3d30.mp

% tex/conc/mp/3d30.mp   2016-10-4   Alan U. Kennington.
% $Id: tex/conc/mp/3d30.mp a35cf781df 2016-10-04 11:45:02Z Alan U. Kennington $
% Infinitesimal transformations of 2-sphere generated by Lie algebra elements.

input 3dmax
input mapmax

verbatimtex
\input akmath
\input dgmpmax
etex

%%%%%%%%%%%%%%%%%%%%%%%%%
%       figure 1        %
%%%%%%%%%%%%%%%%%%%%%%%%%
beginfig(1);
numeric A[][];          % The current 4x3 transformation matrix.
numeric p[][], q[][];   % Lists of 3-vectors.
numeric s;              % The screen scale factor.
pair w[];               % Coordinate pairs on the drawing canvas.
color col[];
color vcol, vcoll;
path pat[];

%==============================================================================
% Multiplier and orientation angles for viewer.
dv := 10;               % Distance of camera from centre of sphere.
ph_v := -45;            % Angle phi of viewer.
th_v := 35;             % Angle theta of viewer.

s := 500;               % Some sort of magnification/zoom factor.
R := 1;                 % Radius of the sphere.

axlength := 1.55;
azlength := 1.5;
ytX := 0.2;
ytY := 0.3;

np := 5;
nq := 5;
xt := 0.5;  % Extension of lines.

% Constant-latitude circles.
nR := 12;       % 12 cubic spline points around the equator to make it smooth.
nlat := 1;      % Number for dividing the latitude of 90 degrees.

% Constant-longitude circles.
mR := 20;       % 40 cubic spline points along the longitude line.
% nlong := 12;    % Number for dividing the longitude of 180 degrees.
nlong := 6;     % Number for dividing the longitude of 180 degrees.

penGRID := 0.5bp;
penBDY := 0.3bp;
penLONG := 0.5bp;
penLONGZ := 0.5bp;
penLAT := 0.5bp;
penLATZ := 0.5bp;
penVEC := 0.9bp;

col1 := 0.5white;               % Grid colour 1.
% col1 := (0,0.4,0);              % Grid colour.
% col2 := (185,210,255)/255;      % Earth colour.
% col2 := (162,187,248)/255;      % Earth colour.
% col2 := (135,168,255)/255;      % Earth colour.
% col2 := (200,220,255)/255;      % Earth colour 2.
col2 := 0.93white;              % Earth colour 2.
col3 := 0.93white;              % Earth colour 1.
col4 := 0.5white;               % Grid colour 2.

spA := 25pt;                    % Space for subtitle.
spB := 14pt;                    % Interline space.

% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Z_set_rpt(p0)(dv, ph_v, th_v);  % Position of viewer.
Z_set(q0)(0, 0, 0);             % Centre of picture.
A_set_pq(A)(p0)(q0);            % Set the perspective matrix.

% Axes and grid lines.
Z_set(p1)(axlength + ytX, 0, 0); % X axis.
Z_set(p2)(0, axlength + ytY, 0); % Y axis.
Z_set(p3)(0, 0, azlength);      % Z axis.
Z_set(p4)(0, 0, 0);             % Origin.
Z_set(p7)(0, 0, 1);             % North pole.
Z_set(p8)(0, 0, -1);            % South pole.
Z_set(p11)(0,0,0);              % Centre of the sphere.

A_calc_w(A)(w1)(p1)(s);
A_calc_w(A)(w2)(p2)(s);
A_calc_w(A)(w3)(p3)(s);
A_calc_w(A)(w4)(p4)(s);
A_calc_w(A)(w7)(p7)(s);
A_calc_w(A)(w8)(p8)(s);

A_sphere_outline(A)(pat1)(q0)(s, R);

%==============================================================================
% Draw the axes.
pickup pencircle scaled penGRID;
drawarrow w4--w1 withcolor col1;
drawarrow w4--w2 withcolor col1;
drawarrow w4--w3 withcolor col1;
label.rt(btex $x_1$ etex, w1);
label.urt(btex $x_2$ etex, w2);
label.lft(btex $x_3$ etex, w3+(-2pt,0));

