#!/usr/bin/perl

# Este código es muy antiguo, y por lo tanto,
# me parece muy malo. Hay que depurarlo y reescribirlo
# 1. mejores nombres de variables
# 2. listas que empiecen en el índice 0
# 3. subrutina de dibujo correcta
# 4. cálculo de costes escalado correctamente
# Los costes buenos deben tener en cuenta: 1) coste de los dptos spaguetti tipo CRAFT
# Esto es sencillo: si sumanos las dos paredes largas y las dos cortas y restamos, es el nivel de desproporción
# Y simplificando debería ser igual: restar a la más larga la más corta (que no es de la diagonal)
#                                          2) distancias entre centros de dptos por la diagonal
# 5. warnings on, strict on
# 6. con el comando de sistema 'tput' obtener y usar dimensiones de xterm
# 7. guardar también a fichero la mejor solución. Sobreescribir vale
# 8. No hay dos bahías sino dos alas: una grande y una pequeña, por lo tanto igual no hace falta hacer permutaciones
# sino colocar alternativamente o por orden (esto hay que pensarlo bien). Lo primero de cada iteración es la 
# diagonal aleatoria.

use 5.030;

my $DEBUG = 0;

my $cols = `tput cols`;
chomp $cols;
my $lines = `tput lines`;
chomp $lines;
$lines--;
print "Área de dibujo = $lines x $cols\n";

my @dptos = ( 2800, 6300, 2100, 5600, 1400, 2801, 1960, 2802, 1540, 90, 130, 210 );
my @number = 0..scalar(@dptos)-1;
my $sum;
$sum += $_ for (@dptos);
print "Área a construir $sum\n";

my @char = "a" .. "z";

my $L=135; # length
my $W=210; # width

# my $coef = 16/9; SAMSUNG 24
my $factor_de_pantalla = $cols / (2*$lines);    # suponemos que 2 columnas hacen igual a una fila
my $factor_real = $W / $L;

if ($factor_real > $factor_de_pantalla) {
    $lines -= int ( ($factor_real - $factor_de_pantalla) * $lines ); 
}else{
    $cols -= int ( ($factor_de_pantalla - $factor_real) * $cols );
}
print "Planta dibujada = $lines x $cols\n";
my $superficie = $lines * $cols - $cols;
# for (1..$nd){
#    $area[$_] = int ( .53 + ($superficie / $sum) * $sdpts[$_-1] ); # truco artero para redondeo
#    $area[0] += $area[$_];
# }
# print "Área asignada = $area[0]\n";
# my @area = sort {$a <=> $b} dhondt( $superficie, scalar( @dptos ), \@dptos);
my @area = Saint_Lague ( $superficie, \@dptos );
if ($DEBUG){
    say "@dptos";
    say "@area";
}
my $sum2;
$sum2 += $_ for (@area);
die "ERROR GORDO" if ($sum2 != $superficie);
print "El número total de bloques es $sum2\n";

my @sqarea;
for (@area){
    push @sqarea, sqrt($_);
}
my @rpoints;
my @diag;
my @xy;
my $result = 9e99;
my $it=0;
my $r;

while (1){
    $it++;
    rpoints();
    diagonal();
    dibuja();
    $r = evalua();
    if ($r < $result){
	$result = $r;
	guarda();
	print "$0 iteration $it: error $r\n";
    }
    permutas();
}
exit 0;



sub rpoints {
    @rpoints=();
    push @rpoints, -(1 + rand()*$lines/2);
    push @rpoints, 1;
    push @rpoints, -(1+ $lines/2 + rand()*$lines/2);
    push @rpoints, $cols;
    if ($DEBUG){ say "@rpoints"; }
}



sub diagonal {
#    my @points = @_;
#    if (scalar @points != 4) { 
#	warn "Error de número de puntos"; 
#	return -1; 
#    }
    my ($l1,$c1,$l2,$c2) = @rpoints;
    @diag=();
# ECUACIÓN DIAGONAL 1) recta (y-y1)/(x-x1) = (y2-y1)/(x2-x1)
#                         y = y1 + (x-x1)*(y2-y1)/(x2-x1)

    for my $j (1..$cols){
        $diag[$j] = 1+int( abs( $l1 + ($j-$c1)*($l2-$l1)/($c2-$c1) ) );
    }
	
    if ($DEBUG) { 
	say "@diag"; 
	say "length = ", scalar(@diag)-1;
    }
}

