(* Weight Diagrams for rank 2 groups by Daniel Bump         *)
(* for Wolfram Mathematica.                                 *)
(* Copyright 1996 by Daniel Bump (bump@math.stanford.edu)   *)
(*                   http://math.stanford.edu/~bump/        *)
(* Right to modify or make copies of this file for          *)
(* noncommercial use is hereby granted provided this        *)
(* copyright notice is retained. Sale of this program is    *)
(* prohibited. Correctness of this program and suitability  *)
(* for any purpose is not warranted. User assumes all risk. *)

(* Freudenthal multiplicity formula for A2.  *)
(* WeightMultiplicitiesA2 creates a table of the weights with *)
(* multiplicities. WeightDiagramA2 displays the table         *)
(* graphically ComputeWeights is a routine to compute a given *)
(* multiplicities by those which have already been computed   *)
(* by means of the Freudenthal formula.  rr and rl complete   *)
(* the table by application of the Weyl group elements which  *)
(* consist of rotations in 2*Pi/3. Pointlist converts from    *)
(* coordinates in the hyperplane x+y+z=0 in R^3 to            *)
(* R^2. Displaypoints produces the graphics. Valid checks to  *)
(* see if a weight occurs with nonzero multiplicity.          *)

WeightMultiplicitiesA2[n1_,n2_]:=Block[
	{alpha,lambda1,lambda2,mu1,mu2,mu,lambda,weights,n,i,
   	multiplicities,rho,mult,nu,multnu,rr,rl},
   (* OpenWrite["debug"]; *)
	alpha={{1,-1,0},{0,1,-1},{1,0,-1}};
   lambda1={2/3,-1/3,-1/3};
   lambda2={1/3,1/3,-2/3};
   lambda=n1*lambda1+n2*lambda2;
	multiplicities={};
	mu1=0;
   While[
		mu2=0;
      mu=lambda-mu1*alpha[[1]]-mu2*alpha[[2]];
		(*	Print["mu1=",mu1," mu2=",mu2," mu=",InputForm[mu]]; *)
      (* Write["debug",mu1,mu2,mu]; *)
      (mu.lambda1>=0)&&(mu.lambda2>=0),
      While[
      	mu=lambda-mu1*alpha[[1]]-mu2*alpha[[2]];
	      (* Write["debug",OutputForm["   "],mu1,mu2,mu]; *)
         (* Print["   mu1=",mu1," mu2=",mu2," mu=",InputForm[mu]]; *)
			(mu.lambda1>=0)&&(mu.lambda2>=0),
         If[ValidA2[mu,lambda],
         	mult=ComputeWeightA2[mu,lambda,multiplicities];
	      	AppendTo[multiplicities,{mu,mult}];
         ];
         mu2++
      ];
      mu1++
   ];
	rr[l_]:={RotateRight[l[[1]]],l[[2]]};
	rl[l_]:={RotateLeft[l[[1]]],l[[2]]};
	(* Close["debug"]; *)
   Union[multiplicities,Map[rr,multiplicities,1],Map[rl,multiplicities]] 
]

ComputeWeightA2[m_,l_,list_]:=Block[{i,j,total,mult},
   rho={1,0,-1};
   alpha={{1,-1,0},{0,1,-1},{1,0,-1}};
   If[m==l,1,
	   Sum[
			total=0;
      	For[j=1,
         	!FreeQ[list,m+j*alpha[[i]]],
            j++,
	      	mult=list[[Position[list,m+j*alpha[[i]]][[1,1]],2]];
         	(* Print["m+j*alpha[[i]]=",InputForm[m+j*alpha[[i]]],"mult=",mult]; *)
            total+=mult*((m+j*alpha[[i]]).alpha[[i]])
      	];
	      (* Print["m=",InputForm[m]," i=",i," total=",total]; *)
   	   total,
      	{i,3}
	   ]*2/((l+rho).(l+rho)-(m+rho).(m+rho))
   ]
]

ValidA2[m_,l_]:=Block[{lambda1,lambda2,subtractm,a},
   lambda1={2/3,-1/3,-1/3};
   lambda2={1/3,1/3,-2/3};
   subtractl[x_]:=l-x;
   test[x_]:=(((x.lambda1)>=0)&&((x.lambda2)>=0));
   Apply[And,Map[
   	test,
		Map[subtractl,Permutations[m],1],
      1
   ]]
]

DisplayPointsA2[list_]:=
	Table[Text[list[[i,2]],list[[i,1]]],{i,Length[list]}]

   (* Alternative:																	 *)
   (* Flatten[Table[{PointSize[0.01*list[[i,2]]],Point[list[[i,1]]]}, *)
	(* {i,Length[list]}]] 															 *)

PointListA2[l_]:={l[[1,1]]*{1.,0.}+l[[1,3]]*{.5,-.866025},l[[2]]}

WeightDiagramA2[n1_,n2_]:=Show[Graphics[DisplayPointsA2[
	Map[PointListA2,WeightMultiplicitiesA2[n1,n2],1]
]]]

(* Freudenthal Multiplicity formula and weight diagrams for type B2 *)

WeightMultiplicitiesB2[n1_,n2_]:=Block[
	{alpha,lambda1,lambda2,mu1,mu2,mu,lambda,weights,n,i,
   	multiplicities,rho,mult,nu,multnu,wa,wb},
   (* OpenWrite["debug"]; *)
	alpha={{1,-1},{0,1},{1,0},{1,1}};
   lambda1={1,0};
   lambda2={1/2,1/2};
   lambda=n1*lambda1+n2*lambda2;
	multiplicities={};
	mu1=0;
   While[
		mu2=0;
      mu=lambda-mu1*alpha[[1]]-mu2*alpha[[2]];
		(* Print["mu1=",mu1," mu2=",mu2," mu=",InputForm[mu]]; *)
      (* Write["debug",mu1,mu2,mu]; *)
      (mu.lambda1>=0)&&(mu.lambda2>=0),
      While[
      	mu=lambda-mu1*alpha[[1]]-mu2*alpha[[2]];
	      (* Write["debug",OutputForm["   "],mu1,mu2,mu]; *)
         (* Print["   mu1=",mu1," mu2=",mu2," mu=",InputForm[mu]]; *)
			(mu.lambda1>=0)&&(mu.lambda2>=0),
         If[ValidB2[mu,lambda],
         	mult=ComputeWeightB2[mu,lambda,multiplicities];
	      	AppendTo[multiplicities,{mu,mult}];
         ];
         mu2++
      ];
      mu1++
   ];
	wa[l_]:={{-l[[1,2]],-l[[1,1]]},l[[2]]};
	wb[l_]:={{-l[[1,1]],l[[1,2]]},l[[2]]};
	(* Close["debug"]; *)
   Union[multiplicities,Map[wa,multiplicities,1],Map[wb,multiplicities]] 
]

ComputeWeightB2[m_,l_,list_]:=Block[{i,j,total,mult},
	alpha={{1,-1},{0,1},{1,0},{1,1}};
   lambda1={1,0};
   lambda2={1/2,1/2};
   rho={3/2,1/2};
   If[m==l,1,
	   Sum[
			total=0;
      	For[j=1,
         	!FreeQ[list,m+j*alpha[[i]]],
            j++,
	      	mult=list[[Position[list,m+j*alpha[[i]]][[1,1]],2]];
         	(* Print["m+j*alpha[[i]]=",InputForm[m+j*alpha[[i]]],"mult=",mult]; *)
            total+=mult*((m+j*alpha[[i]]).alpha[[i]])
      	];
	      (* Print["m=",InputForm[m]," i=",i," total=",total]; *)
   	   total,
      	{i,4}
	   ]*2/((l+rho).(l+rho)-(m+rho).(m+rho))
   ]
]

ValidB2[m_,l_]:=Block[{lambda1,lambda2,subtractm,a},
   lambda1={1,0};
   lambda2={1/2,1/2};
   subtractl[x_]:=l-x;
   test[x_]:=(((x.lambda1)>=0)&&((x.lambda2)>=0));
   Apply[And,Map[
   	test,
		Map[subtractl,WeylGroupB2[m],1],
      1
   ]]
]

WeylGroupB2[l_]:=Block[{multl},
	multl[m_]:=l*m;
   Flatten[Map[Permutations,
   	Map[multl,Flatten[Outer[List,{1,-1},{1,-1}],1],1],1],1]
]

DisplayPointsB2[list_]:=
	Table[Text[list[[i,2]],list[[i,1]]],{i,Length[list]}]

   (* Alternative:																	 *)
   (* Flatten[Table[{PointSize[0.01*list[[i,2]]],Point[list[[i,1]]]}, *)
	(* {i,Length[list]}]] 															 *)


WeightDiagramB2[n1_,n2_]:=Show[Graphics[DisplayPointsB2[
	WeightMultiplicitiesB2[n1,n2]
]]]

(* Freudenthal Multiplicity formula and weight diagrams for type G2 *)

WeightMultiplicitiesG2[n1_,n2_]:=Block[
	{alpha,lambda1,lambda2,mu1,mu2,mu,lambda,weights,n,i,
   	multiplicities,rho,mult,nu,multnu,rr,rl},
   (* OpenWrite["debug"]; *)
	alpha={{1,-1,0},{-1,2,-1},{0,1,-1},{1,0,-1},{2,-1,-1},{1,1,-2}};
   lambda1={1,0,-1};
   lambda2={1,1,-2};
   lambda=n1*lambda1+n2*lambda2;
	multiplicities={};
	mu1=0;
   While[
		mu2=0;
      mu=lambda-mu1*alpha[[1]]-mu2*alpha[[2]];
		(* Print["mu1=",mu1," mu2=",mu2," mu=",InputForm[mu]]; *)
      (* Write["debug",mu1,mu2,mu]; *)
      (mu.lambda1>=0)&&(mu.lambda2>=0),
      While[
      	mu=lambda-mu1*alpha[[1]]-mu2*alpha[[2]];
	      (* Write["debug",OutputForm["   "],mu1,mu2,mu]; *)
         (* Print["   mu1=",mu1," mu2=",mu2," mu=",InputForm[mu]]; *)
			(mu.lambda1>=0)&&(mu.lambda2>=0),
         If[ValidG2[mu,lambda],
         	mult=ComputeWeightG2[mu,lambda,multiplicities];
	      	AppendTo[multiplicities,{mu,mult}];
         ];
         mu2++
      ];
      mu1++
   ];
	rr[l_]:={RotateRight[l[[1]]],l[[2]]};
	rl[l_]:={RotateLeft[l[[1]]],l[[2]]};
	(* Close["debug"]; *)
   Union[multiplicities,Map[rr,multiplicities,1],Map[rl,multiplicities]] 
]

ComputeWeightG2[m_,l_,list_]:=Block[{i,j,total,mult},
   rho={2,1,-3};
	alpha={{1,-1,0},{-1,2,-1},{0,1,-1},{1,0,-1},{2,-1,-1},{1,1,-2}};
   If[m==l,1,
	   Sum[
			total=0;
      	For[j=1,
         	!FreeQ[list,m+j*alpha[[i]]],
            j++,
	      	mult=list[[Position[list,m+j*alpha[[i]]][[1,1]],2]];
            total+=mult*((m+j*alpha[[i]]).alpha[[i]])
      	];
   	   total,
      	{i,6}
	   ]*2/((l+rho).(l+rho)-(m+rho).(m+rho))
   ]
]

ValidG2[m_,l_]:=Block[{lambda1,lambda2,subtractm,a},
   lambda1={1,0,-1};
   lambda2={1,1,-2};
   subtractl[x_]:=l-x;
   test[x_]:=(((x.lambda1)>=0)&&((x.lambda2)>=0));
   Apply[And,Map[
   	test,
		Map[subtractl,Union[Permutations[m],Permutations[-m]],1],
      1
   ]]
]

DisplayPointsG2[list_]:=
	Table[Text[list[[i,2]],list[[i,1]]],{i,Length[list]}]

   (* Alternative:																	 *)
   (* Flatten[Table[{PointSize[0.01*list[[i,2]]],Point[list[[i,1]]]}, *)
	(* {i,Length[list]}]] 															 *)

PointListG2[l_]:={l[[1,1]]*{1.,0.}+l[[1,3]]*{.5,-.866025},l[[2]]}

WeightDiagramG2[n1_,n2_]:=Show[Graphics[DisplayPointsG2[
	Map[PointListG2,WeightMultiplicitiesG2[n1,n2],1]
]]]