#!/usr/local/bin/perl

# VER WARNING de $sum 

use 5.040.3;
# use utf8;
no warnings 'all'; # antigua diatriba para aceptar wide chars

# use integer;      # Nope. No way

# Prior versions doesn't even check -c for 'my $x=1; if ($x=0) { say "Not true, but TRUE"; };'
# use warnings 'all', FATAL => qw(uninitialized numeric);

# Versión 2025 de simplicación, comentarios y mejora
# "Actualizations happen" --Larry Wall

my $VERSION = "54LM10";    # La batalla contínua. LM2 puede ser de más de 3 turnos, no de otra cosa. let ego = "on"
                          # El 2 debe significar que incorporo QC en los calendarios factibles, p.ej. no permitiendo alguna cosa
                          # No hice lo de (2) pero en (3) meto el time out en algún loop to goto PEZ; to avoid hangs
                          # versión LM 4 - no verborrea mujer. Outputs seleccionados
                          # LM5 -> se juega con los tiempos de búsqueda. Aumentar tiempo mínimo a una hora.
                          # LM7 -> $JORNADAS más realistas con el cálculo en semanas y no días.
                          # La duda es si la turnicidad se paga sólo en dinero, porque la diferencia es considerable  
                          # LM8 -> se va a tratar de minimizar holguras negativas y punto. Son las que cuestan dinero o peor
                          # LM9 -> como se puede saber el grado de dificultad, se puede aumentar el tiempo máximo en una hora si...
                          # LM10 -> se hace un nuevo rango de asignación, que es lo que flaquea

# (c) Jesús Lozano Mosterín, Jesús 2025
                         # Se intenta incorporar turno madrugada, normalmente en variante 6 h. * (3 (M,T,N) + 1 (m)) 
                         # Y se ordena la @LISTA de combinaciones sexys para retomar si falla algo -> usar 'solo'

# El modelo IS-LM es didáctico (nota pedante necesaria)
# Explicación corta: no se puede hacer tan fácilmente regresiones de puntos de 'equilibrio' de mercados (vid. David D. Friedman)

$|=1;

# El tema ahora es computar el número de cambios de turno, sin contar descansos,
# y tenerlo en cuenta en $e
# Lo que se busca es que en lo posible, entre descansos, se mantenga el mismo turno.
# lun 21 abr 2025 07:03:03 CEST

# Hacer suma de holguras para ver si > $JORNADAS
# mar 22 abr 2025 17:40:11 CEST

die "Error: No hay argumento(s)" unless @ARGV;
my @LISTA;
my $cc = 0;
my $cmax = 0;
my $REBOTE = 10;    # Muy importante para lotes. Debe ser bajo para tirar para adelante y acabar
die "Error: Not numeric" if (0+$ARGV[0] ne $ARGV[0]);
die "Error: argument can not be 0" if ($ARGV[0]==0);
my $i1 = $ARGV[0];
my $j1 = $ARGV[1] // $ARGV[0];
my $k1 = $ARGV[2] // $ARGV[1] // $ARGV[0]; 
my $h1;
if (defined $ARGV[3]){
    if ( $ARGV[3] =~ /^\d+$/ ){
	# Éxito: cuarto turno detectado
	$h1 = ($ARGV[3] <= $k1) ? $ARGV[3] : $k1;

	if (defined $ARGV[4]){
	    if ($ARGV[4] =~ /solo/i){
		$LISTA[$cc] = "$i1 $j1 $k1 $h1";
		$cmax = 1;
		goto solo;
	    }
	}
    }elsif ($ARGV[3] =~ /solo/i){	# Esta opción es buena para un solo problema normal
	$LISTA[$cc] = "$i1 $j1 $k1";
	$cmax = 1;
	goto solo;
    }else{
	die "Error en parámetro no numérico";
    }
}

# la duda es si usar un $argc mejoraría esta gestión. Pero primero que funcione 	   
if (scalar (@ARGV) >= 1){
    # solo se usa un argumento para desarrollar combinaciones normales
    say "\nLOTE DE CALENDARIOS GENERADOS:";
    for (my $i = $i1; $i > 0; $i--) {
	for (my $j = 1; $j <= $i; $j++){      # de tarde 1 al menos por humanidad
	    for (my $k = 0; $k <= $j; $k++){  # de la noche se puede prescindir. Lo importante es el afterhours :-) 
## SE PRESUPONE, PARA FACILITAR LOTES, QUE mañana >= tarde >= noche
		unless (defined $h1){
		    $LISTA[$cc] = "$i $j $k";     # Lo normal son 3 turnos 
		    say "Calendario de lote n.º $cc -> $LISTA[$cc]";
		    $cc++;
		}else{
		    for my $h ( 0 .. $h1 ){
			# El autor bananero de este dictatorial script ha decidido:
			# que la madrugada es menos importante que la noche, luego (m) <= (N)
			# Ese turno entre la noche y la mañana, coloquialmente, el turno cabrón,
			# es el 4.º, por lo que puede ser turno de reserva para cualquiera de los otros 3
			# No lo he probado todavía. Igual sobra sal.
			    
			$LISTA[$cc] = "$i $j $k $h";
			say "Calendario de lote n.º $cc -> $LISTA[$cc]";
			$cc++;
		    }
		}
	    }
	}
    }
    $cmax = $cc-1;   # es el máximo pero ya se sabe
}else{
    die "Error: Not supported more than 3 shifts and less than 1 as argument.\nUsage: $0 <maxMorningworkers> [Afternoonworkers] [Nightworkers] [morningstarworkers] [solo]\n";
}

@LISTA = sort { $b cmp $a } @LISTA;


solo:

say "\n";

# HASTA AQUI GENERA TODAS LAS POSIBILIDADES

my $DEBUG = 0;          # -2 no hace espiral
                        # -1 reporta errores compru()
                        # 1 reporta horizontal
                        # 2 reporta bugs undef raros parcheados ya
                        # 3 escribe fichero de preferencias supuestas
                        # 4 esribe preferencias en pantalla

