#Surfaces package. Programmed for MapleV by Tim Murdoch December, 1992. 
#Revised for Release 2 in August, 1993
#This package consists of procedures to compute the coefficients of the 
#first and second fundamental forms, a unit normal vector, Gauss curvature and 
#mean curvature of a parametric surface in R^3. 
#Parameterized surfaces are represent as a list of three functions:
#[f(u,v),g(u,v),h(u,v)] (the independent variables may have any names).

g11:=proc(f:list,x:list)
local localf, localx, f1;
localf:=array(f); localx:=array(x);
f1:=map(diff, localf, x[1]);
linalg[dotprod](f1,f1)
end:

g12:=proc(f:list,x:list)
local localf, localx, f1, f2;
localf:=array(f); localx:=array(x);
f1:=map(diff, localf, x[1]);
f2:=map(diff, localf, x[2]);
linalg[dotprod](f1,f2)
end:

g21:=proc(f:list,x:list)
local localf, localx;
localf:=f; localx:=x;
g12(localf,localx)
end:	

g22:=proc(f:list,x:list)
local localf, localx, f2;
localf:=array(f); localx:=array(x);
f2:=map(diff, localf, x[2]);
linalg[dotprod](f2,f2)
end:

metricdet:=proc(f:list,x:list)
local localf, localx;
localf:=f; localx:=x;
simplify(g11(localf,localx)*g22(localf,localx)-g12(localf,localx)^2) 
end:

unitnormal:=proc(f:list,x:list)
local localf, localx, f1, f2, n, length;
localf:=array(f); localx:=array(x);
f1:=map(diff, localf, x[1]);
f2:=map(diff, localf, x[2]);
length:=sqrt(metricdet(convert(localf,list),convert(localx,list)));
convert(evalm((1/length)*linalg[crossprod](f1,f2)),list)
end:

b11:=proc(f:list,x:list)
local localf, localx, f11, n;
localf:=array(f); localx:=array(x);
f11:=map(diff, localf, x[1], x[1]);
n:=unitnormal(convert(localf,list),convert(localx,list));
-linalg[dotprod](n,f11)
end:

b12:=proc(f:list,x:list)
local localf, localx, f12, n;
localf:=array(f); localx:=array(x);
f12:=map(diff, localf, x[1], x[2]);
n:=unitnormal(convert(localf,list),convert(localx,list));
-linalg[dotprod](n,f12)
end:

b21:=proc(f:list,x:list)
local localf, localx;
localf:=f; localx:=x;
b12(localf,localx)
end:	

b22:=proc(f:list,x:list)
local localf, localx, f22, n;
localf:=array(f); localx:=array(x);
f22:=map(diff, localf, x[2], x[2]);
n:=unitnormal(convert(localf,list),convert(localx,list));
-linalg[dotprod](n,f22)
end:

Gausscurv:=proc(f:list,x:list)
local localf, localx;
localf:= f; localx:= x;
simplify((b11(localf,localx)*b22(localf,localx)-b12(localf,localx)^2)/(metricdet(localf, localx)))
end:

Meancurv:=proc(f:list,x:list)
local localf, localx;
localf:= f; localx:= x;
simplify((b11(localf,localx)*g22(localf,localx)-2*g12(localf,localx)*b12(localf,localx)+g11(localf,localx)*b22(localf,localx))/(2*metricdet(localf, localx)))
end:

catalogue:=proc(f:list,x:list)
local localf, localx, a, b, c, d, e;
localf:= f; localx:= x;
a:=linalg[matrix]([map(simplify,[g11(localf, localx),g12(localf, localx)]),
map(simplify,[g21(localf, localx),g22(localf, localx)])]);
print(`First fundamental form`= evalm(a));
b:=map(simplify,unitnormal(localf, localx));
print(`Unit normal vector`= evalm(b));
c:=linalg[matrix]([map(simplify,[b11(localf, localx),b12(localf, localx)]),
map(simplify,[b21(localf, localx),b22(localf, localx)])]);
print(`Second fundamental form`= evalm(c));
d:=Gausscurv(localf, localx);
print(`Gauss curvature`= d);
e:=Meancurv(localf, localx);
print(`Mean curvature`= e);
end:

`help/text/surfaces` := TEXT(
`HELP FOR: Introduction to the surfaces package`,
`   `,
`CALLING SEQUENCE: <function>(parameter_list,variable_list)`,
`   `,
`SYNOPSIS:   `,
`   `,
`-The available functions are:`,
`   `,
`	g11 g12 g21 g22 metricdet unitnormal b11 b12 b21 b22 Gausscurv Meancurv`,
`   `,
`-To compute a coefficient of the first fundamental form, invoke any of the`,
`functions`,
`   `,
`	g11(parameter_list, variable_list), g12(parameter_list, variable_list)`,
`	g21(parameter_list, variable_list), g22(parameter_list, variable_list)`,
`   `,
`EXAMPLES:   `,
`>g11([x,y,x*y],[x,y]);`,
`                                          2`,
`                                     1 + y`,
`   `,
`>g12([x,y,x^2+y^2],[x,y]);`,
`                                      4 x y`,
`   `,
`>g21([x,y,x^2-y^2],[x,y]);`,
`                                    - 4 x y`,
`   `,
`>g22([x^2,y^2,x*y],[x,y]);`,
`                                       2    2`,
`                                    4 y  + x`,
`   `,
`   `,
`-Invoke metric determinant function using the form`,
`   `,
`	metricdet(parameter_list, variable_list).`,
`   `,
`EXAMPLE:   `,
`>torus:=[(R+r*cos(v))*cos(u),(R+r*cos(v))*sin(u),r*sin(v)]:`,
`>metricdet(torus,[u,v]);`,
`                          3             4       2    2  2`,
`                       2 r  R cos(v) + r  cos(v)  + r  R`,
`   `,
`   `,
`-To compute a unit normal vector, invoke the unit normal function using the 
form`,
`   `,
`	unitnormal(parameter_list, variable_list).`,
`   `,
`EXAMPLE:   `,
`>unitnormal([x,y,1-x-y],[x,y]);`,
`                               1/2       1/2       1/2`,
`                         [1/3 3   , 1/3 3   , 1/3 3   ]`,
`   `,
`   `,
`-To compute a coefficient of the second fundamental form, invoke any of the 
functions`,
`   `,
`	b11(parameter_list, variable_list), b12(parameter_list, variable_list)`,
`	b21(parameter_list, variable_list), b22(parameter_list, variable_list)`,
`   `,
`EXAMPLES:   `,
`>sphere:=[R*cos(u)*cos(v),R*sin(u)*cos(v),R*sin(v)]:`,
`>simplify(b11(sphere,[u,v]));`,
`                                          2`,
`                                    cos(v)  R`,
`   `,
`>b12([x,y,x^2+y^2],[x,y]);`,
`                                       0`,
`   `,
`>b21([s,t,s*t],[s,t]);`,
`                                         1`,
`                               - ----------------`,
`                                       2    2 1/2`,
`                                 (1 + s  + t )`,
`   `,
`>torus:=[(R+r*cos(v))*cos(u),(R+r*cos(v))*sin(u),r*sin(v)]:`,
`>simplify(b22(torus,[u,v]));`,
`                                       r`,
`   `,
`-To compute the Gauss curvature of a parameterization, invoke the function`,
`   `,
`	Gausscurv(parameter_list, variable_list).`,
`   `,
`EXAMPLE:   `,
`>torus:=[(R+r*cos(v))*cos(u),(R+r*cos(v))*sin(u),r*sin(v)]:`,
`>Gausscurv(torus,[u,v]);`,
`                                     cos(v)`,
`                                ----------------`,
`                                r (R + r cos(v))`,
`   `,
`   `,
`-To compute the mean curvature of a parameterization, invoke the function`,
`   `,
`	Meancurv(parameter_list, variable_list).`,
`   `,
`EXAMPLE:   `,
`>enneper:=[x-x^3/3+x*y^2,-y-x^2*y+y^3/3, x^2-y^2]:`,
`>Meancurv(enneper,[x,y]);`,
`   `,
`-To compute all quantities in this package at once, invoke the function`,
`   `,
`catalogue(parameter_list, variable_list).`,
`   `,
`Catalogue prints the first fundamental form matrix, a unit normal vector, the 
second fundamental form matrix, the Gauss curvature, and the mean curvature 
(computed from the returned unit normal vector) in that order.`,
`   `,
`EXAMPLE:   `,
`>interface(labelling=false);`,
`>sphere:=[R*cos(u)*cos(v),R*sin(u)*cos(v),R*sin(v)]:`,
`>catalogue(sphere,[u,v]);`,
`                                            [  2       2     ]`,
`                                            [ R  cos(v)    0 ]`,
`                   First fundamental form = [                ]`,
`                                            [              2 ]`,
`                                            [      0      R  ]`,
`   `,
`          Unit normal vector = [ cos(u) cos(v), sin(u) cos(v), sin(v) ]`,
`   `,
`                                             [       2      ]`,
`                                             [ cos(v)  R  0 ]`,
`                   Second fundamental form = [              ]`,
`                                             [     0      R ]`,
`   `,
`                                                 1`,
`                             Gauss curvature = ----`,
`                                                 2`,
`                                                R`,
`   `,
`                              Mean curvature = 1/R`
):

#save `surfaces.m`;
#quit