# La pendiente mínima es 0 y la máxima la de la máxima diagonal -> radomizar
# puntos de máxima pendiente ($lines, 1) hasta (1, $cols), pero esto cambia la geometría
# luego debería ser desde el punto 1 (1, -$lines) hasta el punto 2 ($cols, 1)
#


sub Saint_Lague {
    my ($seats, $votes) = @_;
    my @V = @$votes;
    my @s = (0) x scalar @V; 
    my ($seat, @r, @stat);
    for my $i (1..$seats) {
        my $max=0;
        for my $j (0..scalar(@V)-1) {
	    $r[$j] = $V[$j]/(2*$s[$j]+1);
	}
        for my $j (0..scalar(@V)-1) {
	    if ($r[$j] > $max) {
		$max = $r[$j];
		$seat = $j;
	    }
	}
        $s[$seat]++;
        $stat[$seat]++;
#        print "El escaño $i va para el partido $seat\n";
    }
#    for my $j (0 .. $#V){
#        print "Partido $j -> $stat[$j] escaños\n";
#    }
    return @stat;
}



sub dhondt {
    my ($escanos, $partidos, $votos)=@_;
    my @votes = @$votos;
    
    $partidos = scalar @votes;
    my (@cocientes, @total, %hash);
    for my $i (0..$partidos-1){
	for my $j ( 1 .. $escanos ) {
	    my $n = $votes[$i]/$j;
	    push @cocientes, $n;
	    $hash{$n} = "$i ronda $j";
	}
    }
    my @coc_sorted = sort { $b <=> $a } @cocientes;
    for my $i (1..$escanos) {
	my $j = $coc_sorted[$i-1];
#	print "Escaño $i asignado al partido $hash{$j}, $j\n";  
	$hash{$j} =~ s/(\d+)\s.*/$1/;
	$total[$hash{$j}]++;
    }
    for my $i (0..$partidos-1){
	unless (defined $total[$i]) { $total[$i] = 0; }
#	print "Partido $i -> $total[$i] escaños, $votos[$i] votos\n";
    }
    return @total;
}


sub dibuja {
#    system "clear";
    my $ida = 1;
    @xy=();
    my $k = -1;
    my ($x, $y) = (1, 1);
ZZ:   
      while (++$k <= $#area){
	  my $z = $area[$k];                       # dptos
	  my $b = 0;                               # bloques
	  while ($b < $z){
	      if ($ida==1){
		  unless (defined $xy[$x][$y]){
		      $xy[$x][$y]=$char[$k];
		      if (++$b > $z){
			  goto ZZ;
		      }else{
			  $y++;
		      }
		  }
		  if ($y == $diag[$x]) {
		      unless (defined $xy[$x][$y]){
			  $xy[$x][$y] = " ";
			  if ($x==$cols){ 
			      $ida = 2;
			      $y++;
			      goto backtrack;
			  }
			  $y=1;
			  $x++;
		      }
		  }
	      }else{
backtrack:		
		    unless (defined $xy[$x][$y]){
			$xy[$x][$y] = $char[$k];
			if (++$b > $z){
			    goto ZZ;
			}else{
			    $y++;
			    if ($y > $lines){
				$x--;
				$y = $diag[$x]+1;
			    }
			}
		    }
	      }    
	  }
      }
    if ($DEBUG) {
	for my $y (1..$lines){
	    for my $x (1..$cols){
		print $xy[$x][$y];
	    }
	    print "\n";
	}
    }
}

sub evalua {
    my $err;
    for my $k (0..scalar(@sqarea)-1){
	my $front = 0;
	for my $y (1,$lines){
	    for my $x (1..$cols){
		if ($xy[$x][$y] eq $char[$k]) {
		    $front++;
		}
	    }
	}
	if ($front > 0){
	    $err += abs( ($front-$sqarea[$k]) / $front );
	}else{
	    $err += 1_000_000;
	}
    }
    return $err;
}

sub guarda {
    for my $y (1..$lines){
	for my $x (1..$cols){
	    print $xy[$x][$y];
	}
	print "\n";
    }
    if (defined $ARGV[0] && -w $ARGV[0]) {
	open OUT, '>', $ARGV[0] or die "Cannot open. $!";
	for my $y (1..$lines){
	    for my $x (1..$cols){
		print OUT "$xy[$x][$y]";
	    }
	    print OUT "\n";
	}
	print OUT "$0 iteration $it: error $r\n";
	close OUT;
    }
}

