#!/usr/bin/perl -w

# VER WARNING de $sum 

use 5.034;

my $DEBUG = 1;
my $RETARD = 0;

my $TURNOS =3;
my $YEAR =2023;
my $VACACIONES =30;
my $CURROMAX =6;
my $CURROMIN =2;
my $DESCANMAX =6;
my $DESCANMIN =1;
my $JORNADAS =216;  # normalmente no se llega, está autolimitado, por lo que hay que tirar para arriba 
# esto son 365 - 52 domingos 26 sábados 14 fiestas 30 días de vacaciones en Cuba 12 Moscosos y 15 gripe
  
my ( $dias,$inidevacas,$effdiasvaca,$findevacas,$numperiovaca,$d,$dmax,$max, $sum );  # $d es día en estudio y empieza en 1, como los meses
my ( @inivaca,@finvaca );
my ( @pvaca,@s,@req,$bb,@list ); # s is the core [day][worker][shift] and the 0 index serve as * (any other)
my ( $k,$flag );
my @ch=qw( D M T N );
if (febrero($YEAR)==28) { $dias=365; }
else { $dias=366; }
$req[1] = 4;               # M
$req[2] = 2;               # T
$req[3] = 2;               # N
$max = 9e99;
my $REQXDIA = $req[1]+$req[2]+$req[3];
my $TRABAJADORES = $REQXDIA + 3;

while ($TRABAJADORES*$JORNADAS<$dias*$REQXDIA){
    say "¡ESTO NO CUADRA! Pocas jornadas de trabajo o pocos trabajadores... incrementando...";
    $TRABAJADORES++;
}
say "El número de trabajadores debe ser como mínimo de $TRABAJADORES";
my $FICHERO ="pl-$req[1]$req[2]$req[3]-$TRABAJADORES.out";

for my $month (1..4){ $inidevacas += daysinmonth($month,$YEAR); }
$inidevacas++;
for my $month (5..10){          # 6 MESES
    $effdiasvaca += daysinmonth($month,$YEAR);
}
$numperiovaca = 1 + int ($effdiasvaca/$VACACIONES);
$findevacas= $inidevacas+$effdiasvaca;


printf("número de periodos de vacaciones %d  días de vacaiones %d  inicio de vacaciones %d  fin de vacaciones %d\n",$numperiovaca,$effdiasvaca,$inidevacas,$findevacas) if $DEBUG;
for my $j (1..$TRABAJADORES){
    if ($j % 2){
	$inivaca[$j] = $inidevacas + ($j % $numperiovaca) * $VACACIONES + $j % $numperiovaca;
	$finvaca[$j] = $inivaca[$j]+$VACACIONES-1;
    }else{
	$finvaca[$j] = $findevacas - ($j % $numperiovaca) * $VACACIONES - $j % $numperiovaca;
	$inivaca[$j] = $finvaca[$j]-$VACACIONES+1;
    }
    printf("inicio %d  fin %d\n",$inivaca[$j],$finvaca[$j]) if $DEBUG;
}
  
####################################


if ($TRABAJADORES - int ($TRABAJADORES/($numperiovaca-1)) < $REQXDIA){
    die "¡ESTO NO CUADRA! Pocos periodos de vacaciones o pocos trabajadores...";
}

init:
  $k=0; # errores subsanables
for my $i (0..$dias){
    for my $j (0..$TRABAJADORES){
	for my $t (0..$TURNOS){
	    $s[$i][$j][$t]=0;
	}
	if ($i>0 && $j>0) {
	    if ($i >= $inivaca[$j] && $i <= $finvaca[$j]){	   
		$pvaca[$j][$i]=0;
	    }
	    else { $pvaca[$j][$i]=1; }  # POSIBLE, PUES SI
	}
    }	
}
$d=1;

###################### BUCLE PRINCIPAL

