function diagram(type,rank,gap){
diagramWindow=window.open('','diagramWwindow','resizable=yes,width=800,height=500,scrollbars=yes');
diagramWindow.location = 'spherical.cgi?Submit=diagram&type='+type+'&rank='+rank+'&gap='+gap;
}
END
return '';
}
sub top{
print header;
print start_html(-BGCOLOR=>'white',-title=>"Spherical Explorer");
}
sub helpPage{
top();
print center(strong("Help page for the spherical unitarity tester")),p;
print a({-href=>'javascript:void(self.close())'},'Close');
spherical::help();
}
sub example{
warn "sub example";
my $example=param('examples');
my ($types,$lambdas,$titles,$comments)=sphericalExamples::getExamples();
my $type=$types->{$example};
my $comment=$comments->{$example};
my @lambda=@{$lambdas->{$example}};
my $rank=($type eq 'A')?$#lambda:scalar(@lambda);
my $lambda=join ',', @lambda;
my $coordinates='standard';
# my ($type,$lambda,$lambdaWeight,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu)=test($type,$lambda);
my ($type,$lambda,$lambdaWeight,$lambdaWeightGap,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu)
=spherical::process($type,\@lambda,$coordinates);
top();
print center(h2("Unitary test for $type$rank"));
print diagramScript();
print a({-href=>"javascript:diagram('$type',$rank,''"},'Dynkin Diagram'), ' and coordinates', p;
$message = "$comment
$message";
outputOne($type,$lambda,$lambdaWeight,$lambdaWeightGap,,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu,$comment,1);
print p,a({-href=>'javascript:void(self.close())'},'Close');
}
sub testOne{
warn "sub testOne";
my $lambda=param('lambda');
$lambda =~ s/^\s+//;
$lambda =~ s/\s$+$//;
$lambda =~ s/\s+/,/g;
my @lambda=split ',', $lambda;
my $type=param('type');
my $coordinates=param('coordinates');
my ($type,$lambda,$lambdaWeight,$lambdaWeightGap,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu)
=spherical::process($type,\@lambda,$coordinates);
top();
# my $rank=($type eq 'A')?$#{@$lambda}:scalar(@$lambda);
my $rank=($type eq 'A')?$#{$lambda}:scalar(@$lambda);
print center(h2("Unitary test for $type$rank"));
showG($type,$rank);
my $gap = ($coordinates eq 'gap')?'gap':'';
print br,a({-href=>"javascript:diagram('$type',$rank,'$gap')"},'Dynkin Diagram'), ' and coordinates',p;
print diagramScript();
outputOne($type,$lambda,$lambdaWeight,$lambdaWeightGap,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu,'',1);
print p,a({-href=>'javascript:void(self.close())'},'Close');
}
sub outputOne{
my ($type,$lambda,$lambdaWeight,$lambdaWeightGap,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu,$comment,$detail,$unitaryOnly)=@_;
warn "sub outputOne:$comment:$detail", Dumper($lambda);
# my $rank=($type =~ /A/)?$#{@$lambda}:scalar(@$lambda);
my $rank=($type =~ /A/)?$#{$lambda}:scalar(@$lambda);
my $size=2*$rank;
$detail = ($detail =~ /High|1/)?1:'';
print $message,p if ($message and $detail);
next if ($unitaryOnly and !$result);
return if ($result eq 'stop');
my $resultString= ($result==1)?strong(font{color=>'blue'},'UNITARY'):strong(font{color=>'red'},'NOT UNITARY');
# print br if ($detail);
my $M0;
if ($type eq 'A'){
$M0="GL(".$M_0->[0].")";
}elsif ($type eq 'B'){
$M0="SO(".(2*$M_0->[0]+1).")";
}elsif ($type eq 'C'){
$M0="Sp(".2*$M_0->[0].")";
}elsif ($type eq 'D'){
$M0="SO(".2*$M_0->[0].")";
}
my @rows;
my @row;
@row=qw(M OM h nu);
push @rows, join '', map {td($_)}@row;
# my @indices=(0..$#{@$M_GL});
my @indices=(0..$#{$M_GL});
@indices=sort {$M_GL->[$b] <=> $M_GL->[$a]} @indices;
@row=($M0);
my $cell="(".join ', ', @$O_0;
$cell .= ')';
push @row, $cell;
my @h_0=spherical::flatten($h_0);
$cell = "(".join ', ', @h_0;
$cell.= ")\n";
push @row, $cell;
push @row, ' ';
push @rows, join '', map{td($_)}@row;
my @levi;
foreach my $i (@indices){
my $factor="GL(".$M_GL->[$i].")";
my $cell = $factor;
push @levi, $factor;
# $cell .= ')';
@row= ($cell);
$cell= "(".join ', ', @{$O_GL->[$i]};
$cell .=")";
push @row, $cell;
$cell= "(".join ', ',@{$h_GL->[$i]};
$cell .=")";
push @row, $cell;
push @row, $nu_GL->[$i];
push @rows, join '', map{td($_)}@row;
}
my $tableBody=join '',map {TR($_)}@rows;
my @fullLevi=@levi;
unshift @fullLevi, $M0 if ($M_0->[0]>0);
@rows=();
my @row= ("\nrow length","multiplicity","Z","unitary","nu");
push @rows, join '', map{td($_)}@row;
my @keys=keys %$psd;
foreach my $i (@$O_0){
push @keys, $i unless ($psd->{$i});
}
@keys = sort descending @keys;
if ($detail){
print p,strong('lambda'), ": (", join ',', cleanUp(@$lambda);
print ")";
print ' ',$resultString;
print br,"Weight Coordinates (Bourbaki): [",join ',', @$lambdaWeight;
print ']';
print br,"Weight Coordinates (Gap): [[",join ',',@$lambdaWeightGap;
print "]]";
my $lambdaString= join ',', @$lambda;
my $lambdaWeightString= join ',', @$lambdaWeight;
print br,"\nOrbit O: (", join ', ', @$O;
print ")\n",br;
print "Centralizer Z:";
my @keys=sort descending keys %$Z;
foreach my $i (0..$#keys){
my $j=$keys[$i];
print $Z->{$j}->[1].'('.$Z->{$j}->[0].')';
print 'x' unless ($i==$#keys);
}
print br,"Levi Factor M: ";
print join 'x', @fullLevi;
print table({-border=>1,-cellpadding=>3},$tableBody);
print p;
# return if ($result eq 'stop');
foreach my $i (@keys){
if (defined($psd->{$i})){
my $rowMultiplicity=$Z->{$i}->[0];
my $factor=$Z->{$i}->[1];
my @row=($i,
$rowMultiplicity,
$factor."(".$rowMultiplicity.")",
($psd->{$i} == 1)?'+':'-');
my $cell="(".join ', ', @{$nu->{$i}};
$cell .= ')';
push @row, $cell;
push @rows, join '', map{td($_)}@row;
}else{
push @rows, td($i).td(1).td('O(1)').td('+').td('*');
}
}
$tableBody=join '',map {TR($_)}@rows;
print table({-border=>1,-cellpadding=>3},$tableBody);
print '
';
}else{
print '';
print '| (', join ', ', cleanUp(@$lambda);
print ') | [',join ',', @$lambdaWeight;
print '] | (', join ',', @$O;
print ') | ';
my @keys=sort descending keys %$Z;
foreach my $i (0..$#keys){
my $j=$keys[$i];
print $Z->{$j}->[1].'('.$Z->{$j}->[0].')';
print 'x' unless ($i==$#keys);
}
print " | ", join 'x', @fullLevi;
print " | $resultString |
";
}
}
sub descending{
return ($b <=> $a);
}
sub cleanUp{
my @rv;
foreach my $x (@_){
$x =~ s/\/1$//;
push @rv, $x;
}
return @rv;
}
sub testFile{
warn "sub testfile";
top();
my $file=upload('file');
my $type=param('type');
my $detail=param('detailFileUpload');
my $unitaryOnly=param('unitaryOnlyFileUpload');
my $coordinates=param('coordinates');
$detail = ($detail =~ /High|1/)?1:'';
print center(h2("Unitary test for type $type"));
unless ($detail){
print "",
TR(td(strong('lambda'),br,
strong('standard')),
td({-valign=>'bottom'}
,strong('lambda')
,br
,strong('weight'))
,td({-valign=>'bottom'}
,strong('Orbit O'))
,td({-valign=>'bottom'}
,strong('Centralizer Z'))
,td({-valign=>'bottom'}
,strong('Levi Factor M'))
,td({-valign=>'bottom'}
,strong('Unitary?')));
}
foreach my $line (<$file>){
my ($type,$lambda,$lambdaWeight,$lambdaWeightGap,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu)=processLine($type,$line,$coordinates,$detail);
my $rank = scalar(@$lambdaWeight);
showG($type,$rank) unless (!$detail or ($unitaryOnly and !$result));
outputOne($type,$lambda,$lambdaWeight,$lambdaWeightGap,,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu,'',$detail,$unitaryOnly);
}
print "
";
print a({-href=>'javascript:void(self.close())'},'Close');
}
sub processLine{
warn "sub processLine";
my $type=shift;
my $line=shift;
my $coordinates=shift;
my $detail=shift;
chomp $line;
$line =~ s/#.*//;
$line =~ s/[,\s]+/,/g;
$line =~ s/[^0-9,\.\/]//g;
next unless $line;
my @line = split ',', $line;
@line = sort descending @line;
$line = join ',', @line;
my ($type,$lambda,$lambdaWeight,$lambdaWeightGap,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu)
=spherical::process($type,\@line,$coordinates);
return ($type,$lambda,$lambdaWeight,$lambdaWeightGap,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu);
#
}
sub fileExample{
top();
my $example=param('fileExamples');
my ($typeAndRanks,$files,$fileTitles)=sphericalExamples::getFileExamples();
my $file=$files->{$example};
my $typeAndRank=$typeAndRanks->{$example};
(my $type = $typeAndRank) =~ s/[^A-D]//g;
(my $rank = $typeAndRank) =~ s/[^0-9]//g;
my $coordinates=param('coordinates');
my $gap = ($coordinates eq 'gap')?'gap':'';
my $detail=param('detail');
$detail = ($detail =~ /High|1/)?1:'';
print center(h2("Unitary test for $type$rank"));
print diagramScript();
showG($type,$rank);
print br,a({-href=>"javascript:diagram('$type',$rank,'$gap')"},'Dynkin Diagram'), ' and coordinates', br,
"Testing points from file $file",p;
$file = "../$file";
open(IN,"$file")||die("Can't open $file for input");
unless ($detail){
print '',
TR(td(strong('lambda'),br,strong('standard')),td({-valign=>'bottom'},strong('lambda'),br,strong('weight')),td({-valign=>'bottom'},strong('Orbit O')),td({-valign=>'bottom'},strong('Centralizer Z')),td({-valign=>'bottom'},strong('Levi Factor M')),td({-valign=>'bottom'},strong('Unitary?')));
}
foreach my $line (){
my ($type,$lambda,$lambdaWeight,$lambdaWeightGap,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu)=processLine($type,$line,$detail);
outputOne($type,$lambda,$lambdaWeight,$lambdaWeightGap,,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu,'',$detail);
}
print '
' unless ($detail);
print p,a({-href=>'javascript:void(self.close())'},'Close');
}
sub unipotent{
warn "SUB UNIPOTENT";
top();
my $type=param('unipotentType');
my $rank=param('unipotentRank');
my $detail=param('detailUnipotent');
$detail = ($detail =~ /High|1/)?1:'';
print h3("All unipotent Representations for type $type$rank");
print diagramScript();
showG($type,$rank);
print br,"Showing unitary points only",br if (param('unitaryOnlyUnipotent'));
print br,a({-href=>"javascript:diagram('$type',$rank,'')"},'Dynkin Diagram'), ' and coordinates',p;
unless ($detail){
print "",
TR(td(strong('lambda'),br,strong('standard')),td({-valign=>'bottom'},strong('lambda'),br,strong('weight')),td({-valign=>'bottom'},strong('Orbit O')),td({-valign=>'bottom'},strong('Centralizer Z')),td({-valign=>'bottom'},strong('Levi Factor M')),td({-valign=>'bottom'},strong('Unitary?')));
}
#implement this table:
#type rank G dual size=n partitions parity
#A r SL(r+1) SL(r+1) r+1
#B r SO(2r+1) Sp(2r) 2r odd rows are even
#C r Sp(2r) SO(2r+1) 2r+1 even rows are even
#D r SO(2r) SO(2r) 2r even rows are even
my $n;
my $parity=-1;
if ($type eq 'A'){
$n=$rank+1;
}elsif ($type eq 'B'){
$n=2*$rank;
$parity=1;
}elsif ($type eq 'C'){
$n=2*$rank+1;
$parity=0;
}elsif ($type eq 'B'){
$n=2*$rank;
$parity=0;
}
my @partitions=spherical::partitions($n);
#generate all partitions (as hashes)
foreach my $i (0..$#partitions){
my $p=$partitions[$i];
my %p;
foreach my $j (@$p){
$p{$j}+=1;
}
$partitions[$i]=\%p;
}
if ($parity>=0){
warn "IN PAIERTY $parity";
my @goodPartitions;
P: foreach my $p (@partitions){
R: foreach my $rowLength (keys %$p){
next R if (($rowLength&1) != ($parity&1));
next P if (($p->{$rowLength})&1);
}
push @goodPartitions, $p;
}
@partitions=@goodPartitions;
}
foreach my $i (0..$#partitions){
my $j=$#partitions-$i;
my $p=$partitions[$j];
my @lambda;
foreach my $r (keys %$p){
my $base=($r&1)?frac(1):frac(1/2);
foreach my $i (0..int($r/2)-1){
push @lambda, ($base+$i)x($p->{$r});
if ($type eq 'A'){
push @lambda, (-$base-$i)x($p->{$r});
}
}
}
warn "lambda is now", join ',', @lambda;
if ($type eq 'A'){
push @lambda, (frac(0))x($rank+1-scalar(@lambda));
}else{
push @lambda, (0)x($rank-scalar(@lambda));
}
warn "lambda is now modified", join ',', @lambda;
my ($type,$lambda,$lambdaWeight,$lambdaWeightGap,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu)
=spherical::process($type,\@lambda);
outputOne($type,$lambda,$lambdaWeight,$lambdaWeightGap,,$result,$psd,$message,$Z,$O,$O_0,$M_0,$h_0,$O_GL,$M_GL,$h_GL,$nu_GL,$nu,'',$detail);
}
unless ($detail){print "
";}
print p,a({-href=>'javascript:void(self.close())'},'Close');
}
sub showG{
my ($type,$rank)=@_;
print "\n\nG: ";
if ($type eq 'A'){
print "GL(".($rank+1).")";
}elsif ($type eq 'B'){
print "SO(".(2*$rank+1).")";
}elsif ($type eq 'C'){
print "Sp(".(2*$rank).")";
}elsif ($type eq 'D'){
print "SO(".(2*$rank).")";
}
print " (type $type$rank)";
}
sub intro{
print p, "
This is the beta version the explorer for all classical groups. Please send
bugs to jda\@math.umd.edu.
This is a program for learning about the spherical unitary representations of
a real or p-adic classical group G. A spherical representation of G is given by a
parameter lambda, which is an n-tuple of complex numbers; after a basic reduction we assume
lambda is real. It implements an algorithm in a ",
a({-href=>'http://www.math.cornell.edu/~barbasch/nsph.ps'},'paper'),' by Dan Barbasch.'
,p,"
Choose a type (A-D), enter a parameter lambda and click Test. A popup window will tell you whether the corresponding
irreducible spherical representation of G is unitary, together with some supplementary
data about the representation. Lambda is entered a as a string of real numbers, separated by commas or spaces (it will be made dominant).
For example: .75 1 1/2 0 or 2,1/2,-.5,-2",
p,
"For more information see the ",
a({-href=>'javascript:help()'},'help page'),p,
' There is also a page with information on ',
a({-href=>'rootSystem.cgi'},'Root Systems and Coordinates'),
' and a pdf file on ',
a({-href=>'/papers/sphericalExpository.pdf'}),
'the mathematics behind this program.',
p,
'Return to the ',
a({-href=>'/'},'Atlas'),' home page',
p,
p,
hr;
}