# my $min = -9e99;     # No va ser menor que 0 ni con un España-Malta, pero bueno. 
# my $maxfacil = 9e99;   # Cosa de esta versión LM2. A mí no me mires. 
my $max = 9e99;      # casi siempre hace falta algo de esto y hay que poner un número bárbaramente alto :-)
                     # (antes había quien ponía la edad en 2 dígitos, o el año, pero eso es racanear)
# $e desviación del equilibrio a minimizar

my $detect = 0;
my $MEGA365 =  1_000_000;     # eso parece corto pero como no es un Cray... fracasos $k intraaño               
my ( $k, $flag ) = (0,0);      # Variables auxiliares que pueden (casi seguro) ser necesarias

# my $RETARD = 0;      # Esto no recuerdo ni para qué es !!!  -> es para prolongar el cálculo a, por ejemplo 2 años.
                       # Pendiente para 2027, porque la duda es si es mejor en enganche por delante o por detrás
                     # Basta añadir un día, 32 de diciembre = 1 de enero, para enganchar calendarios 
my $SPEED = 1;       # DOS MARCHAS: 0 flojete, 1 a ras!
my $TIMEMAX = 60 * 120;     # 2 horas
my $TIMEMIN = 60 * 60;   # 1 hora
my $diff_t;

my $YEAR = 2026;
my $VACACIONES = 31;  # pueden ser más días
my $CURROMAX = 6;     # días seguidos de trabajo. Podrían ser más, de hecho existen cuadrantes de 7 dias 12 horas y 7 días de descanso
# my $CURROMIN =2;     # esto significa que se va a intentar que no haya un día «suelto» de trabajo. Las bajas por la causa que sea, pueden alterar esto  
my $DESCANMAX =4;    # si se puede, que no haya más de una semana de descanso para que no se acumule el trabajo en otra parte del año
                     # 0j0 -> esta es la cifra mayor y la que se utiliza para cchequear
# my $DESCANMIN =0;    # puede haber un día de descanso en cualquier parte
my $PERIODO = ($CURROMAX > $DESCANMAX) ? $CURROMAX : $DESCANMAX;

# my $BAJAS_PREVISTAS = 10; # vamos a ver, se trata de una *estimación* del *promedio*. Que no se está de maternidad todos los años se ve a 0j0 :-)
                          # esto puede determinar que el 331 que antes secubría con 12 ahora no, p.ej.
# my $DIAS_LIBRES = 10;     # es de humanos, tener algo de esto >= 1  ¡PUEDE SER UN DIA DONUT!
# my $FIESTAS = 15;
# my $JORNADAS = 366 - 53 - 27 - $VACACIONES - $FIESTAS - $BAJAS_PREVISTAS - $DIAS_LIBRES;   # normalmente no se llega, está autolimitado, por lo que hay que tirar para arriba

### Versión LM7

my $JORNADAS = 37 # horas/semana, siendo conservador hasta que se calcule bien
 * ( 366/7        # número de semanas máximo
     - ( 4 + 3/7 ) # un mes de 31 días de vacaciones
     - 3.5 )       # semanas de festivos, 14 son 7*2, pero la gripe o los embarazos o lo que sea...
  / 8 ;            # Las jornadas interesa que sea en días. 8 horas se da por normal. Pueden ser 4 o 12, con el calendario 
                   # ya en la mano, porque sólo indica qué parte del día toca o no toca 




# Accidentalmente me doy cuenta de que los fines de semana no están previstos, más que a través de
# el número máximo de jornadas de trabajo al año, que todavía no se tocó. (ni se tocará en número de horas)

$JORNADAS -= 6;         # por nocturnicidad y disponibilidad

### Ejem. si el calendario es una chapuza, o surge un imprevisto, se tira de los de holgura...  POSITIVA, que es la buena
### La holgura negativa es a deber o a pagar como extra, cosa que puede y suele ser preferida 

### No cojo la parte entera porque se compara con otras cantidades que pueden o no ser enteras  



my $dias;
if (febrero($YEAR)==28) { $dias=365; }
else { $dias=366; }

say "$YEAR es un año de $dias dias\n";

say "Se va a tratar de introducir un número de jornadas total de $JORNADAS al año\n";

# Antiguamente:
# esto son 365 - 52 domingos 26 sábados 14 fiestas 30 días de vacaciones en Cuba, 12 Moscosos y 15 gripe

# my @spiral = qw(- \ | / - | /);
my @spiral = ("\x{2190}", "\x{2196}", "\x{2191}", "\x{2197}", "\x{2192}", "\x{2198}", "\x{2193}", "\x{2199}" );
my $NSOL = 0;        # Al lío, empieza la fiestuqui
my $fracasos = 0;

my $counter = -1;


######################################## HASTA AQUI SE ACABA LA PARTE GRATIS, QUE NO CONSUME ###########################################################################


PEZ:

# Antes fue el PEZ que el dinosaurio, dicen

my $iniproblem_t = time();

my @req;   # @req uisites    Obviamente, es importante y lo que se trata de cubrir.

$req[0] = 0;               # by plot 

if ($cmax > 0){                 # CAMBIO DE CALENDARIO
    $NSOL = $fracasos = $k = 0;
    $max = 9e99;
#   $maxfacil = 9e99;
    $counter++;
    goto THEEND if ($counter > $cmax);
    my $temporal;
    if (defined $LISTA[$counter]){
	($req[1], $req[2], $req[3], $temporal) = split / / , $LISTA[$counter];          # Lo mismo, del lote de problema que sea según el mayor núm. $number
    }
    if (defined $temporal){
	$req[4] = $temporal;
    }
    say "\n\n\n---------------- Empieza a procesarse calendarios del tipo n.º $counter";
}else{
    die "Proper use: $0 <Morningnumber> [Tafternoon] [Nnigth] [m-morningstar] [solo]"; 
}