sub permutas {
    my $n = scalar(@dptos);
    my $per = int ($n*rand()); 
    my $otro = int ($n*rand()); 
    my $temp;
    
    $temp=$area[$per];
    $area[$per]=$area[$otro];
    $area[$otro]=$temp;

    $temp=$char[$per];
    $char[$per]=$char[$otro];
    $char[$otro]=$temp;
 
    $temp=$sqarea[$per];
    $sqarea[$per]=$sqarea[$otro];
    $sqarea[$otro]=$temp;
    
    $temp=$dptos[$per];
    $dptos[$per]=$dptos[$otro];
    $dptos[$otro]=$temp;
    
    # creo que no se me olvida nada

    $temp = $number[$per];
    $number[$per] = $number[$otro];
    $number[$otro] = $temp;
}






__END__


This is the ultimate xterm layout plant diagonal design.
  My lecture 29 Feb 2008 PhD, revised by the wisdom of
  ancient coding, reinventing myself from the crap.
















my $N=12;   # num. of depts.
# my $NB=3;  #num. of bays
# area for each department
my $p = 2; # pasillo
my $r = 2; # resolution
my $f = 24; # filas
my $c = 79; # columnas 
# secuencia inicial
my @sq = ( 0, 1, 2, 8, 6, 7, 5, 4, 3, 9, 10, 11, 12 );
for $i (1..$#q){
    $wq[$i] = sqrt($q[$i]);
}
$solant = 9e99;

while (1){
    &linea;
    N:    for $n (1..$N){
	$k = $r * ($wq[$sq[$n]]+$p/2) ;
	$m = $r * $wq[$sq[$n]] ;
	$num = int (.5+ $k * $m);
        $ok=0;
	if ($ok==0){
	    for $j (1..$W*$r){
		for $i (1..$L*$r){
		    next N if ($num==0);
		    if ($x[$i][$j]==0){
			$x[$i][$j]=$sq[$n];
			$num--;
		    }elsif ($x[$i][$j]==-1){
			last; 
		    }
		}
		if ($j==$W*$r){ $ok=1; last; }
	    }
	}
        for ($j=$W*$r;$j>=1;$j--){
	    for ($i=$L*$r;$i>=1;$i--){
		next N if ($num==0);
		if ($x[$i][$j]==0){
		    $x[$i][$j]=$sq[$n];
		    $num--;
		}elsif ($x[$i][$j]==-1){
		    last; 
		}
	    }
	}
    }
    $it++;
    $sol = &evalua;
    if ($sol < $solant){
	&dibuja;
	$solant = $sol;
	print "$it $sol\n";
    }
    &permuta;
}
exit 1;



sub evalua {
    for $i (1..$N){
	$front[$i]=0;
	for $j (1..$W*$r){
	    if ($x[1][$j]==$i){ $front[$i]++; }
	    if ($x[$L*$r][$j]==$i){ $front[$i]++; }
	}
	for $j (1..$L*$r){
	    if ($x[$j][1]==$i){ $front[$i]++; }
	    if ($x[$j][$W*$r]==$i){ $front[$i]++; }
	}
    }
    $media = 2*($W*$r+$L*$r)/($W*$r*$L*$r);
    $err =0;
    for $i (1..$N){
	$err += ($front[$i]/$q[$i] - $media)**2;
    }
    return $err;
}

sub linea {
    $j1=1;
    $i1 = 1+rand()*($L*$r-1);
    $j2=$W*$r;
    $i2 = 1+rand()*($L*$r-1);
    for $i (1..$L*$r){
	$yflot = (($j2-$j1)/($i2-$i1))*( $i -$i1)+$j1;
	for $j (1..$W*$r){
	    if ($yflot-$p*$r <= $j && $j <= $yflot+$p*$r){ $x[$i][$j]=-1; }
	    else { $x[$i][$j]=0; }
	}
    }
}

sub dibuja{
    for $i (1..$f){
	for $j (1..$c){
	    print chr(64 + $x[int(.5+$i*$L*$r/$f)][int(.5+$j*$W*$r/$c)]);
	    if ($j==$c) { print "\n"; }
	}
    }
}