#!/usr/local/bin/perl -w
# permalist2 
#
# makes alist matrices based on permutations.
#
# permalist2 differs from permalist in that it makes the left hand
# columns into weight 2 identity matrices, regardless of the weight of
# other columns. This is like construction "2" Gallager codes.
#
# permalist3 makes the rows nonuniform weight and makes the 
# number of weight 2 cols smaller than is given by permalist2
#
# write them to code/GHC, please
#
#  reads in 
#  l  -  number of cols in constituent code, e.g. 16
#  t  -  weight per column e.g. 2
#  Nl -  block length divided by l
#
#  - outputs an alist corresponding to a set of permutation matrices thus:
#
# if as it must be, t=3, then it is this:
#  0 1 1 1 1 1 1 1 
#  1 P Q R S T U V
#  1 W X Y Z A B C
#
# l defines the weight per row in the bulk.
#  t=3 (fixed) defines the weight per col of the 
#  right hand part. 
# this  means M = t*Nl 
#   and       N = l * Nl
#
# the perms are constructed assuming that Nl+1 is a prime and Nl is even. 
#
# here are some primes
#
# 101
# 211
# 223
# 227
# 307
# 401
# 503
# 1009
# 1277
# 2003
# 2131
# 2137 
# 3001
# 4001
# 5003
# 10007

$seed = 0 ; 
eval "\$$1=\$2" while @ARGV && $ARGV[0]=~ /^(\w+)=(.*)/ && shift;

print STDERR "setting t to 3\n" ; 
$t = 3 ;
srand ( $seed ) ;
$N = int ( $Nl *  $l ) ;
$M = $Nl * $t ;
if ( $N * $M <= 0 ) {
    print "usage: \n  permalist3.p l=4 t=3 Nl=100 seed=0 > alist.file\n" ;
    print "  permalist3.p l=4 t=3 Nl=400 > alist.file\n  (Nl+1 prime)\n" ;
    exit(0);
}

$NM = $Nl ; # number of short cols
$Nsub = $N - $NM ;
$MM = $Nl ; # number of short rows
$Msub = $M - $MM ; 
$head = $N." ".$M."\n" ;
$head .= $t." ".$l."\n" ;
$head .= "2 "x$NM ; # some cols have weight 2, some have weight t
$head .= "$t "x$Nsub ; # some cols have weight 2, some have weight t
$head .= "\n" ;
$lmo = $l -1 ;
$head .= "$lmo "x$MM ; #
$head .= "$l "x$Msub ; #
$head .= "\n" ;
print $head ;

# make null lists 
for ( $n = 1 ; $n <= $N ; $n ++ ) {
    $nlist[$n] = "" ; 
    $numnlist[$n] = 0 ;
}
for ( $m = 1 ; $m <= $M ; $m ++ ) {
    $mlist[$m] = "" ; 
    $nummlist[$m] = 0 ;
}

sub nullperm {
    for ( $nl = 1 ; $nl <= $Nl ; $nl ++ ) {
	$fto[$nl] = 0 ;
    }
}
sub checkperm { # fto is the frequency of coming to this n
    for ( $nl = 1 ; $nl <= $Nl ; $nl ++ ) {
	if ( $fto[$nl] != 1 ) {
	    print STDERR  "perm $q not valid $nl\n" ; 
	    for ( $n = 1 ; $n <= $Nl ; $n ++ ) { 
		print STDERR "$n to $p[$n]\n" ;
	    }
	    exit(0) ; 
	}
    }
}

# the first Nl columns --- put in zero , I , I .
for ( $nl = 1 ; $nl <= $NM ; $nl ++ ) {
    $n = $nl ;
    $m = $nl + $Nl ; 
    # put m and n on each others lists 
    $nlist[$n] .= $m."\t" ;
    $mlist[$m] .= $n."\t" ;
	$numnlist[$n] ++ ;
	$nummlist[$m] ++ ;
     $m = $nl + $Nl + $Nl ; 
    # put m and n on each others lists 
    $nlist[$n] .= $m."\t" ;
    $mlist[$m] .= $n."\t" ;
	$numnlist[$n] ++ ;
	$nummlist[$m] ++ ;
}

# set up identity
&nullperm();
for ( $nl = 1 ; $nl <= $Nl ; $nl ++ ) {
    $from = $nl ;
    $to = $nl ; 
    $p[$from] = $to ; 
    $pi[$to] = $from ;  # the inverse, in case it is useful
    $fto[$to] ++ ;
}
&checkperm();

# rest of first row
for ( 
# define what the offset of our square is
$moff = 0 , $noff = $NM , $ll = 2 ; 
     $ll <= $l ;
     $ll ++ , $noff += $Nl ) {

# put in this perm
    &permadd();
}

for ( $q = 0 ; $q <= $Nl ; $q ++ ) {
    $usedq[$q] = 0 ;
} $usedq[1] = 1 ;
$usedq[0] = 1 ;
$usedq[$Nl] = 1 ;

for ( $tt = 2 ; $tt <= $t ; $tt ++ ) {
# do the same for the next row bottom left ...
    $moff += $Nl ; $noff = $NM ;

# OK, now we need some interesting perms
# 
# one idea is to assume that Nl+1 is prime.
# then let i -> q i mod (Nl+1)
    for ( 
# define what the offset of our square is
	 $ll = 2 ; 
	 $ll <= $l ;
	 $ll ++ , $noff += $Nl ) {
	
	do {
	    $q = int (  rand (( $Nl -1 )/2.0) ) + 1 ;
	} while ( $usedq[$q] ) ;
	$usedq[$q] ++ ;
	print STDERR "--- $q ---\n" ;

# invent a perm
	&nullperm();
	for ( $nl = 1 ; $nl <= $Nl ; $nl ++ ) {
	    $from = $nl ;
	    $to = ( $nl * $q ) % ( $Nl + 1 ) ; 
	    $p[$from] = $to ; 
	    $pi[$to] = $from ;  # the inverse, in case it is useful
	    $fto[$to] ++ ;
	}
	&checkperm();

# put in this perm
	&permadd();
    }
}

# append zeros to short lines
for ( $n = 1 ; $n <= $N ; $n ++ ) {
    while ( $numnlist[$n] < $t ) {
	$nlist[$n] .= "0\t" ;
	$numnlist[$n] ++ ;
    }
}
for ( $m = 1 ; $m <= $M ; $m ++ ) {
    while ( $nummlist[$m] < $l ) {
	$mlist[$m] .= "0\t" ;
	$nummlist[$m] ++ ;
    }
}

sub permadd {
    for ( $nl = 1 ; $nl <= $Nl ; $nl ++ ) {
	$n = $noff + $nl ;
	$m = $p[$nl] + $moff ; 
	# put m and n on each others lists 
	$nlist[$n] .= $m."\t" ;
	$mlist[$m] .= $n."\t" ;
	$numnlist[$n] ++ ;
	$nummlist[$m] ++ ;
    }
}

# finish lists 
for ( $n = 1 ; $n <= $N ; $n ++ ) {
    $nlist[$n] =~ s/\t$/\n/ ; 
    print $nlist[$n] ; 
}
for ( $m = 1 ; $m <= $M ; $m ++ ) {
    $mlist[$m] =~ s/\t$/\n/ ; 
    print $mlist[$m] ; 
}