# Antiguamente, era más bonito, pero no cabía el helicóptero
#    $req[1] = $LISTA[0];               # M
#    $req[2] = $LISTA[1];               # T
#    $req[3] = $LISTA[2];               # N

my @ch=qw( D M T N m );    # posibilidades: Descanso, Mañana, Tarde, Noche, madrugada
                         # podría haber más posibilidades si se quiere recoger algo como un Reemplazo, o un Fuerza Mayor
                         # (se llama fuerza mayor cuando algo es imposible de superar)
my $TURNOS = 0;

say "\nProblema:";
for my $i (1..scalar(@req)){
    if (defined $req[$i]){
	if ($req[$i] >= 0){
	    say "\t\t $ch[$i] = $req[$i]";
	    $TURNOS++;   # 2 turnos al día -> eso no implica que sean de 7 horas o 12, sino que sólo hay 2 horarios al día 
	}
    }
}
say "";
say "Empieza el procesado a ", scalar localtime(), "";
say "";
die "Número de turnos no posible de TURNOS = $TURNOS" if ($TURNOS < 1);

my $REQXDIA = 0;
for (1 .. scalar(@req)-1){
    if (defined $req[$_]){
	$REQXDIA += $req[$_];  # Esto parece una chorrada. Vale. Pero, es por donde puede empezar el ajuste 
    }
}
say "El número de requisitos al año es de ", $REQXDIA * $dias;

######################################### Esto creo que fue una buena idea, es un CORE set

my @set;  # @set is the core $set[day][worker][shift] and the 0 index serve as * (any other) 
# my @bestset;

########################################## A partir de aquí, la cosa se lía, pero no se parte de cero

# my $sum = 0;         # esta variable es autoexplicativa -> pero no se usa

my ( $inidevacas, $findevacas );  # es común que haya un periodo vacacional en los meses más cálidos
# PERO puede haber otras vacaciones, de invierno. Esto ya es complicado. En principio, el número de períodos vacionales es 1 o 2 y ya. 
# Suponemos que no todo es 'flotante', para que el calendario tenga algo de buena pinta.    
# No hace falta explicar el lío que supone elegir vacaciones sobre la marcha, por lo que mejor es plantea la cosa como $DIAS_LIBRES  

# Y esto hace pensar en cuál es el formato de OUTPUT del programa. Elijo ASCII y elijo que sea compacto y a la izquierda,
# para que se pueda anotar a la derecha. Se podría elegir una línea por día y trabajador, pero eso es output spaguetti. 

# Después, se puede elegir entre poner los meses por líneas o por columnas.
# Por líneas sería ultracompacto. 12 líneas y a la cama
# Por columnas, ya serían treinta y pico líneas entre cabecera de meses, días, y totales. Esto parece razonable.  

### No quiero lidiar todavía con páginas, porque eso sería suponer el tipo de letra, etc.
### Que cada uno elija lo que prefiera o pueda. No obstante los tipos monoespaciados no son feos y aseguran que
### cada número de 0 a 9 y cada letra del alfabeto latino (o ASCII) ocupen lo mismo y, sin necesidad de tablas,
### se vea la cosa alineada y bonita.

### Opciones no descartables es que el output sea pdf o, casi mejor, html
### No soporto al <cualquier_cosa>xml</cualquier_cosa>, eso sí que es fealdad

### Otras opciones son incluso que haya outputs para la red, comprimidos, etc.
### bla, bla, bla...
  
my $TRABAJADORES = $REQXDIA + 1;     # (en todo caso por 2, aunque podrían ser el triple o más)

while ($TRABAJADORES * $JORNADAS <= $dias * $REQXDIA){    # pogo estrictamente menor para que el ajuste sea hacia arriba
    $TRABAJADORES++;
    say "Pocas jornadas de trabajo o pocos trabajadores... incrementando... $TRABAJADORES";
}

# for my $i (0 .. $dias){
#    for my $j (0 .. $REQXDIA * 2){
#	for my $turn (0 .. $TURNOS){
#	    $set[$i][$j][$turn] = 0;
#	    $bestset[$i][$j][$turn] = 0;
#	}
#    }
# }

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

trabajadores:

if ($NSOL == 0 && $k > $MEGA365){
    $MEGA365 *= 5;                       # como que no va a ser fácil volver con mismo rollo, incrementa medio orden de magnitud
    $TRABAJADORES++;
    die "Fallo miserable y normal: agotamiento de neuronas (AI) en $TRABAJADORES trabajadores" if $TRABAJADORES > $REQXDIA * 2;
    say "---> Se incrementa a $TRABAJADORES trabajadores";
    $k = 0;
    $fracasos = 0;
}

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

my $FICHERO;
if (defined $req[4]){
    $FICHERO = "pl-$req[1]$req[2]$req[3]$req[4]_$TRABAJADORES.out";
}else{
    $FICHERO = "pl-$req[1]$req[2]$req[3]_$TRABAJADORES.out"
}

if (-e $FICHERO){
    warn "\nWarning: El fichero $FICHERO ya existe y no se continua en él.\n";
    goto PEZ;
}
    
###################################  sáb 31 may 2025 23:44:10 CEST

my $dmax = $REQXDIA * $dias / $TRABAJADORES;       # demanda potencial por (hacia) trabajador, posible error si se redondea

say "\n### Los requisitos medios para cada trabajador son de $dmax y las jornadas son $JORNADAS ###";      # NUEVO: flotante

say "\nEL GRADO DE DIFICULTAD APROXIMADO DEL PROBLEMA ES DE ", $dias * $TRABAJADORES / ($JORNADAS * $TRABAJADORES - $REQXDIA * $dias);
# cuanta menos holgura de definición, más dificultad
# ahora el problema es ver cuándo se aumenta una hora $TIMEMAX
# pero eso sólo pasa en un problema de un lote de ellos, por lo que variable nueva
my $prime = 0;
if ( $JORNADAS * $TRABAJADORES - $REQXDIA * $dias <= $REQXDIA ) { $prime = 1; } 