my @spiral = qw(- \ | / - | / o);
my $cand;   # candidato
while ($d<=$dias){
    select(undef,undef,undef,0.001) if $RETARD;   # delay for not overheating
    print "\r " . $spiral[$d % 8] . " $d  " if $DEBUG;
    @list = motor();
    for my $bb (1..$TURNOS){	  
	while ( $s[$d][0][$bb] < $req[$bb] ) {
	    $cand = shift @list;
	    die "AGOTADO" unless defined $cand;
#	  t = 1+(int) (drand48()*TRABAJADORES);
#	  t = 1+(int) ( xoroshiro128plus() * TRABAJADORES );
	    if ($pvaca[$cand][$d]==1 && $s[$d][$cand][0]==0){  # no vacaciones y no salir el mismo dia
		if (set( $d, $cand, $bb ) ){  # bien 
		}else{ # mala suerte 
		}
	    }	  
	}
    }
    
    my $r = compru();
    if ($r<1){  # compru() fail
	$k++;	# kontador de número de fallos
	if ($k > $TRABAJADORES * $TRABAJADORES){   # heurística vulgaris
	    for (my $i=$d; $i >= $d-$CURROMAX; $i--){
		last if $i<=0;
		borra($i);
	    } 
	    $d-=$CURROMAX;
	    if ($d<1){ $d=1; }
	}else{
	    borra($d);   # igualmente hay fallo pero puede ser del día
	    $d--;
	    if ($d<1){ $d=1; }
	} 	
    }else{
	$k=0;  # no hay error, y se va hacia adelante
    }
    $d++;   # IMPORTANTE porque sí o sí se borra o se adelanta
  
    next if $d < $dias;
 ###############################   
    
    my $e=0;
    $dmax = int ($REQXDIA * $dias / $TRABAJADORES);       # demanda potencial por trabajador
    for my $j (1..$TRABAJADORES){
	$e += ($s[0][$j][0]-$dmax)**2;  # error cuadrático de la holgura, totalizada para todos los trabahjadores
    }                                   # si no se asigna todo el trabajo, vale, pero debe estar repartido  
  
    if ($d > $dias){
	if ($s[0][0][0] < ($REQXDIA*$dias)){     # igual es pedir demasiado que no sobre nada, que siempre sea igual;
	    goto init; # pero si es menos, puede que falle algo gordo
	}
    }
    if ($e<$max && $d>$dias){
	$max=$e;
	say "\n ====== Solución factible y mejor ======";
        # fout = fopen (FICHERO,"a+");
	open OUT, '>>', $FICHERO or die "Cannot open $FICHERO: $!"; 
	say OUT "\nCalendario generado por $0 en ", scalar localtime();
	printf OUT "\n%i trabajadores \n%i requisitos\nE-index %i day %i\n",$TRABAJADORES,$REQXDIA,$e,$dias;
	for my $j (1..$TRABAJADORES){
	    printf OUT "\n\nTrabajador %i\n\n    ENE FEB MAR ABR MAY JUN JUL AGO SEP OCT NOV DIC", $j;
	    for my $i (1..31){
		printf OUT "\n%i " , $i ;
		if ($i<10){ printf OUT " "; }
		$d=$i;
		for my $x (0..11){
		    $d += daysinmonth($x,$YEAR);
		    if ($d <= $d-$i+ daysinmonth($x+1,$YEAR)){
			$flag=0;
			for my $kk (1..$TURNOS){
			    if ($s[$d][$j][$kk]){			  
				printf OUT "   %s",$ch[$kk];
				$flag=1;
				last;
			    }
			}
			if ($flag==0 && $pvaca[$j][$d]==0){
			    printf OUT "   V";
			}elsif ($flag==0 && $pvaca[$j][$d]==1){
			    printf OUT "   D";
			}
		    }else{ printf OUT "    "; }
		}
	    }
	    printf OUT "\n %i trabajos: ",$s[0][$j][0];
	    for my $t (1..$TURNOS){ 
		printf OUT " %s %i,",$ch[$t],$s[0][$j][$t]; 
	    }
	}
        say OUT "";
	say OUT "";
	say OUT "Some stats:";
	for my $j ( 1 .. $TRABAJADORES ){
	    say OUT "Trabajador $j  M $s[0][$j][1]  T $s[0][$j][2]  N $s[0][$j][3]  \* $s[0][$j][0]"; 
	}
	say OUT "";
	say OUT "Total trabajo asignado = $s[0][0][0]";
	say OUT "Total trabajo potencial = ", $TRABAJADORES * $JORNADAS;
	close OUT;  
	goto init;
    }elsif ($d>$dias){ 
	goto init;       # se le pasó el arroz y no es óptima => empezar de nuevo
    }
}

exit 2;









sub motor {
    my @capaz;
    for my $j (1..$TRABAJADORES){
	if ($pvaca[$j][$d] == 1){
	    push @capaz, $j;
	}
    }
#  return sort { $s[0][$a][0] <=> $s[0][$b][0] } @capaz;
    return jlm(@capaz);
}



sub borra {
    my $i = shift;
    if ($i<=0){ return; }
    # dia a eliminar $i
    for my $j (1..$TRABAJADORES){
	for my $t (1..$TURNOS){
	    if ($s[$i][$j][$t]){
		
		$s[0][$j][$t]--;
		if ($s[0][$j][$t]<0) { $s[0][$j][$t]=0; }
		
		$s[0][0][$t]--;
		if ($s[0][0][$t]<0) { $s[0][0][$t]=0; }
		
		$s[$i][0][$t]--;
		if ($s[$i][0][$t]<0) { $s[$i][0][$t]=0; }
		
		$s[$i][$j][0]--;             # 0j0 está suponiendo que no ira el trabajador j a otro turno el día i (porque se elimina el día i)
		if ($s[$i][$j][0]<0) { $s[$i][$j][0]=0; }
		
		$s[$i][0][0]--;
		if ($s[$i][0][0]<0) { $s[$i][0][0]=0; }
		
		$s[0][$j][0]--;
		if ($s[0][$j][0]<0) { $s[0][$j][0]=0; }
		
		$s[$i][$j][$t]=0;
		if ($s[0][0][0]<0) { $s[0][0][0] = 0; }
		
		$s[0][0][0]--;
		if ($s[0][0][0]<0) { $s[0][0][0] = 0; }
		
	    }
	}
    } 
}




