#! /usr/bin/perl

$debug=0;
 
#$word = "1, 2, 3, 4, -5";
#$word = "1, 2, 3, -4, 1, -2, 3, 4, 2";
#$word = "1, 2, 3, 4, 5, 5, 4, 3, 2, 1";
#$word = "1, 2, 3, 4, 5";

$word = &reformword(@ARGV[0]);
print "map is $word\n";

my(@map) = split(/, /, $word);

@train=(1, 1, 1, 0, 0, 0,
	1, 1, 1, 0, 0, 0,
	1, 1, 1);

for($i=1; $i<100; $i++){
    $stretch = 1;
    foreach $ref (@map){
	if($ref<0){
	    $curve = (-1 * $ref);
	    $times = -1;
	}
	else{
	    $curve = $ref;
	    $times = 1;
	}
	($stretchsub, @train) = &normalize (&Dehn(@train, $curve, $times));
	$stretch = $stretch * $stretchsub;
    }

    if ($debug){
	print "$i ($stretch) :";
	print join " ", @train;
	print "\n";
    }
    last if (abs($stretch - $stretch_old) < 0.00000001);
    $stretch_old = $stretch;
}

if($i>=99){
    print "train track didn't converge\n";
}
else{
    print "stretch factor is $stretch\n";
    print "${i}-th train track is:\n";
    print join " ", @train;
    print "\n";
}


#---------------------------------------------------------------------------
# Dehn
#---------------------------------------------------------------------------
sub Dehn{
    my($a11, $a12, $a13, $a22, $a23, $a33,
       $b11, $b12, $b13, $b22, $b23, $b33,
       $t1, $t2, $t3, $curve, $times) = @_;
    my($c11, $c12, $c13, $c22, $c23, $c33,
       $d11, $d12, $d13, $d22, $d23, $d33,
       $e11, $e12, $e13, $e22, $e23, $e33,
       $f11, $f12, $f13, $f22, $f23, $f33,
       $u1, $u2, $u3, $u4, $u5,
       $v1, $v2, $v3, $v4, $v5,
       $cross);

    if($curve==1){
	$cross = $a12 + $a23;
	$t1 = $t1 + $times * $cross;
	return ($a11, $a12, $a13, $a22, $a23, $a33,
		$b11, $b12, $b13, $b22, $b23, $b33,
		$t1, $t2, $t3);
    }
    elsif($curve==2){
	($u1, $u2, $c11, $c12, $c13, $c23)
	    = first_elementary_move($t1, $t2, $a11, $a12, $a13, $a23);
	$cross = $c12 + $c23;
	$u1 = $u1 + $times * $cross;
	($v1, $v2, $e11, $e12, $e13, $e23)
	    = inverse_first_elementary_move($u1, $u2, $c11, $c12, $c13, $c23);
	return ($e11, $e12, $e13, 0, $e23, 0,
		$b11, $b12, $b13, $b22, $b23, $b33,
		$v1, $v2, $t3);	
    }
    elsif($curve==3){
	($u1, $u2, $u3, $u4, $u5,
	 $c11, $c12, $c13, $c22, $c23, $c33,
	 $d11, $d12, $d13, $d22, $d23, $d33)
	    = second_elementary_move($t2, $t1, 0, $t3, 0,
				     $a11, $a12, $a13, $a22, $a23, $a33,
				     $b11, $b12, $b13, $b22, $b23, $b33);
	$cross = 2*$c11 + $c12 + $c13;
	$u1 = $u1 + $times*$cross;

	($v1, $v2, $v3, $v4, $v5, 
	 $e11, $e12, $e13, $e22, $e23, $e33,
	 $f11, $f12, $f13, $f22, $f23, $f33)
	    = inverse_second_elementary_move($u1, $u2, $u3, $u4, $u5, 
				     $c11, $c12, $c13, $c22, $c23, $c33,
				     $d11, $d12, $d13, $d22, $d23, $d33);
	return ($e11, $e12, $e13, $e22, $e23, $e33,
		$f11, $f12, $f13, $f22, $f23, $f33,
		$v2+$v3, $v1, $v4+$v5);
    }
    elsif($curve==4){
	($u1, $u2, $c11, $c12, $c13, $c23)
	    = first_elementary_move($t3, $t2, $b11, $b12, $b13, $b23);
	$cross = $c12 + $c23;
	$u1 = $u1 + $times * $cross;
	($v1, $v2, $e11, $e12, $e13, $e23)
	    = inverse_first_elementary_move($u1, $u2, $c11, $c12, $c13, $c23);
	return ($a11, $a12, $a13, $a22, $a23, $a33,
		$e11, $e12, $e13, 0, $e23, 0,
		$t1, $v2, $v1);	
    }
    elsif($curve==5){
	$cross = $b12+$b23;
	$t3 = $t3 + $times * $cross;
	return ($a11, $a12, $a13, $a22, $a23, $a33,
		$b11, $b12, $b13, $b22, $b23, $b33,
		$t1, $t2, $t3);	
    }
    elsif($curve==6){
	$cross = 2 * $a11 + $a12 + $a13;
	$t2 = $t2 + $times * $cross;
	return ($a11, $a12, $a13, $a22, $a23, $a33,
		$b11, $b12, $b13, $b22, $b23, $b33,
		$t1, $t2, $t3);	
    }
    else{
	print("WARNING: curve $curve is not implemented. : function Dehn_twist.\n");
    }
}
# end Dehn