# Claro, este número no quiere decir que pueda el algoritmo con ello.
# Por lo que, nada lo impide, se pueda aumentar cuando se detecte el estancamiento.
# Puede ser por tiempo de ejecución pero hasta ahora no hizo falta. La paciencia es la madre de la ciencia.

my ( @inivaca,@finvaca );   # ¿En qué estábamos? Ah, esto son listas, ¿? sí, cada trabajador tiene principio y fin de vacas diferente
                            # Esto podría expandirse a, por ejemplo, $inidevaca[$numerodetrabajador][$numerodeperiodovacacional]

$inidevacas = 1;           # primer día. Nochebuena.
for my $month (1..4){   # ¿alguien querría vacacionar largo en enero, febrero o marzo?
    # no creo, y abril es el mes de las lluvias o algo así se decía antes
    $inidevacas += daysinmonth($month,$YEAR); 
}
    
# Hasta aquí calcula bien el PERIODO VACACIONAL normal
# Ya está. Esto no es código de velocidad alta. No es ese tipo de fiesta.    

my $effdiasvaca = $VACACIONES * 6;  # 6 meses de vacaciones

$findevacas = $inidevacas + $effdiasvaca;
  
# (algo hay que dejar para mañana)
    
printf("\nNúmero de días del periodo de vacaciones %d  días de vacaciones %d\n  inicio de periodo de vacaciones %d  fin de periodo de vacaciones %d\n\n",
    $effdiasvaca, $VACACIONES, $inidevacas, $findevacas);   # 

# El v. 54j tiene 192 días de vacaciones, pero igual se puede mejorar o empeorar 
# si se toman estaciones en vez de meses. El problema es que esto choca con lo 
# convencional, de que más o menos sea un mes concreto. O quincenas. Como el 
# problema familiar no es fácilmente computable, tonces se puede buscar el mejor
# periodo climático y después dejar la asignación de periodo completo por 
# trabajador a discreción de la empresa, que tiene varias opciones: la rotación (malo),
# la antigüedad (malo), la lotería de vacaciones (malo), la asignación por ranking
# de preferencias (encuesta prefs. + algoritmo húngaro), el jefe (¿qué jefe?), o lo 
# que decida la rubia. Tonces, como no se trata de hacer una votación del Óscar por 
# agosto, mes preferido, ni este humilde script quiere consumir 1 Megawatio para 
# decidir, no nos metemos, miramos solo que el periodo total sea cojonudo. Tonces,
# sí convendría mirar el año climático medio, pero no del siglo pasado. Y vale ya.

# El problema siguiente es que si se toma 0.70 * primavera + verano + 0.70 * otoño
# pueden salir más días que podrían tener aplicación en países o empresas grandes, 
# para minimizar el problema inicial de cubrir requisitos, pero igual es mejor la
# jugada de facilitar las cosas a las pymes (la mayoría abrumadora de empresas), y 
# la cosa es que estas empresas se interrogan comúnmente sobre si mejor decidir un 
# mes y zanjar el problema cerrando. No es opción para lo que estamos tratando que 
# es el objetivo 24/7. Again, tonces, puede ser problema o no marear vacaciones a
# los que ya trabajan a turnos. Pero, todo importa poco con tal de que la asignación 
# sea buena para el conjunto, por lo que el siguiente script será para empalmar éste
# con 'NEXT' y bla bla bla

# Vamos, pero... ¿no es mejor que cada trabajador decida el calendario *anual* según 
# su biorritmo o incluso sea compensado en puntos o dinero por holguras negativas
# e incentivado con las positivas si no entra en el conjunto de lo 'normal' del 
# calendario? /* margen para la duda */

$finvaca[0] = $inidevacas;
$flag = 0;

say "Días del año correspondientes a las vacaciones:";
for my $trab (1 .. $REQXDIA*2) {
    
    if ( $finvaca[$trab-1] < $findevacas - int($VACACIONES * 0.2)) {   # el límte superior es difuso, pero no debería entrar en Nov

	$inivaca[$trab] = $inidevacas if ($trab % 6 == 1);    # elijo no poner +1 aquí 
	$inivaca[$trab] = $finvaca[$trab-1] +1 if ($trab % 6 != 1); # solo quiero saber el inicio contiguo   
	$flag = $trab + 1 if ($trab % 6 == 0);            # habíamos quedado en que eran + - 6 meses el periodo 'normal' de vacas
                                      # Esto hay que fijarlo y es importante para reducir los parámetros del problema
	
    } else {      # se va hacia atrás en el calendario... es raro, pero parece lo mejor -> esto es la mala idea

	$inivaca[$trab] = $inidevacas;      
	$inivaca[$trab] = $finvaca[$trab-1] +1 unless ( $trab == $flag );
	$flag = $trab + 1 if ($trab % 6 == 0);	
    
    }
    
    $finvaca[$trab] = $inivaca[$trab] + $VACACIONES ;
    
    if ($trab <= $TRABAJADORES){
	print "Número de trabajador $trab  ->  ";
	printf("inicio %d  fin %d\n", $inivaca[$trab], $finvaca[$trab]);
    }
}

# hasta aquí bien porque el giro (pueden ser 3) lo hace bien 
	
# La holgurilla entre vacas de unos y otros no vale sólo para contarse las vacas,
# sino que además ayuda mucho a que el algoritmo haga el encaje bien, ...o no

# say "\nChequeo adicional en los meses peores de ajuste, los de vacaciones...";
# if ($TRABAJADORES - $TRABAJADORES * $effdiasvaca/$dias  <= $REQXDIA){
#    warn "¡ESTO NO CUADRA! Pocos periodos de vacaciones o pocos trabajadores...";
#    $TRABAJADORES++;
#    say "Se incrementa el número de trabajadores a $TRABAJADORES";
# } else {
# if ( $TURNOS > 3 ){
#    say "Originalmente este script surgió de número de turnos == 3.";
#    print "Pero es posible que sean más.";
    # Sobre esto, la tendencia es hacia más 12 h x 2 que 6 h x 4 por los desplazamientos
    # (esto es coyuntural: hay países donde se emplea + trabajo juvenil, + propensos a 6 o 4 h.)
    # No obstante, se puede considerar un cuarto grupo de trabajadores que se ocupen de
    # hacer de correturnos y trabajar en los meses de más carga algoritmica, los meses de
    # vacaciones.
