Dear Dror, 

In these notebooks i hope to express some computations which i’ve been trying to execute via Mathematica. To this point, the computations have not succeeded; my efforts insufficient. Below I try to describe my goals and present limits.There is a division of fiction/non-fiction within mathematics which i’ve had to relearn during your course. Not all mathematical ideas are physically feasible, and many things i thought i could `do’ have been illusions.

My principal aim this semester has been to explicitly solve a class of optimal semicoupling problems between a boundary target measure space (Y, τ) and source measure space (X, σ) relative to a (nonstandard) class of cost functions $c:Y \times X \to R$. Topologically, the source space X is embedded within some bordified manifold-with-corners (X^(#))and Y is the topological boundary of the bordification (X^(#)). Concretely, our main examples occupy Poincare’s hyperbolic disk. I shall describe the costs in detail below.

To implement a measure space (X,σ) on Mathematica is an interesting/aggravating task. I dare to indulge an observation here.
Measures are limits of configurations. The unordered configuration space of, say, seven points on a 64-pointed sample space X can be identified with a quotient of the seven-fold cartesian product Tuples[X,7] by the symmetric group (Subscript[Symm, 7])on seven letters. This description of the configuration space (Subscript[S, 7])(X) is however nonphysical/nonconstructible. The cartesian product of order 2^(6.7) is too large to be constructed, while the symmetric group quotient (X^7)-> (X^7)/(Subscript[Symm, 7]) is itself a large reduction. The cardinality of the quotient diminishes from (64^7)to (64+7-1)!/64! (7-1)!, which is a reduction of 29 to 18 dimensions. The inbuilt symbolic capabilities of Mathematica, which are unfortunately licenced and obscured, can potentially serve a useful function. Symbolically expanding the product

Times@@Table[Table[e^a[j],{j,1,64}]//Total, {i,1,7}]

permits a formal enumeration of (Subscript[S, 7])[64], where the Table[e^a[j],{j,1,64}]]//Total gives a symbolic enumeration of the point set a[1],a[2],..... Our netbook has insufficient memory to expand this product. Moreover, we should like to know whether the (inbuilt, hence secret) expansion bypasses the quotient 64^7 -> 64^7/(Subscript[Symm, 7]).

Times@@Table[Table[e^a[j],{j,1,16}]//Total, {i,1,7}]//Expand

Geodesic rays on Cartan symmetric spaces

We compute (approximate) geodesic distances on the hyperbolic disk represented as coset space SO(2,R) \ SL(2,R) with basepoint o corresponding to the compact subgroup SO(2,R). For possibly nonsymmetric x ∈ SL(2,R) the (Cartan-Killing right-invariant riemannian) distance dist[o,o.x] is evaluated by finding k’∈SO(2,R) and a’∈ R(eals) such that  ^k’ [^t x.x ]=exp[2a’]. Explicitly k’,a’ are uniquely defined by having property that the k’-conjugate of the symmetric operator ^t x.x coincides with a diagonal matrix exp[2a’]. The quantity Abs[a’] represents dist[o,o.x]^1. Geometrically, the matrix curve o.exp[2t] for 0<t<a’ is a geodesic ray joining the basepoint o to o.exp[2a’]. The compact operator k’ amounts to rotating this geodesic ray while fixing basepoint o. 

The evaluation of the compact factor k’ is achieved by an approximation scheme which we learned from Furstenberg’s papers proving Zariski density of SL(2,Z) in SL(2,R) and “Poisson formula for semisimple lie groups”. The argument generalizes to higher rank lie groups (which are our main interest) but has simple interpretation in the present case of SL(2,R). If Z is a symmetric operator in SL(2,R), then the eigenvectors of Z are real and orthogonal (relative to the compact subgroup/metric SO(2,R)). Unless Z is the identity, these eigenvalues will be strictly greater and strictly less than unity. Unless Z is diagonal, the orbits Z^1.{1,0}, Z^2.{1,0},Z^3.{1,0}, ... will converge projectively to the >1-eigenspace of Z, and the negative powers Z^-1.{1,0},Z^-2.{1,0},Z^-3.{1,0},... will converge projectively to the <1-eigenspace of Z. That is, the orbits each diverge in R^2, but have unique limit points in the projective space Proj(R^2). Renormalizing these high positive and negative powers, we obtain a sequence k1, k2, k3, ... of compact operators in SO(2,R) which converge to the unique k’ (up to sign) for which the symmetric operator adj[k’,Z] is diagonal, i.e. the columns of k’ form a basis for the eigenspaces of Z. 

Our definition below is imperfect and yields a singular matrix whenever the projective limits ($s^(+∞)).e1,(s^(-∞)).e1 $  coincide. I.e., whenever s is a diagonal or diagonal.j matrix. This prevents the compact conjugation to be computed in the torus function. In these dysfunctional cases however, we observe that a diagonal s needs only k->id, and k->j, i.e. assign the Weyl group W representation in the specfic basepoint compact subgroup $SO(2)$. 

Our basic sample point is a pair $(o.y,o.x)$ in $Y \times X$ which are pairwise visible by some (directed) geodesic arc ξ[o.y,o.x]. The geodesic arc ξ[o.y,o.x] is parametrized by an O(2)-compact element $k[o.y,o.x]$ which conjugates $symm[y.x^{-1}]$ into a uniquely correspondant diagonal matrix $exp[2α]$. Then o.exp[α].k[o.y,o.x].x=o.y, and we find the geodesic distance between o.y,o.x, i.e. the length of the arc ξ to be α. Our midpoint functional bisects the geodesic arc $ξ[o,o.exp[α]]$ at the midpoint o.exp[α/2]. Accordingly, o.exp[α/2].k[o.y, o.x].x coincides with midpoint on the geodesic arc ξ[o.y,o.x].

scale[v_List,a_Real]:=v.{{a^(-1),0},{0,a^(-1)}}; 
adj[k_List,x_List]:=adj[k,x]=k.x.Inverse[k] ; 
symm[x_List]:=symm[x]=Transpose[x].x; (*square symmetrization*)

diag[m_List]:={m[[1,1]], m[[2,2]]}; 

id={{1,0},{0,1}}; 
j={{0,-1},{1,0}};
ref={{1,0},{0,-1}};
g={{2.,1.},{1.,1.}};
hex=scale[{{1.,0.},{-0.5,N@Sqrt[3]/2 }},Sqrt[Det[{{1,0},{-0.5,N@Sqrt[3]/2 }}]]] ; (*useful SL(2,R) matrices*)

approxcomp[xsym_List,n_Integer:10]:=approxcomp[xsym,n]={
scale[N@MatrixPower[xsym, n, {1,0}],Norm[N@MatrixPower[N@xsym, n, {1,0}],2]], 
scale[N@MatrixPower[xsym, -n, {1,0}],Norm[N@MatrixPower[N@xsym, -n, {1,0}],2]]} ; 


(* approxcomp is the main function of this notebook. Given a symmetric matrix, it yields compact elements of O(2,R) which approximately conjugate the given matrix to a diagonal. The function yields a noninvertible matrix when the symmetric argument is diagonal*)


k[ y_List, x_List,n_Integer:10]:=k[y,x,n]=approxcomp[symm[N@y.N@Inverse[x]],n]; (*ill defined if symm[y.Inverse[x]] is diagonal   *)

torus[y_List, x_List,n_Integer:10]:=torus[y,x,n]=adj[k[y,x,n],symm[N@y.N@Inverse[x]]];

geod[y_List, x_List, n_Integer:10]:=geod[y,x,n]=torus[y,x,n][[1,1]]//Log;

mid[y_List,x_List, n_Integer:10]:=mid[y,x,n]=(Exp@((Log@torus[y,x,n]).{{0.25,0.},{0.,0.25}})).k[y,x,n].x;

tri=({x1_Real,x2_Real,x3_Real}-> {x1-x2-x3,x2-x3-x1,x3-x1-x2}); 

cosinelaw=({x1_Real,x2_Real,x3_Real}-> N@({x3^2-x2^2-x1^2,Times[2,x1,x2]}));


hp[m_List]:=hp[m]=N@{(m[[1,1]] m[[1,2]]+m[[2,1]] m[[2,2]])/(m[[1,1]]^2+m[[2,1]]^2),1/(m[[1,1]]^2+m[[2,1]]^2)};
cay[{a_Real, b_Real}]:=cay[{a,b}]={(a^2+b^2-1) / (a^2+(b+1)^2),(-2 a) / (a^2+(b+1)^2) };
comp[m_List]:=comp[m]=cay[#]&@hp[m];

(*above composition of cayley transform permits us to plot SL(2,R) matrices as orbits on the POincare disk.*)

kk[k1_Real]:=RotationMatrix[k1]; 
a[a1_Real]:=a[a1]={{Exp[-a1],0},{0,Exp[a1]}};
u[t_Real]:={{1,t},{0,1}};

p[3]={{{-3,-2},{2,1}},{{-3,2},{-2,1}},{{-2,-3},{1,1}},{{-2,-1},{3,1}},{{-2,1},{-3,1}},{{-2,3},{-1,1}},{{-1,-3},{1,2}},{{-1,-2},{0,-1}},{{-1,-2},{1,1}},{{-1,-2},{2,3}},{{-1,-1},{1,0}},{{-1,-1},{2,1}},{{-1,-1},{3,2}},{{-1,0},{-2,-1}},{{-1,0},{2,-1}},{{-1,1},{-3,2}},{{-1,1},{-2,1}},{{-1,2},{-2,3}},{{-1,2},{-1,1}},{{-1,2},{0,-1}},{{-1,3},{-1,2}},{{0,-1},{1,-1}},{{0,-1},{1,1}},{{0,-1},{1,2}},{{0,-1},{1,3}},{{0,1},{-1,-1}},{{0,1},{-1,1}},{{0,1},{-1,2}},{{0,1},{-1,3}},{{1,-4},{0,1}},{{1,-3},{-1,4}},{{1,-3},{0,1}},{{1,-3},{1,-2}},{{1,-2},{-2,5}},{{1,-2},{-1,3}},{{1,-2},{0,1}},{{1,-2},{1,-1}},{{1,-2},{2,-3}},{{1,-1},{-3,4}},{{1,-1},{-2,3}},{{1,-1},{-1,2}},{{1,-1},{0,1}},{{1,-1},{1,0}},{{1,-1},{2,-1}},{{1,-1},{3,-2}},{{1,0},{-4,1}},{{1,0},{-3,1}},{{1,0},{-2,1}},{{1,0},{-1,1}},{{1,0},{1,1}},{{1,0},{2,1}},{{1,0},{3,1}},{{1,0},{4,1}},{{1,1},{-3,-2}},{{1,1},{-2,-1}},{{1,1},{-1,0}},{{1,1},{0,1}},{{1,1},{1,2}},{{1,1},{2,3}},{{1,1},{3,4}},{{1,2},{-2,-3}},{{1,2},{-1,-1}},{{1,2},{0,1}},{{1,2},{1,3}},{{1,2},{2,5}},{{1,3},{-1,-2}},{{1,3},{0,1}},{{1,3},{1,4}},{{1,4},{0,1}},{{2,-5},{-1,3}},{{2,-3},{-3,5}},{{2,-3},{-1,2}},{{2,-3},{1,-1}},{{2,-1},{-5,3}},{{2,-1},{-3,2}},{{2,-1},{-1,1}},{{2,-1},{1,0}},{{2,-1},{3,-1}},{{2,1},{-3,-1}},{{2,1},{-1,0}},{{2,1},{1,1}},{{2,1},{3,2}},{{2,1},{5,3}},{{2,3},{-1,-1}},{{2,3},{1,2}},{{2,3},{3,5}},{{2,5},{1,3}},{{3,-5},{-1,2}},{{3,-4},{-2,3}},{{3,-2},{-4,3}},{{3,-2},{-1,1}},{{3,-2},{2,-1}},{{3,-1},{-5,2}},{{3,-1},{-2,1}},{{3,-1},{1,0}},{{3,1},{-1,0}},{{3,1},{2,1}},{{3,1},{5,2}},{{3,2},{-2,-1}},{{3,2},{1,1}},{{3,2},{4,3}},{{3,4},{2,3}},{{3,5},{1,2}},{{4,-3},{-1,1}},{{4,-1},{-3,1}},{{4,1},{3,1}},{{4,3},{1,1}},{{5,-3},{-3,2}},{{5,-2},{-2,1}},{{5,2},{2,1}},{{5,3},{3,2}}};

The list p[3] consists of a local identity neighborhood of the identity in SL(2,Z). We were testing our midpoint function by successively bisecting the arcs ξ[o.x,o] for x ranging over the SL(2,Z) sample. There is an unfortunate 'bug' however in our midpoint function, which originates with the dysfunctional arguments of our approximate compact function. Namely, after the second iteration of the midpoint function, the SL(2,Z) sample orbit ceases to be symmetric in the Poincare disk -- we dont know how to fix this.

ptest[0]=p[3]; ptest[j_Integer]:=mid[#,id]&/@ptest[j-1];

(Re[mid[#,id]]&/@ptest[2]);

ListPlot[comp[#]&/@Re[ptest[2]]]

(*
ListPlot[Table[comp[#]&/@ptest[j],{j,3,4}]]*)

ListPlot[{comp[#]&/@(Re@mid[#,id]&/@p[3]),comp[#]&/@p[3]}]