#!/usr/bin/perl
# Generate the geometric product table.  The basic idea is remove common elements and keep only unique elements, and keep track of the sign.

@be = qw(S  EO E1 E2 E3 EI  EO1 EO2 EO3 EOI E12 E13 E1I E23 E2I E3I  EO12 EO13 EO1I EO23 EO2I EO3I E123 E12I E13I E23I EO123 EO12I EO13I EO23I E123I EO123I);
#@be = qw(S E1 E2 E3 E12 E23 E13 E123);
#@be = qw(S E1 E2 E12);

$sz = 32;
#$sz = 8;
#$sz = 4;
my @GParray = map[("") x $sz], 1 .. $sz;

sub AddTerm {
	my($sgn,$alpha,$beta,$gamma) = @_;

	printf("AddTerm($sgn,$alpha,$beta,$gamma)\n");
	if ( length($GParray[$gamma][$beta]) > 0 ) {
		$GParray[$gamma][$beta] = $GParray[$gamma][$beta] . " + ";
	}
	$a = $be[$alpha];
	printf("   alpha is $alpha, a is $a\n");

#	$a =~ s/E/A/;
#	$a =~ s/S/A0/;
	$a =~ s/S/scal/;
#			$a =~ s/S/scal/;
	if ( $sgn < 0 ) {
		$a = "-" . $a;
	}
	printf("   a is $a at $gamma,$beta\n");
	$GParray[$gamma][$beta] = $GParray[$gamma][$beta] . $a;
}