for i=-np upto np:
    Z_set(p5)(i/np, -1 - xt, 0);
    Z_set(p6)(i/np, 1 + xt, 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col1;
    endfor
for j=-nq upto nq:
    Z_set(p5)(-1 - xt, j/nq, 0);
    Z_set(p6)(1 + xt, j/nq, 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col1;
    endfor

pickup pencircle scaled penBDY;
fill pat1 withcolor col3;
% draw pat1;

pickup pencircle scaled penGRID;
drawarrow w7--w3 withcolor col1;
for i=np upto np:
    Z_set(p5)(i/np, -1 - xt, 0);
    Z_set(p6)(i/np, 1 + xt, 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col1;
    endfor
% Kludge!
for i=-2 upto np-1:
    Z_set(p5)(i/np, -1 - xt, 0);
    Z_set(p6)(i/np, -sqrt(1-(i/np)*(i/np)), 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col1;
    endfor

for j=-nq upto -nq:
    Z_set(p5)(-1 - xt, j/nq, 0);
    Z_set(p6)(1 + xt, j/nq, 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col1;
    endfor
% Kludge!
for j=-nq+1 upto 2:
    Z_set(p5)(sqrt(1-(j/nq)*(j/nq)), j/nq, 0);
    Z_set(p6)(1 + xt, j/nq, 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col1;
    endfor

%- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
% Draw the sphere.
A_draw_lat_hide(A)(s)(p11)(R, nlat, nR, penLAT, penLATZ)(p0);
A_draw_long_hide(A)(s)(p11)(R, nlong, mR, penLONG, penLONGZ)(p0);

% Add some vectors to show the infinitesimal transformation.
pickup pencircle scaled penVEC;
vlen := 0.42;               % Length of vector.
vcol := 0.0white;           % Colour of vector.
vcoll := 0.6white;          % Colour of second vector.

for i = -4 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -90, lati, vlen*cosd(lati), 0, vcol);
    endfor
for i = 0 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -120, lati, vlen*cosd(lati), 0, vcoll);
    endfor
for i = 4 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -150, lati, vlen*cosd(lati), 0, vcoll);
    endfor
for i = 6 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -180, lati, vlen*cosd(lati), 0, vcol);
    endfor
for i = 7 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 150, lati, vlen*cosd(lati), 0, vcoll);
    endfor
for i = 7 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 120, lati, vlen*cosd(lati), 0, vcoll);
    endfor
for i = 6 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 90, lati, vlen*cosd(lati), 0, vcol);
    endfor
for i = 4 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 60, lati, vlen*cosd(lati), 0, vcoll);
    endfor
for i = 0 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 30, lati, vlen*cosd(lati), 0, vcoll);
    endfor
for i = -4 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 0, lati, vlen*cosd(lati), 0, vcol);
    endfor
for i = -4 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -30, lati, vlen*cosd(lati), 0, vcoll);
    endfor
for i = -4 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -60, lati, vlen*cosd(lati), 0, vcoll);
    endfor

% Redraw the x_3 axis. (Includes special kludge to raise base of arrow a bit.)
pickup pencircle scaled penGRID;
drawarrow (w7+(0,1pt))--w3 withcolor col1;

% label.bot(btex \strut vector field induced by
%  $U=\left[\matrix{\phantom{-{}}0&-a&0\cr a&0&0\cr\phantom{-{}}0&0&0\cr}\right]$
%  etex, w8+(0,-spA));

label.bot(btex \strut vector field induced by $U=
 \left[\matrix{0&\MinSp\llap{$-{}$}a&0\cr a&\MinSp0&0\cr0&\MinSp0&0\cr}\right]$
 etex, w8+(0,-spA));

%==============================================================================
% Second copy. This is required to shift the viewpoint in paper-space.
w20 := (7.0cm,0cm);

% Shift of first image to left of second image.
currentpicture := currentpicture shifted -w20;

%==============================================================================
% The second image.
%==============================================================================
% Draw the axes.
pickup pencircle scaled penGRID;
drawarrow w4--w1 withcolor col4;
drawarrow w4--w2 withcolor col4;
drawarrow w4--w3 withcolor col4;
label.rt(btex $x_1$ etex, w1);
label.urt(btex $x_2$ etex, w2);
label.lft(btex $x_3$ etex, w3+(-2pt,0));