#    my $c = 0;
#    for (1 .. $TURNOS){
#	$c++ if ($req[$_] > 0);
#    }
#    if ($c != $TURNOS){
#	die "Error: El número de /* TURNOS */ no coincide. Revisar el setup.";
#    }
# }
say "";

# - He roto tu retrovisor
# - ¿Y cómo fue?
# - A la segunda vuelta de campana

my @cand;             # candidato de list de motor()
my @list; # a mejorar en motor()
my $top = 0;  # mayor $d

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

INIT:
  
if ( $NSOL == 0  && $k > $MEGA365 ){ goto trabajadores; }    # doble salto
                                                                               # PONER COSAS A 0
for my $da (0..$dias){
    for my $trab (0..$REQXDIA*2){
	$set[$da][$trab][$_] = 0 for (0 .. $TURNOS);     # Esta fue una buena idea, porque se mira esto (0 o 1) y se sabe casi todo
    }	
}

my $d = 0;       # 1 es el primer día corriente
my $r = 1;
# $k = 0;

if ($top >= $dias){
#    for my $i (0 .. $dias){
#	for my $j (0 .. $REQXDIA*2){
#	    for my $t (0 .. $TURNOS){
#		$set[$i][$j][$t] = $bestset[$i][$j][$t];
#	    }
#	}
#    }
    $top = 0;
}

while ($d < $dias) {
    
    select (undef, undef, undef, 0.001) if $SPEED == 0; 
    
    $d++ if ($r > 0);    # adelante un día, a ver si es bueno    

    if ($d == 1){
	$diff_t = time() - $iniproblem_t;
	goto PEZ if ( ( $NSOL >= $REBOTE && $diff_t >= $TIMEMIN ) || $diff_t >= $TIMEMAX + $prime );
        # si tarda > 2 horas en un calendario, malo o bueno (que ya hizo lo que pudo)
    }
    
    if ($d > $top) { $top = $d; }
    
    print "\r" . $spiral[$d % 8] . sprintf (" %03d", $d );
    
    printf (" %03d", $top ) if $DEBUG == 2;   # sólo si hay dificultades para factibilidad... llegar a fin de año
    
#    select (undef,undef,undef,0.001) if $SPEED == 0;   # delay for not overheating -> outer loop
    
    # Block 1 of generation
    @list = motor($d);

    for my $turn (1 .. $TURNOS){
LOOP:	
	@cand = splice @list, 0, $req[$turn]; 	
	my @rr = insert( $d, \@cand, $turn );
	
	if ( scalar @rr ){     # reciclable
	    push @list, @rr;
	    goto LOOP;
	}
    } 
    
    $r = compru();
    
    if ($DEBUG == -1){
	say "";
	say "compru = $r   dia $d -> $set[$d][0][$_]" for (1..$TURNOS);
    }
    
    if ($DEBUG == 1){
	for my $j (1 .. $TRABAJADORES){
	    for my $i (1 .. $d){
		$flag = 0;
		for my $turn (1 .. $TURNOS){
		    if ($set[$i][$j][$turn] == 1){
			$flag = 1;
			print $ch[$turn];
		    }
		}
		if ($flag == 0){
		    print "0";
		}
	    }
	    say "";
	}
	say "";
    }
    
    # Block 2 of reacting to improve/fail
    if ( $r <= 0 ){  # compru() fail
	$k++;	# kontador de número de fallos sin cumplipimiento
	# heurística vulgaris -> ¿podría ser menos?
	if ($k > $MEGA365) { goto INIT; }    # doble salto
#	if ($k > $TRABAJADORES ** 2){
#	    for (1 .. 2+abs($r)){    # 1 a 3 días mínimo derecho al olvido
#		borra();
#		$d--;
#		last if ($d <= 0);
#	    }
#	    $d++;
#	}else{
	    borra();
#	}
#	if ($d <= 0){ $d = 1; }
    }     
}  

###############################  $d == 365 o 366 (y seguro, porque los rebotes son hacia arriba)   

for ( 1 .. $TURNOS ){
    goto INIT if ( $set[0][0][$_] < $req[$_] * $dias ); 
}

my $e = 0;     # A OPTIMIZAR
my @err;                    # v. LM8 -> el error va a ser la suma de holguras negativas. Se usa para ranking y no tiene mucha importancia
                            # la disparidad en turnos que se la jueguen a los dardos

for my $trab (1..$TRABAJADORES){            # LA HOLGURA NEGATIVA ES LA MALA: TRABAJAR MÁS
    for my $turn (1 .. $TURNOS){
	my $tmp = $set[0][$trab][$turn] - $req[$turn] * $JORNADAS / $REQXDIA;  # error de la holgura, totalizada para todos los trabajadores;
	if ($tmp < 0){
	    $e += 10 * $tmp;           # heurística para primar la menor holgura negativa, pero 
	}else{
	    $e += -$tmp;              # también buscar más igualdad en las positivas (que pongo * -1)
	}
#	$err[$trab] += ( $set[0][$trab][$turn] - $req[$turn] * $JORNADAS / $REQXDIA ) ** 2;    # lo mismo, pero deglosado por trabajador y turno
    }   # versión 54h no sólo por día, sino por turno

    my $tmp2 = $set[0][$trab][0] - $JORNADAS;    # esto se hace porque no hay que poner interés total en el equilibrio de turnos y sí en jornadas (controladores)
    if ($tmp2 < 0){
	$e += 100 * $tmp2;
    }else{
	$e += -$tmp2;
    }
    $err[$trab] = $tmp2;
}
$e = abs( $e );

