#!/usr/bin/perl

use 5.040.3;   # Safe bet

### Como este script me ha quedado bastante bien,
### (c) Jesús Lozano Mosterín, 2025


#  Voy a tratar de aplicarlo a 'cutting stock' que puede ser lámina o alambre 
# (tradicionalmente resueltos por lp)

my $timeout = 60 * 10;    # 10 minutos
my $t0 = time();

# Problema de una dimensión
# Supuesto máxima longitud = 100
# Tipos a cortar 1/10, 1/11, 1/3 sobre 100
# Minimizar derroche o decidir longitud total
# Elijo decidir longitud total <= 1000
my $LL = 1_000;

my $max = -9e99;
my @tipos = ($LL/10, $LL/11, $LL/3, $LL/5, $LL/7, $LL/13);    
my @nombres = qw(décimos onceavos tercios quintos sieteavos treceavos);
my @ptipos = ( 1*$tipos[0], 2*$tipos[1], 3*$tipos[2], 4*$tipos[3], 5*$tipos[4], 6*$tipos[5] );  
# el coste puede ser el mismo,
# el precio no, y lo pongo mayor para mayor longitud de los trozos
my $ingreso = 0;

my @candidat;
my @rdo;

# 0j0: puede haber varias soluciones, y además puede convertirse en un PCP
# product cycling problem 

my $L = 0;
my $min = 9e99;

say "\nEl objetivo es longitud $LL por debajo, dados los tipos de trozos, y, como prueba, $LL-L, derroche pequeño\n";

# se introduce la sub req() llamada por objective()
# se introduce sub generador_candidatos() que da $L, necesariamente múltiplo
# No es un conjunto entero muy grande, mal por el ejemplo
# (me temo que esto no se va a parecer a lo intencionado, como siempre)

my $result = 0;
while ($min >= 1){
    last if (time() - $t0 > $timeout);
    $L = generador_candidatos();
    next if (req($L) != 1);
    
    my $tmp = abs(objective($L) - $LL);
    if ( $tmp < $min && $min >=  0){
	$min = $tmp;
	$result = $L;
	say "parcial:  $result -> error $min";
	goto salida if $min == 0 && comprobe($result) == 1;
    }
}
say "[procedimiento de terminación normal]";
salida:

say "-" x 80;
say "Y el número de partes ganador es:";
for my $i (0.. scalar(@rdo)-1){
    say $i+1, ") $nombres[$i] => cantidad $rdo[$i]";
}
say "con logitud $result e ingreso $max\n";

exit 2;


sub objective {          # CHANGE THIS TO YOUR NEEDS
    my ($i)  = @_;
#    $i //= $L;       # test standard MonteCarlo
#    return exp($i);     # This is the target example. Could be any function 

    if ($ingreso >= $max){
	$max = $ingreso;
	@rdo = @candidat;
	return $i;
    }
    return $LL ** 4;              #  se minimiza 
}

sub req {
    my $i = shift;
    return 1 if ($i <= $LL && $i > 0);
    return 0;
}

sub generador_candidatos {
    my $l = 0;
    $ingreso = 0;
    for my ($j, $t) (each @tipos){
	$candidat[$j] = int ( ($LL / $t) * rand() );   # número de trozos por tipo
	$l += $candidat[$j] * $t;
	$ingreso += $candidat[$j] * $ptipos[$j];
    }
    return $l; 
}
    
# sub signo {             # no se usa :-) quizá el del zodiaco :-) :-)
#    my $j = shift;
#    if (objective($j) > $LL){
#	return 1;
#    }else{
#	return -1;
#    }
# }

sub comprobe {          # DEPENDS ON EXAMPLE 
    my ($k) = shift;      # for the test, despite is a redundant one. $min == 0 will suffer
    state $resultant;
    $resultant = $k if ($LL - $k < $resultant);
    return 1 if ($k == $resultant);   ## llegar 2 veces al 'óptimo' supuesto es garantía 
    return 0;
#    return 1 if (exp($L) == $INPUT * exp(1));
#    return 0;
}

__END__
  
Al parecer, ya no es necesario $resultant para 'aprender'
  de la mejor solución anterior. Se reusa $result.