for i=-np upto np:
    Z_set(p5)(i/np, -1 - xt, 0);
    Z_set(p6)(i/np, 1 + xt, 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col4;
    endfor
for j=-nq upto nq:
    Z_set(p5)(-1 - xt, j/nq, 0);
    Z_set(p6)(1 + xt, j/nq, 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col4;
    endfor

fill pat1 withcolor col2;

drawarrow w7--w3 withcolor col4;
for i=np upto np:
    Z_set(p5)(i/np, -1 - xt, 0);
    Z_set(p6)(i/np, 1 + xt, 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col4;
    endfor
% Kludge!
for i=-2 upto np-1:
    Z_set(p5)(i/np, -1 - xt, 0);
    Z_set(p6)(i/np, -sqrt(1-(i/np)*(i/np)), 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col4;
    endfor

for j=-nq upto -nq:
    Z_set(p5)(-1 - xt, j/nq, 0);
    Z_set(p6)(1 + xt, j/nq, 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col4;
    endfor
% Kludge!
for j=-nq+1 upto 2:
    Z_set(p5)(sqrt(1-(j/nq)*(j/nq)), j/nq, 0);
    Z_set(p6)(1 + xt, j/nq, 0);
    A_calc_w(A)(w5)(p5)(s);
    A_calc_w(A)(w6)(p6)(s);
    draw w5--w6 withcolor col4;
    endfor

%- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
% Draw the sphere.
A_draw_lat_hide(A)(s)(p11)(R, nlat, nR, penLAT, penLATZ)(p0);
A_draw_long_hide(A)(s)(p11)(R, nlong, mR, penLONG, penLONGZ)(p0);

% NOTE: Mega-kludge to swap the x_1 and x_3 axes.
% Should make this a general macro to rotate and/or mirror space.
% Or make it a general affine transformation of space.
A_w := A[0][3];
A_x := A[1][3];
A_y := A[2][3];
A_z := A[3][3];
A[0][3] := A[0][1];
A[1][3] := A[1][1];
A[2][3] := A[2][1];
A[3][3] := A[3][1];
A[0][1] := A_w;
A[1][1] := A_x;
A[2][1] := A_y;
A[3][1] := A_z;
for i = 7 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 120, lati, vlen*cosd(lati), 180, vcoll);
    endfor
for i = 7 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 150, lati, vlen*cosd(lati), 180, vcoll);
    endfor
for i = 7 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -180, lati, vlen*cosd(lati), 180, vcol);
    endfor
for i = 3 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -150, lati, vlen*cosd(lati), 180, vcoll);
    endfor
for i = -2 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -120, lati, vlen*cosd(lati), 180, vcoll);
    endfor
for i = -3 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -90, lati, vlen*cosd(lati), 180, vcol);
    endfor
for i = -4 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -60, lati, vlen*cosd(lati), 180, vcoll);
    endfor
for i = -4 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, -30, lati, vlen*cosd(lati), 180, vcoll);
    endfor
for i = -3 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 0, lati, vlen*cosd(lati), 180, vcol);
    endfor
for i = -1 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 30, lati, vlen*cosd(lati), 180, vcoll);
    endfor
for i = 2 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 60, lati, vlen*cosd(lati), 180, vcoll);
    endfor
for i = 5 upto 7:
    lati := i * 10;
    A_bearing_draw(A)(s)(q0)(R, 90, lati, vlen*cosd(lati), 180, vcol);
    endfor

% Redraw the x_3 axis. (Includes special kludge to raise base of arrow a bit.)
pickup pencircle scaled penGRID;
drawarrow (w7+(0,1pt))--w3 withcolor col1;

label.bot(btex \strut vector field induced by $U=
 \left[\matrix{0&0&\MinSp0\cr0&0&\MinSp\llap{$-{}$}a\cr0&a&\MinSp0\cr}\right]$
 etex, w8+(0,-spA));

%==============================================================================
% Save the current picture bounding box.
% bbx := bboxmargin;
% bboxmargin := 0;
% pat0 := bbox currentpicture;
% bboxmargin := bbx;

% setbounds currentpicture to pat0;

endfig;
end