sub geoTerms {
  my($aind,$bind) = @_;
  my($sgn) = 1;
  my($sgn2) = 1;
  my($case,$case2b)=(0,0);
  my($combInd,$combInd2);

  printf("\ngeoTerm($aind,$bind)\n");
  if ( $aind==0 ) {
	  printf("  aind==0\n");
	  $case = 1;
	  $combInd=$bind;
    } elsif ($bind==0 ) {
	  printf("  bind==0\n");
	  $case = 1;
	  $combInd=$aind;
  } else {

    my $astr = $be[$aind];
    my $bstr = $be[$bind];
    
    my @arr=(0,0,0,0,0);
    my @brr=(0,0,0,0,0);

    # Extract which elements are non-zero in each of a and b
    if ( $astr =~ /O/ ) { $arr[0] = 1; }
    if ( $astr =~ /1/ ) { $arr[1] = 1; }
    if ( $astr =~ /2/ ) { $arr[2] = 1; }
    if ( $astr =~ /3/ ) { $arr[3] = 1; }
    if ( $astr =~ /I/ ) { $arr[4] = 1; }

    if ( $bstr =~ /O/ ) { $brr[0] = 1; }
    if ( $bstr =~ /1/ ) { $brr[1] = 1; }
    if ( $bstr =~ /2/ ) { $brr[2] = 1; }
    if ( $bstr =~ /3/ ) { $brr[3] = 1; }
    if ( $bstr =~ /I/ ) { $brr[4] = 1; }

    printf("arr = @arr\n");
    printf("brr = @brr\n");

    # count number of no,ni
    my($nno,$nni);
    $nno = $arr[0] + $brr[0];  $nni = $arr[4]+$brr[4];

    printf(" nno $nnO, nni $nni\n");

    # Some easy cases: terms equal and no no or ni
    if ( $aind==$bind && (
		 ($nno==0 && $nni ==0 )||
		 ($nno==2 && $nni==2) ) ){
	    my($suma);
	    printf(" sum==0, case==0, suma == $suma\n");
	    $suma = $arr[1]+$arr[2]+$arr[3];
	    if ( $suma==0 || $suma == 1 ) {
		    AddTerm(1,$aind,$bind,0);
		    return 1,$bind,0;
	    } elsif ( $suma==2 || $suma==3 ) {
		    AddTerm(-1,$aind,$bind,0);
		    return -1,$bind,0;
	    }
    } elsif ( $aind==$bind && $nno==2 && $nni ==2 ) {
	    printf(" sum==0, nno==2, nni==2\n");
	    AddTerm(-1,$aind,$bind,0);
	    return -1,$bind,0;
    }

    # Another easy case: (no^e1)*(no^e1)=0; (e1^ni)*(e2^ni)=0
    if ( ($nno+$nni)==2 && ($nno==2||$nni==2) ) {
	    printf("  nno+nni==2 and nno=2 or nni=2.  Result is 0\n");
	    return;
    }

    # If $nno+$nni<=1 then just count as outer product (case 1)
    if ( $nno+$nni==0 ) {
	    $case = 0;
    } elsif ( $nno+$nni==1 ) { 
	    $case = 1;
    } elsif ( $nno+$nni==2 ) {
	    # (no^e1^ni)*(e1^e2^e3) = - no^e2^e3 => case 1, outer product
	    if ( ($arr[0]&&$arr[4]) || ($brr[0]&&$brr[4]) ) {
		    $case = 1;
	    } else {
		    # If $nno==1 && $nni==1 then no and ni are in different
		    #  terms and result has two terms:
		    #  (no^e1)*(e1^e2^e3^ni) = -e2^e3 + no^e2^e3^ni
		    $case = 2;

		    $sgn2 = -1*$sgn2;
		    printf("  case 2, sgn2=$sgn2\n");
		    # When we compute sgn2 further down, it just swaps the e_i's and not
		    # the no or ni.  That's good if e1^ni * no^e2 form, but if
		    # no^e1 * e2^e3^ni, then we need to count swaps to get no and ni
		    # adjacent
		    if ( $arr[0] ) {
			    printf("arr[1]+arr[2]+arr[3]+brr[1]+brr[2]+brr[3]=%d\n",$arr[1]+$arr[2]+$arr[3]+$brr[1]+$brr[2]+$brr[3]);
			    if ( ($arr[1]+$arr[2]+$arr[3]+$brr[1]+$brr[2]+$brr[3])%2==1 ) {
				    $sgn2 = -1*$sgn2;
			    }
			    printf("  case 2a, sgn2=$sgn2\n");
		    }
		    printf("  case 2, sgn2=$sgn2\n");
	    }
    } elsif ( $nno+$nni==3 ) {
	    # In this case, only one term, since no,ni cancel, leaving
	    #  that one that is duplicated in the mixed inner/outer term
	    $case = 3;
	    # Case 1: (...^ni)*(no^...)
	    if ( $arr[4] && $brr[0] ) {
		    printf("  arr[4] and brr[0] case\n");
		    $arr[4]=0; $brr[0]=0; $sgn = -1*$sgn;
		    printf("   sgn $sgn\n");
	    } else { # arr[0]==1 && brr[4]==1
		    $arr[0]=0; $brr[4]=0;
		    printf("  arr[4] $arr[4], brr[0] $brr[0]\n");
		    # ==0 since no.ni=-1
		    if ( ($arr[1]+$arr[2]+$arr[3]+$arr[4]+$brr[0]+$brr[1]+$brr[2]+$brr[3])%2==0 ) {
			    $sgn = -1*$sgn;
		    }
	    }
    } elsif ( $nno+$nni==4 ) {
	    # In this case, the no's and ni's cancel, and it's just
	    # the * of the Euclidean part, but you have to get the sign
	    # right: (no^ni)*(no^e1^ni) = -e1, (no^ni)*(no^e1^e2^ni)=e1^e2
	    $case = 4;
	    printf("   case 4\n");
	    printf("   a1+a2+a3+a4+b0+b1+b2+b3 = %d\n",($arr[1]+$arr[2]+$arr[3]+$arr[4]+$brr[0]+$brr[1]+$brr[2]+$brr[3]));
	    if ( ($arr[1]+$arr[2]+$arr[3]+$arr[4]+$brr[0]+$brr[1]+$brr[2]+$brr[3])%2==1 ) {
		    $sgn = -1*$sgn;
	    }
	    $arr[0]=$arr[4]=$brr[0]=$brr[4]=0;
    }

    # Result is entries that exactly 1 of a and b are 1
    my($r,$r2);
    my @rrr=(0,0,0,0,0);
    $r = "E";
    if ( $arr[0]+$brr[0] == 1 ) { $r = $r . 'O'; $rrr[0]=1;}
    if ( $arr[1]+$brr[1] == 1 ) { $r = $r . '1'; $rrr[1]=1;}
    if ( $arr[2]+$brr[2] == 1 ) { $r = $r . '2'; $rrr[2]=1;}
    if ( $arr[3]+$brr[3] == 1 ) { $r = $r . '3'; $rrr[3]=1;}
    if ( $arr[4]+$brr[4] == 1 ) { $r = $r . 'I'; $rrr[4]=1;}
    if ( $case==2 ) {
	    $r2 = "E";
	    if ( $arr[1]+$brr[1] == 1 ) { $r2 = $r2 . '1'; }
	    if ( $arr[2]+$brr[2] == 1 ) { $r2 = $r2 . '2'; }
	    if ( $arr[3]+$brr[3] == 1 ) { $r2 = $r2 . '3'; }
	    printf("  c2: r2=$r2\n");
    }

    # Result of inner product for case 2
    my($r2);
    my @rrr2=(0,0,0,0,0);
    if ( $case==2 ) {
	    $r2 = "E";
	    if ( $arr[1]+$brr[1] == 1 ) { $r2 = $r2 . '1'; $rrr2[1]=1;}
	    if ( $arr[2]+$brr[2] == 1 ) { $r2 = $r2 . '2'; $rrr2[2]=1;}
	    if ( $arr[3]+$brr[3] == 1 ) { $r2 = $r2 . '3'; $rrr2[3]=1;}
    }

    printf(" rrr = @rrr\n");
    my($sum) = $rrr[0] + $rrr[1] + $rrr[2] + $rrr[3] + $rrr[4];
    printf(" sum is $sum\n");
    # if each of no,e1,e2,e3,ni are either in both or neither of
    #  a and b, then no outer product term, only an inner
    #  product term.
    if ( $sum==0 ) {
	    # For (no^ni)*(no^ni), after zero'ing out
	    #  duplicate terms, none of coefficients will be 1.  That
	    #  would result in a '0', but in this case, we want '1'
	    if ( $case==4 ) {
		    # The '0' in AddTerm() is the scalar entry
		    AddTerm(1,$aind,$bind,0);
		    return 1,$bind,0;
	    } else {
		    $sgn = 0;
		    return $sgn,-1,-1;
	    }
    }
    
    # Compute the sign of r due to swaps between a and b
    printf(" P sgn = $sgn\n");
    if ($brr[0] ) {
	    if ( ($arr[1] + $arr[2] + $arr[3] + $arr[4])%2==1 ) { $sgn = -1*$sgn; }
	    printf(" 4 sgn = $sgn\n");
    }
    if ( $brr[1] ) {
	    if ( ($arr[2] + $arr[3] + $arr[4])%2==1 ) { $sgn = -1*$sgn; }
	    printf(" 3 sgn = $sgn\n");
	    if ( $case==2 ) {
		    if ( ($arr[2] + $arr[3])%2==1 ) { $sgn2 = -1*$sgn2; }
	    }
    }
    if ( $brr[2] ) {
	    if ( ($arr[3] + $arr[4])%2==1 ) { $sgn = -1*$sgn; }
	    printf(" 2 sgn = $sgn\n");
	    if ( $case==2 ) {
		    if ( ($arr[3])%2==1 ) { $sgn2 = -1*$sgn2; }
	    }
    }
    if ( $brr[3] ) {
	    if ( ($arr[4])%2==1 ) { $sgn = -1*$sgn; }
	    printf(" 1 sgn = $sgn\n");
    }

    printf("$be[$aind]*$be[$bind] = $r\n");

    printf("  r is $r, sgn is $sgn\n");
    if ( $case==2 ) {
	    printf("  r2 is $r2, sgn is $sgn2\n");
    }
    my($idx);
    for ($idx=0; $idx<=$#be; $idx++) {
	    printf("$idx: $be[$idx], $r\n");
	    if ( $be[$idx] =~ $r ) { last; }
    }
    printf("  idx is $idx\n");
    $combInd = $idx;

    if ( $case==2 ) {
	    printf("  case 2, inner term, r2 is $r2\n");
	    if ( length($r2) == 1 ) {
		    $idx=0;
	    } else {
		    for ($idx=0; $idx<=$#be; $idx++) {
			    printf("$idx: $be[$idx], $r2\n");
			    if ( $be[$idx] =~ $r2 ) { last; }
		    }
	    }
    }
    $combInd2 = $idx;
  }
 done:
  printf("sgn $sgn, bind $bind, combInd $combInd\n");
  printf(" case is $case\n");
  if ($sgn != 0 ) {
	  AddTerm($sgn,$aind,$bind,$combInd);
	  # the inner product term for case 2
	  if ( $case==2 ) {
		  printf("  case 2, inner term, r2 is $r2, sgn2 = $sgn2\n");
		  AddTerm($sgn2,$aind,$bind,$combInd2)
	  }
  }
  return $sgn,$bind,$combInd;
}


for ($i=0; $i<$sz; $i++) {
	for ($j=0; $j<$sz; $j++) {
		printf("\n $be[$i]^$be[$j]");
		my($sgn,$bi,$ci) = geoTerms($i,$j);
	}
}

printf("sz is $sz\n");

for ($i=0; $i<$sz; $i++) {
	for ($j=0; $j<$sz; $j++) {
		if ( length($GParray[$i][$j])>=2 ) {
			printf(" %11s ",$GParray[$i][$j]);
		} else {
			printf(" %11s ", "0");
		} 
	}
	printf(";\n");
}
#use Data::Dump 'dd'; dd @Aarray;