sub action{
    my($word, @train) = @_;
    my(@map) = split(/, /, $word);
    my($ref, $curve, $times);

    foreach $ref (@map){
	    if($ref<0){
		$curve = (-1 * $ref);
		$times = -1;
	    }
	    else{
		$curve = $ref;
		$times = 1;
	    }
	    @train = (&Dehn(@train, $curve, $times));
	}
    return(@train);
}
# end action

sub normalize{
    my($k11, $k12, $k13, $k22, $k23, $k33,
	  $l11, $l12, $l13, $l22, $l23, $l33,
	  $t1, $t2, $t3)= @_;
    my($c1, $c2, $c3, $total);

    $c1 = $k12 + $k23;		# $k22=0
    $c2 = 2*$k11 + $k12 + $k13;
    $c3 = $l12 + $l23;		# $l22=0

    $total = $c1 + $c2 + $c3 + abs($t1) + abs($t2) + abs($t3);
    if($total == 0){
	$total = 1;
    }
    return($total,
	   $k11/$total, $k12/$total, $k13/$total, $k22/$total, $k23/$total, $k33/$total,
	   $l11/$total, $l12/$total, $l13/$total, $l22/$total, $l23/$total, $l33/$total,
	   $t1/$total, $t2/$total, $t3/$total);
}
# end normalize

sub action_normalize{
    my($word, @train) = @_;
    my(@map) = split(/, /, $word);
    my($ref, $curve, $times, $stretch, $stretchsub);
    $stretch = 1;

    foreach $ref (@map){
	if($ref<0){
	    $curve = (-1 * $ref);
	    $times = -1;
	}
	else{
	    $curve = $ref;
	    $times = 1;
	}
	($stretchsub, @train) = &normalize (&Dehn(@train, $curve, $times));
	$stretch = $stretch * $stretchsub;
    }
    print("stretch is $stretch. : sub_action\n");
    return(@train);
}
# end action_normalize



#---------------------------------------------------------------------------
# Elementary
#---------------------------------------------------------------------------

sub hat{
    my($hat) = pop(@_);
    my($foo);
    foreach $foo (@_){
	$hat = $foo if $hat > $foo;
    }
    return $hat;
}
#end hat

sub cup{
    my($cup) = pop(@_);
    my($foo);
    foreach $foo (@_){
	$cup = $foo if $cup < $foo;
    }
    return $cup;
}
#end cup

## first elementary move on pants. ##
sub first_elementary_move{
    my($t1, $t2, $c11, $c12, $c13, $c23)= @_;
    my($qt1, $qt2, $qc11, $qc12, $qc13, $qc23);

    my($sgn)=1;
    my($L) = $c12;

    $qc11 = &cup($L- abs($t1), 0);
    $qc12 = $L + $c11 - $qc11;
    $qc13 = $qc12;
    $qc23 = abs($t1) + $qc11 - $L;
    $qt2  = $t2 + $c11 + &cup( &hat($L-$qc11, $t1), 0);

    if ($t1>0){$sgn = 1;}
    else {$sgn = -1 ;}

    $qt1 = -1 * $sgn * ($c23 + $L - $qc11);

    return ($qt1, $qt2, $qc11, $qc12, $qc13, $qc23);

}
# end first_elementary_move


## inverse first elementary move on pants. ##
sub inverse_first_elementary_move{
    my($t1, $t2, $c11, $c12, $c13, $c23)= @_;
    my($qt1, $qt2, $qc11, $qc12, $qc13, $qc23);

    my($sgn) = 1;
    my($L) = $c12;

    $qc11 = &cup($L-abs($t1), 0);
    $qc12 = $L + $c11 - $qc11;
    $qc13 = $qc12;
    $qc23 = abs($t1) + $qc11 - $L;
    $qt2  = $t2 + $c11 + &cup( &hat($L-$qc11, $t1), 0) - $qc11 - $qc12;
    if ($t1>0){$sgn = 1;}
    else {$sgn = -1 ;}
    $qt1 = -1 * $sgn * ($c23 + $L - $qc11);

    return ($qt1, $qt2, $qc11, $qc12, $qc13, $qc23);
}
# end of inverse_first_elementary_move