# if ($e <= $maxfacil){           
#    $maxfacil = $e;
# }else{
#    goto INIT;                         # Este es el rebote más fácil de superar
# }    

my @err2;

# my $e2 = 0;                    # $e2 no se usa para nada de momento y $err[] lista para un ranking de calendarios
for my $trab (1 .. $TRABAJADORES){
    my $ttt = 0;
    my $ttant = 0;
    my $t3 = 0;
    for my $ddd (1 .. $dias){
	if ($set[$ddd][$trab][0]){
	    $t3++;
	    for my $turn (1 .. $TURNOS){
		if ($set[$ddd][$trab][$turn]){
		    $ttt = $turn;
		    last;
		}
	    }
#	    $e2 += abs($ttant - $ttt) % 2;    # el problema es que puede haber secuencias largas con descanso corto en medio
	    $err2[$trab]++ if $ttant != $ttt;   # diferencia o no con turno anterior. Descansos cuentan 
	    $ttant = $ttt;
	}else{
	    $ttant = 0;
	    if ($t3 > $CURROMAX){ $err[$trab] += $t3; }   # esto no se miró antes para la agilidad de los ajustes (se mira en insert()) 
	    $t3 = 0;                                      # No debería pasar nada de esto, pero nunca se sabe
	}
    }
}

my @holgura;