sub set {
    my ($d,$j,$n) = @_;
    if ($pvaca[$j][$d]==0){ return 0; }
    if ($s[$d][$j][$n]){ return 1; }       # do nothing, yet done
    
    my ($c1,$c2) = (0,0);
    if ($d <= $CURROMIN) { 
	goto expand;
    }
    if ($d > $CURROMAX){	
	for my $i ($d-$CURROMAX-1 .. $d){
	    if ($i > $d-$CURROMIN){
		$c1++ if ($s[$i][$j][0]);
	    }
	    $c2++ if ($s[$i][$j][0]);
	}
	if ($c1 <= $CURROMIN){
	    goto expand;
	}
	if ($c2 < $CURROMAX){
	    goto expand;
	}
    }else{
	goto expand;
    }
    
#    for my $t ( 1 .. $TURNOS){
#	if ($s[$i][$j][$t] == 0){
  
	    # Borrado de estadísticas para después asignar y hacer lo que dé la gana 		
#	if ($t == $n){	
#	    $s[0][$j][$n]++;
#	    if ($s[0][$j][$t]<0) { $s[0][$j][$t]=0;}
#		$s[0][0][$t]--;
#		if ($s[0][0][$t]<0) { $s[0][0][$t]=0; }
#		$s[$i][0][$t]--;
#		if ($s[$i][0][$t]<0) { $s[$i][0][$t]=0;}
#		$s[$i][$j][0]--;
#		if ($s[$i][$j][0]<0) { $s[$i][$j][0]=0;}
#		$s[$i][0][0]--;
#		if ($s[$i][0][0]<0) { $s[$i][0][0]=0;}
#		$s[0][$j][0]--;
#		if ($s[0][$j][0]<0) { $s[0][$j][0]=0; }
#		$s[$i][$j][$t]=0;
#		$s[0][0][0]--; 
#		if ($s[0][0][0]<0) { $s[0][0][0] = 0; }
#	    }
#	}
#    }
    
expand:    
    $s[$d][$j][$n]=1;
    $s[0][$j][$n]++;
    $s[0][0][$n]++;
    $s[$d][0][$n]++;
    $s[$d][$j][0]++;
    $s[$d][0][0]++;
    $s[0][$j][0]++;
    $s[0][0][0]++; 
    return 1; 
}

#######################################################

sub compru {
    for my $t (1 .. $TURNOS){
	return 0 if $req[$t] > $s[$d][0][$t];
    }
    return 1 if $d==1;
    for my $j (1..$TRABAJADORES){	
	if ($s[0][$j][0] > $JORNADAS){ return -4; }
	if ($s[$d-1][$j][2] && $s[$d][$j][1]){ return -1; }
	if ($s[$d-1][$j][3] && $s[$d][$j][1]){ return -1; }
	if ($s[$d-1][$j][3] && $s[$d][$j][2]){ return -1; }
	if ($s[$d-1][$j][3] && $s[$d][$j][1]){ return -1; }
	if ($d > $CURROMAX){		 
	    my $z = 0;
	    for (my $i=$d ; $i >= $d-$CURROMAX; $i--){
		if ($s[$i][$j][0]==0){
		    $z++ if $pvaca[$j][$i] == 1;
		    if ($z > $DESCANMAX) { return -3; }
		}	    
	    }
	}	  
    }
    return 1;
}

	  
sub febrero {
    my $y = shift;
    if ($y % 400 == 0){   return 29;
    }elsif ( $y % 100 == 0){  return 28;
    }elsif ($y % 4 == 0){  return 29;
    }else{      return 28;  }
}

sub daysinmonth {
    my ($m, $y) = @_;
    if ($m==1 || $m==3 || $m==5 || $m==7 || $m==8 || $m==10 || $m==12){ return 31; }
    if ($m==4 || $m==6 || $m==9 || $m==11){ return 30; }
    if ($m==2){ return (febrero($y)); }
    if ($m==0){ return 0; }
    else{ return -1; }
}

sub jlm {
    my @deck = @_;
    my @deck2;
    my $n = scalar(@deck);
    while ($n){
	my $t = int ($n*rand);
	push @deck2, splice(@deck,$t,1);
	--$n;
    }
    return @deck2;
}

__END__

Indentación ridícula: no hay cosa más boba que una línea con solo "{"
 Sospecho vandalismo.