sub inverse_second_elementary_move{
    my($qT1, $qT3, $qT5, $qT2, $qT4,
	  $qK11, $qK12, $qK13, $qK22, $qK23, $qK33,
	  $qL11, $qL12, $qL13, $qL22, $qL23, $qL33)=@_;
    
    my($rT1, $rT4, $rT2, $rT5, $rT3,
     $rL11, $rL12, $rL13, $rL22, $rL23, $rL33,
     $rK11, $rK12, $rK13, $rK22, $rK23, $rK33)
	=&second_elementary_move($qT1, $qT2, $qT3, $qT4, $qT5,
				 $qK11, $qK12, $qK13, $qK22, $qK23, $qK33,
				 $qL11, $qL12, $qL13, $qL22, $qL23, $qL33);
    return ($rT1, $rT2, $rT3, $rT4, $rT5, 
	    $rK11, $rK12, $rK13, $rK22, $rK23, $rK33,
	    $rL11, $rL12, $rL13, $rL22, $rL23, $rL33);

}
# end inverse_second_elementary_move ##

sub second_elementary_move{
    my($T1, $T2, $T3, $T4, $T5, 
	  $K11, $K12, $K13, $K22, $K23, $K33,
	  $L11, $L12, $L13, $L22, $L23, $L33)=@_;
    my($K, $L);
    my($qk1, $qk2, $qk3, $qk4, $qk5, $qk6);
    my($ql1, $ql2, $ql3, $ql4, $ql5, $ql6);
    my($qt1, $qt2, $qt3, $qt4, $qt5);
    my($c1, $c2, $c3, $c4, $c5, $c6);
    my($sgn);

    $K = $K11 + $T1;
    $L = $L11 + $T1;

    $qk1 = $K22 + $L33 + &cup($L-$K13, 0) + &cup(0-$L-$L12, 0);
    $qk4 = &cup(&hat($L, &hat($L11, $K13-$L12-$L)), 0);
    $qk6 = &cup(&hat(0-$L, &hat($K11, $L12-$K13+$L)), 0);
    $qk5 = &cup(&hat(&hat($K13,$L12), &hat($K13-$L, $L12+$L)), 0);
    $qk2 = (-2* $qk4) - $qk5 + $K13 + $K23 + (2*$K33);
    $qk3 = (-2* $qk6) - $qk5 + $L12 + $L23 + (2*$L22);

    $ql1 = $L22 + $K33 + &cup($K-$L13, 0) + &cup(0-$K-$K12, 0);
    $ql4 = &cup(&hat($K, &hat($K11, $L13-$K12-$K)), 0);
    $ql6 = &cup(&hat(-$K, &hat($L11, $K12-$L13+$K)), 0);
    $ql5 = &cup(&hat(&hat($L13,$K12), &hat($L13-$K, $K12+$K)), 0);
    $ql2 = (-2* $ql4) - $ql5 + $L13 + $L23 + (2*$L33);
    $ql3 = (-2* $ql6) - $ql5 + $K12 + $K23 + (2*$K22);

## ***** t2 ***** ##
    if($T1>=$K13+$K11+$K12+$K11){
	$qt2 = $T2 + $K33 + $K13;
    }
    elsif($T1>=0){
	$c4 = &hat($K13, $T1);
	$c1 = &cup($K13 - $T1, 0);
	$c2 = &hat($c1, $L11);
	$c3 = &hat( &cup($c1 - $L11 - $L12, 0), $L11);
	$qt2  = $T2 + $K33 + $c4 + $c2 - $c3;
    }
    elsif($T1<0 && -1*$T1<$K13+$K11+$K12+$K11 ){
	$c1 = &cup( -1*$T1 - $K11 - $K12 - $K11, 0);
	$c2 = $K13 - $c1;
	$c3 = &hat( &cup( $L11 + $T1, 0), $c2);
	$c4 = &hat( &cup($c2 - $c3 - $L12, 0), $c3);
	$qt2 = $T2 + $K33 + $c3 - $c4 ;
    }
    elsif($T1<0 && -1*$T1>=$K13+$K11+$K12+$K11){
	$qt2 = $T2+$K33;
    }
    else{
	print("WARNING : not correct value in $qt2: function second_elementary_move.\n");
    }
    
## ***** t5 ***** ##
    if($T1>=$L13+$L11+$L12+$L11){
	$qt5 = $T5 + $L33 + $L13;
    }
    elsif($T1>=0){
	$c4 = &hat($L13, $T1);
	$c1 = &cup($L13 - $T1, 0);
	$c2 = &hat($c1, $K11);
	$c3 = &hat( &cup($c1 - $K11 - $K12, 0), $K11);
	$qt5  = $T5 + $L33 + $c4 + $c2 - $c3;
    }
    elsif($T1<0 && -1*$T1<$L13+$L11+$L12+$L11 ){
	$c1 = &cup( -1*$T1 - $L11 - $L12 - $L11, 0);
	$c2 = $L13 - $c1;
	$c3 = &hat( &cup( $K11 + $T1, 0), $c2);
	$c4 = &hat( &cup($c2 - $c3 - $K12, 0), $c3);
	$qt5 = $T5 + $L33 + $c3 - $c4 ;
    }
    elsif($T1<0 && -1*$T1>=$L13+$L11+$L12+$L11){
	$qt5 = $T5+$L33;
    }
    else{
	print("WARNING : not correct value in $qt5: function second_elementary_move.\n");
    }
    
## ***** t3 ***** ##
    if($T1>=0){
	$qt3 = $T3;
    }
    elsif(-1*$T1<$K13+$K11+$K12+$K11){
	$c1 = &cup(0, -1*$T1-$K11);
	$c2 = &hat($c1, $K12);
	$qt3 = $T3 - $c2;
    }
    elsif(-1*$T1>=$K12+$K11+$K11+$K13){
	$qt3 = $T3 - $K12;
    }
    else{
	print("WARNING : not correct value in $qt3: function second_elementary_move.\n");
    }

## ***** t4 ***** ##
    if($T1>=0){
	$qt4 = $T4;
    }
    elsif(-1*$T1<$L13+$L11+$L12+$L11){
	$c1 = &cup(0, -1*$T1-$L11);
	$c2 = &hat($c1, $L12);
	$qt4 = $T4 - $c2;
    }
    elsif(-1*$T1>=$L12+$L11+$L11+$L13){
	$qt4 = $T4 - $L12;
    }

## ***** t1 ***** ##
    if ($T1 >= $K13+$K11+$K12+$K11){
	$qt1 = -1*$T1 - $K11 - $L11 - $K33 - $L33;
    }
    elsif($T1 >= 0){
	$c1 = &cup($L13 - ($K12 + $K11 + $T1), 0);
	$c2 = &hat($K11, $c1);
	$c3 = &cup($K13 - ($L12 + $L11 + $T1), 0);
	$c4 = &hat($L11, $c3);
	$qt1 = -1*$T1 - ($K11-$c2) - ($L11-$c4) - $K33 - $L33;
    }
    elsif($T1 < 0 && -1*$T1 >= $K13+$K11+$K12+$K11){
	$qt1 = $T1 + $K11 + $L11 + $K12 + $L12 - $K33 - $L33;
    }
    else{ 
	if ($L+$K+ $ql6- $ql4+ $qk6- $qk4 < 0){
	    $sgn = -1;
	}
	elsif ($L+$K+ $ql6- $ql4+ $qk6- $qk4 > 0){
	    $sgn = 1;
	}
	elsif ($L12 - (2* $qk6) -  $qk5 != 0){
	    $sgn = 1;
	}
	else {
	    $sgn = -1;
	}
	$qt1 = $K22 + $L22 + $K33 + $L33 - 
	    ( $ql1 +  $qk1 + ( $qt2 -$T2) + ( $qt5 - $T5))
		+ ($sgn * ($T1 +  $ql6 +  $qk6));
    } 
    
    return ($qt1, $qt2, $qt3, $qt4, $qt5, 
	    $qk1, $qk2, $qk3, $qk4, $qk5, $qk6,
	    $ql1, $ql2, $ql3, $ql4, $ql5, $ql6);

}
# end second_elementary_move ##


#---------------------------------------------------------------------------
#  etc
#---------------------------------------------------------------------------
sub reformword{
    my($word) = @_;
    chomp($word);
    $word =~ s/[^\-\,1-6]//g;
    
    $word =~ s/1/1,/g;	
    $word =~ s/2/2,/g;
    $word =~ s/3/3,/g;
    $word =~ s/4/4,/g;
    $word =~ s/5/5,/g;
    $word =~ s/6/6,/g;
    $word =~ s/,+/,/g;	

    $word =~ s/-,/-/g;	
    $word =~ s/-+/-/g;	
    $word =~ s/- *$//g;	

    $word =~ s/^,+//g;	
    $word =~ s/,+$//g;	
    $word =~ s/,/, /g;	

    return($word);
}
# end reformword