if ( $e < $max ){   # la duda es ¿por qué miro si $d aquí si ya reboto en (*) si no >= $d?
    $max = $e;
    $NSOL++;
    $fracasos = $k = 0;
    
#    for my $i (0 .. $dias){
#	for my $j (0 .. $REQXDIA*2){
#	    for my $t (0 .. $TURNOS){
#		$bestset[$i][$j][$t] = $set[$i][$j][$t];
#	    }
#	}
#    }
	
    say "\n ====== Solución factible y mejor $e; número $NSOL ======     ", scalar localtime();
    open my $OUT, '>', $FICHERO or die "Cannot open $FICHERO: $!"; 
    my $minutes = $diff_t / 60;
    say $OUT "\n\nCalendario generado por $0 a ", scalar localtime();
    say $OUT "Tomando $diff_t segundos, ($minutes minutos) desde el inicio de tipo de problema\n";
    say $OUT "\nNUMERO DE SOLUCIÓN  $NSOL                         file=$FICHERO\n";
    printf $OUT "\n%i trabajadores \n%i requisitos\nE-index %i day %i\n",$TRABAJADORES,$REQXDIA,$e,$dias;
    for my $trab (1..$TRABAJADORES){
	printf $OUT "\n\nTrabajador %i\n\n    ENE FEB MAR ABR MAY JUN JUL AGO SEP OCT NOV DIC", $trab;
	for my $i (1 .. 31){
	    my $dd = $i;
	    printf $OUT "\n%i " , $i ;
	    if ($i < 10){ print $OUT " "; }
	    for my $x (0 .. 11){      # quiero saber el mes anterior
		$dd += daysinmonth($x,$YEAR);
		if ($dd <= $dd -$i +daysinmonth($x+1,$YEAR)){
		    $flag=0;
		    for my $turn (1..$TURNOS){
			if ($set[$dd][$trab][$turn]){			  
			    printf $OUT "   %s",$ch[$turn];
			    $flag=1;
			    last;
			}
		    }
		    if ($flag==0 && $dd >= $inivaca[$trab] && $dd <= $finvaca[$trab]){
			print $OUT "   V";
		    }elsif ($flag==0 && ($dd < $inivaca[$trab] || $dd > $finvaca[$trab]) ){
			print $OUT "   D";
		    }
		}else{ 
		    print $OUT "    "; 
		}
	    }
	}
	print $OUT "\n ",$set[0][$trab][0]," trabajos:  ";
	for my $turn (1..$TURNOS){ 
	    print $OUT " ",$ch[$turn]," ", 0+$set[0][$trab][$turn]; 
	}
    }
    say $OUT "\n\nSome stats:";
    for my $trab ( 1 .. $TRABAJADORES ){

	$holgura[$trab] = $JORNADAS - $set[0][$trab][0];             # Esto es importante, porque puede equilibrarse entre años o en el mismo año, o etc. 
	
	print $OUT "Trabajador $trab  M ", f( $set[0][$trab][1] ),"  T ", f( $set[0][$trab][2] ),"  N ", f( $set[0][$trab][3] );
	print $OUT +f( $set[0][$trab][0] ) if (defined $req[4]);
	print $OUT "  = ", f( $set[0][$trab][0] ),"  Holgura = ", f($holgura[$trab]), "\n"; 
    }
    say $OUT "";
    say $OUT "Total trabajo asignado = ", $set[0][0][0];
    say $OUT "Total trabajo potencial grupo = ", $TRABAJADORES * $JORNADAS;
    say $OUT "Total trabajo requerido grupo = ", $dias * $REQXDIA;
    say $OUT "\n\n";
    
    # mié 28 may 2025 06:19:49 CEST
    
    # ESCRIBE SUPUESTAS PREFERENCIAS 
    
    # Este fichero sustituye a los valores de puntuación de encuestas a los trabajadores
    # la cosa no es fácil porque depende de utilidad (+) y de costes (-). Estos últimos
    # más fáciles de estimar. 
    
    
    # 2) Costes. Pueden estar relacionados con el error medido en $e, pero no interesa la 
    # desigualdad como error aquí, ya que si a alguien le toca un calendario desigual bueno,
    # no es coste. Tonces, vamos a restar noches y mañanas, sumar tardes y holguras positivas.
    # El resultado será negativo, cuanto menor, mejor.

    my @costes;
#	my $y = 0;
    for my $cal (1 .. $TRABAJADORES) {
	$costes[$cal] = -2*$set[0][$cal][3] + $set[0][$cal][2] + -1*$set[0][$cal][1] - ( $holgura[$cal] );
	$costes[$cal] -= 2*$set[0][$cal][4] if (defined $req[4]);
        # Suposiciones de soltero español: tardes sí (1), noches no (-2), mañanas a disgusto (-1)
	# Las holguras son más fáciles porque si son negativas es trabajar más jornadas, pero
	# puede darse el caso de que sea con menos noches, o etc. por lo que esto es sólo culpa del robot
#	    $y += $costes[$cal-1];
    }
    
#	for my $i (1 .. $TRABAJADORES){
#	    $costes[$i-1] /= $y;                   # se supone que quedará entre -1 y 0
#	}

    # 1) La Utilidad depende del biorritmo, estado civil, etc. El caso es que simplificando 
    # mucho se puede considerar máxima para el trabajador 1 (= $TRABAJADORES+1) e ir restando
    # 1 punto por cada trabajador.
    
    my @util;
    @util = sort { $costes[$b] <=> $costes[$a] || $a <=> $b } 1 .. $TRABAJADORES;
    unshift @util, 0;
    
    my @util2;
    @util2 = sort { $err2[$b] <=> $err2[$a] || $a <=> $b } 1 .. $TRABAJADORES;
    unshift @util2, 0;
    
    my @util3;
    @util3 = sort { $err[$b] <=> $err[$a] || $a <=> $b } 1 .. $TRABAJADORES;
    unshift @util3, 0;
    
#    my $tt = 0;
#    for (@util){
#	$util[$trab] = ($TRABAJADORES+1)-$trab;   # ranking donde 1 es el primero y $TRABAJADORES el último
#	$util[++$tt] = $_;                       # (supongamos que es la auntigüedad y vale ya)
	# Otra forma de hacerlo sería mirar sólo costes, hacer un ranking y repartir
	# EL PROBLEMA DE ESTO ES QUE EVITA EL PROBLEMA DE ASIGNACIÓN QUE MUY LABORIOSAMENTE propongo en 'next03'
	# o encuentas o baremos o lo que diga la rubia
	
# (pero eso es muy simple. Casi prefiero separar la holgura y enchufársela a $trab
#    }                                        # pero resulta que la escala no puede casar con la matriz
                                             # de costes, o sea que esto igual hay que doblarlo, o etc. 
	
    # Nombre de fichero: El del problema, sustituyendo ".out" por ".prefs"

#    my $FICHERO2 = $FICHERO;
#    $FICHERO2 =~ s/out/prefs/;
    
    # La idea es que este fichero se optimice aparte, siguiendo un modelo de asignación 'next0N'

#    open my $fh2, ">", $FICHERO2 or die "Cannot open $FICHERO2";
    say "It's supposed to rank 1 to $TRABAJADORES by preferences:\n" if $DEBUG == 4; 
    say $OUT "It's supposed to rank 1 to $TRABAJADORES by preferences:\n"; 

#   First, chronotypes: most frecuent afternoon 40-50% (say 45%) and morning and nigth around
#   20-30% (sat 55/2 = 27.5%). I guess wrong morning > nigth, could be, could be not     
    
    say "Rank 1) by utility, more afternoon, less nigths and morningstar" if $DEBUG == 4;
    say $OUT "Rank 1) by utility, more afternoon, less nigths and morningstar";    
    for my $trab (1 .. $TRABAJADORES){
#	for my $cal (1 .. $TRABAJADORES){
#	    print $next +($util[$trab] - $costes[$cal]), " ";
#	    print +($util[$trab] - $costes[$cal]), " " if $DEBUG == 3;
#	}
	say "Worker $trab -> better calendar number ", $util[$trab] if $DEBUG == 4;
	say $OUT "Worker $trab -> better calendar ", $util[$trab];
    }
    
    say "\nRank 2) by errors, for counters of switching shifts" if $DEBUG == 4;
    say $OUT "\nRank 2) by errors, for counters of switching shifts";
    for my $trab (1 .. $TRABAJADORES){
	say "Worker $trab -> better calendar number ", $util2[$trab] if $DEBUG == 4;
	say $OUT "Worker $trab -> better calendar ", $util2[$trab];	
    }

    say "\nRank 3) by errors, for counters of slacks over and under requisites" if $DEBUG == 4;
    say $OUT "\nRank 3) by errors, for counters of slacks over and under requisites";
    for my $trab (1 .. $TRABAJADORES){
	say "Worker $trab -> better calendar number ", $util3[$trab] if $DEBUG == 4;
	say $OUT "Worker $trab -> better calendar ", $util3[$trab];	
    }
    
    say $OUT "\nImportant note: If the assignement is important, do it by hand\n";
    say "\nImportant note: If the assigment is important, do it by hand\n" if $DEBUG == 4;
    close $OUT; 
    
    if ($e == 0){   # NO SÉ SI ES TOTALMENTE IMPOSIBLE (lo + seguro) O CASI
	if ($cmax == 1) {
	    exit 100; # Éxito total pero de un solo problema 
	}else{
	    goto PEZ; # Siguiente problema que en este está bordado (en teoría)
	}
    }    
}

if (++$fracasos <= $MEGA365){       # no se mejora $max  
    # (son 10) Esto pasa al siguiente calendario
    goto INIT;       # no es óptima => empezar de nuevo
}else{               # se le pasó el arroz
    goto trabajadores;  # Bucle mayor que incrementa $TRABAJADORES
}                       # Hasta ahora no hizo falta nunca, pero no se sabe si se pide más

THEEND:

# Por aquí no debería pasar nunca, pero igual suena la flauta y se acaba el lote 

say "\n\nE-index = $max or cmax = $cmax reached. Non plus ultra.";
say "Revision is recommended. See you!\n";

exit 2;



###################################################################################################################################################### MAIN END HERE, MAIN PROBLEMS TOO





sub f {
    my $n = shift;
    $n //= 0;
    return sprintf ("% 3d", $n);
}
    
