#!/usr/bin/perl
# Generate the outer 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);

sub geoTerms {
  my($aind,$bind) = @_;
  my($v) = 1;
    my($sigO,$sig1,$sig2,$sig3,$sigI)=(0,0,0,0,0);

  printf("\ngeoTerm($aind,$bind)\n");
  if ( $aind==0 ) {
  printf("  aind==0\n");
    $combInd=$bind;
  } elsif ($bind==0 ) {
  printf("  bind==0\n");
  $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");

    # If two entries are non-zero, then result is 0
    if ( $arr[0]+$brr[0] == 2 ) { return 0,-1,-1; }
    if ( $arr[1]+$brr[1] == 2 ) { return 0,-1,-1; }
    if ( $arr[2]+$brr[2] == 2 ) { return 0,-1,-1; }
    if ( $arr[3]+$brr[3] == 2 ) { return 0,-1,-1; }
    if ( $arr[4]+$brr[4] == 2 ) { return 0,-1,-1; }
    
    # Result is entries that exactly 1 of a and b are 1
    my($r);
    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;}


    printf("rrr = @rrr\n");
    my($sum) = $rrr[0] + $rrr[1] + $rrr[2] + $rrr[3] + $rrr[4];
    printf("sum is $sum\n");
    if ( $sum==0 ) {
	    $v = 0;
	    return $v,-1,-1;
    }
    
    # Compute the sign of r due to swaps between a and b
    $s=1;
    if ($rrr[0] && $brr[0] ) {
	    if ( ($arr[1]*$rrr[1] + $arr[2]*$rrr[2] + $arr[3]*$rrr[3] + $arr[4]*$rrr[4])%2==1 ) { $s =$s*-1; }
    }
    if ($rrr[1] && $brr[1] ) {
	    if ( ($arr[2]*$rrr[2] + $arr[3]*$rrr[3] + $arr[4]*$rrr[4])%2==1 ) { $s =$s*-1; }
    }
    if ($rrr[2] && $brr[2] ) {
	    if ( ($arr[3]*$rrr[3] + $arr[4]*$rrr[4])%2==1 ) { $s =$s*-1; }
    }
    if ($rrr[3] && $brr[3] ) {
	    if ( ($arr[4]*$rrr[4])%2==1 ) { $s =$s*-1; }
    }

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

    printf("  r is $r, v is $v\n");
    my($idx);
    for ($idx=0; $idx<=$#be; $idx++) {
	    printf("$dxi: $be[$idx], $r\n");
	    if ( $be[$idx] =~ $r ) { last; }
    }
    printf("  idx is $idx\n");
    $combInd = $idx;
  }
  printf("v $v, bind $bind, combInd $combInd\n");
  return $v,$bind,$combInd;
}


$sz = 32;
#$sz = 8;
#$sz = 4;
my @array = map[(0) x $sz], 1 .. $sz;
my @Aarray = map[(-1) x $sz], 1 .. $sz;


#printf("array is @array\n");
#use Data::Dump 'dd'; dd @array;

for ($i=0; $i<$sz; $i++) {
  for ($j=0; $j<$sz; $j++) {
      printf(" $be[$i]^$be[$j]");
	my($v,$bi,$ci) = geoTerms($i,$j);
      printf("bi $bi, ci $ci\n");
      if ( $bi != -1 && $ci != -1 ) {
	      $array[$ci][$bi] = $v; $Aarray[$ci][$bi]=$i;
      }
	printf("vls = $v,$bi,$ci\n");
  printf("\n");
  }
  printf("\n");
}

for ($i=0; $i<$sz; $i++) {
	for ($j=0; $j<$sz; $j++) {
		printf(" %3d ",$array[$i][$j]);
	}
	printf("\n");
}
printf("\n");
#use Data::Dump 'dd'; dd @array;

for ($i=0; $i<$sz; $i++) {
	for ($j=0; $j<$sz; $j++) {
		printf(" %3d ",$Aarray[$i][$j]);
	}
	printf("\n");
}

for ($i=0; $i<$sz; $i++) {
	for ($j=0; $j<$sz; $j++) {
		if ( $Aarray[$i][$j]>=0 ) {
			$a = $be[$Aarray[$i][$j]];
#			$a =~ s/E/A/;
#			$a =~ s/S/A0/;
			$a =~ s/S/scal/;
			if ( $array[$i][$j] < 0 ) {
				$a = "-" . $a;
			}
			printf(" %6s ",$a);
		} else {
			printf(" %6s ", 0);
		}
	}
	printf(";\n");
}
#use Data::Dump 'dd'; dd @Aarray;