sub motor {
    my $dia = shift;
    my @capaz;
    for my $trabaj ( jlm(1..$TRABAJADORES) ){
	if ( $dia < $inivaca[$trabaj] || $dia > $finvaca[$trabaj] ){     # AL PRINCIPIO YA DESCARTA LOS EN VACACIONES
	    unless ( $set[$dia][$trabaj][0] ){
		push @capaz, $trabaj;
	    }
	}
    }
    state $kount;
    if ( ++$kount % $REQXDIA == 0 && $dia > 1){    # en día 1 no hay stats, luego no se puede ordenar
	@capaz = sort { $set[$dia-1][$a][0] <=> $set[$dia-1][$b][0] } @capaz;   # si fuese así sería ordenarlos de + a - disponibilidad en ese momento
	return @capaz;
    }
    return jlm(@capaz);  # Mirar en distinto orden es necesario para ajustar fácil -> shuffle
}

sub borra {
    # dia a eliminar $d
    for my $trab (1..$TRABAJADORES){
	for my $turn (1..$TURNOS){
	    if  ( $set[$d][$trab][$turn] > 0){       # != 0;
		
		$set[$d][$trab][$turn] = 0;
						
		$set[$d][0][$turn]--;
		if ($set[$d][0][$turn] < 0) { $set[$d][0][$turn]=0; }
		
		$set[$d][$trab][0]--;  
		if ($set[$d][$trab][0] < 0) { $set[$d][$trab][0]=0; }
		
		$set[$d][0][0]--;
		if ($set[$d][0][0] < 0) { $set[$d][0][0]=0; }		

		$set[0][$trab][$turn]--;
		if ($set[0][$trab][$turn] < 0) { $set[0][$trab][$turn] = 0; }
		
		$set[0][0][$turn]--;
		if ($set[0][0][$turn] < 0) { $set[0][0][$turn]=0; }
		
		$set[0][$trab][0]--;  
		if ($set[0][$trab][0] < 0) { $set[0][$trab][0]=0; }
		
		$set[0][0][0]--;
		if ($set[0][0][0] < 0) { $set[0][0][0]=0; }		
	    }
	}
    }
}


sub insert {
    my ($dia,$tmp,$turn) = @_;              # AQUI TODO ES SOLO PARA UN TURNO
    my @trab = @$tmp;
    my @return;

    my $x = ($dia > $PERIODO) ? $dia-$PERIODO : 1;     # MAX length
    
    for my $tr (@trab) {
	if ($dia >= 2) {
	    if ( $set[$dia][$tr][$turn] ){
		# do nothing, yet done
		next;
	    }
	    if ($TURNOS >= 3){
		if ( ($set[$dia-1][$tr][3] || $set[$dia-1][$tr][4]) && $turn == 1 ){               # Lo que se intenta no es bueno, ni mirado desde el frente. Sólo cuando haya $req{N}==0  
		    push @return, $tr;          # reciclable para otros turnos
		    next;
		}
	    }
	}
	
	my ($z,$y) = (0,0);	
	for my $i ( $x .. $dia-1 ){
	    if ( $set[$i][$tr][$turn] ){
		$y++;
#		}else{
#		    $z++;
	    }
	}
	next if ($y >= $CURROMAX);

	$set[$dia][$tr][$turn] = 1;
	$set[$dia][0][$turn]++;
	$set[$dia][$tr][0]++;    
	$set[$dia][0][0]++;
	$set[0][$tr][$turn]++;
	$set[0][$tr][0]++;
	$set[0][0][$turn]++;
	$set[0][0][0]++;
	return if ($set[$dia][0][$turn] == $req[$turn]);
    }
    return @return; 
}


sub compru {

    for my $turn (1..$TURNOS){
	return -1 if ($req[$turn] > $set[$d][0][$turn]);            # Lo importante, podría ser -$PERIODO, pero es overkill
    }
    return 1 if $d <= 1;

# if (0){    
#    my $x = ($d > $PERIODO) ? $d-$PERIODO : 1;     # MAX length
    
#    for my $trab (1 .. $TRABAJADORES){    

#	my ($z,$y) = (0,0);	
#	for my $i ( $x .. $d ){
#	    for my $j (1 .. $TURNOS){
#		if ( $set[$i][$trab][0] == 0 ){
#		    $z++;
#		}else{
#		    $y++ if ($set[$i][$trab][$j]);
#		}
#	    }
#	}

#	return -3 if ($z > $DESCANMAX);
#	return -4 if ($y > $CURROMAX);
#    }
    
	# de vacaciones, no es recomendable trabajar (así se ve quién roba)
#	if ( $d < $inivaca[$trab] || $x > $finvaca[$trab] ) {
#	    if ($z < $DESCANMIN || $y > $CURROMAX){    # exceso de jornadas seguidas detectado. Esto va en compru()
#		return -5;                             # no aceptar
#	    }
#	}      	
# }
    
#    if ($d == $dias){
	if ($set[0][0][0] >= $REQXDIA * $d && $set[0][0][0] <= $JORNADAS * $TRABAJADORES){       # se ajusta lo que se ajusta, ya vendrán los desjustes solos
	    return 1;
	}else{ 
	    return -2; 
	}
#    }
    return 1;
}

######################### FIN REVISIÓN   mié 12 mar 2025 13:07:46 CET

	  
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.

Timetable problems are a well known NP problems. In it's multiple 
  incarnations, it's just the shift working scheduling problem. There
  are articles regarding a solution in short capable PC computers,
  but there is always the possibility to not to limit to a fit/don't
  fit timetables, and to construct an arbitrary objective function to
  address problems of inequality/vacations/biorrithms preferences, or 
  simply to minimize slacks and costs derived to special shift works.
  So to speak, enough combinations to take in consideration this as 
  phase 1 of the timetable problem. A possible phase 2 problem is to 
  address real lack of disponibility of people, real time, for which 
  the precalculated slack shift working times serve as data to handle
  the assignation of extratime work.

Jesús Lozano Mosterín, mar 11 mar 2025 01:11:07 CET