#!/usr/bin/perl

use 5.034;

my $DEBUG == 1;

# presupuestos ordenados de + a - y en U represupestar hacia arriba

# Requisitos: % incremento postivo máximo del total y de cada partida,
# incluyendo decrementos 

# Se aleatoriza dentro de los rangos y se mide la idoneidad por el mayor
# incremento postivos de las partidas de arriba (más prioridad)

# Esto se puede hacer a través de un índice de las mejores 3, 5, etc partidas

####

# año 2020, Ayto

############################################ (c) Jesús Lozano Mosterín, 2023, 2025 ###################################################################

# my $ingresos = 233_020_000;  # 2021


if (0){
"
  GASTOS DE PERSONAL
  65.947.900,00

GASTOS CORRIENTES EN BIENES Y SERVICIOS
  40.242.345,03
  
GASTOS FINANCIEROS
  247.522,04

TRANSFERENCIAS CORRIENTES
  96.899.900,00
  
FONDO DE CONTINGENCIA Y OTROS IMPREVISTOS
  500.000,00

INVERSIONES REALES
  12.183.872,81
  
TRANSFERENCIAS DE CAPITAL
  7.715.724,39

ACTIVOS FINANCIEROS
  2.714.183,16
  
PASIVOS FINANCIEROS
  20.621.086,82

TOTAL
  247.072.534,25
  ";
}

# version 4 (2024) -> aditional requirements. I.e. minorate negative cuts
# version 5 (2025) -> imprimir en pantalla el presupuesto candidato

my @gasto = qw(Personal CorrientesByS Financieros Transf_Corrientes Provisiones Inversiones Transf_Capital Activos_fin Pasivos_fin);              
# my @partida = qw(62008400 46165000 674714 88865500 400000 11268893 7956853 3614700 18864802);  # 2021
my @partida = (65_947_900,40_242_345,247_522,96_899_900,500_000,12_183_872,7_715_724,2_714_183,20_621_086);   # 2022 PRESUPUESTADO
# version 5 -> minimums   # prueba de concepto
my @minimos = (60_000_000,30_000_000,200_000,80_000_000,400_000,10_000_000,5_000_000,1_000_000,15_000_000); 
my @notocar = (         0,         0,      0,         1,      0,         0,        0,        0,         1);    # no alterar la cifra pasada

my $ingresos = 0;
$ingresos += $_ for (@partida);

my @prio = qw(0 1 2 4 5 3 6 8 7);  # ordenación por prioridades, THE HACK!

# v.6 Por supuesto, este ranking puede hacerse sobre cualquier base de puntuación.
# De hecho, es posible que haya empates. Se trataría de normalizar el ranking y 
# obtener la priorización por ordenación según bases normalizadas.

if ($DEBUG == 1){
    say "=" x 70;
    for my $i (@prio){
	say "Partida $i -> presupuesto base y su mínimo =   $partida[$i]  $minimos[$i]";
    }
    say "TOTAL = $ingresos";
    say "=" x 70;
}

my $INCREMENTO = 0.06;  # este va a ser el objetivo
my ($low, $high) = (-0.05, 0.15);

my $range = $high - $low;
my $n = scalar @partida;
my @r;
# my $nsol = 20; # número de soluciones
# my $c = 0;

my $resultant = $low;
my (@ppto, $result, $sum, $cuts, $MINcuts);
$MINcuts = 9e99;

alarm (60*5); # 5 minutos  
say "TIMEOUT = 5 min.";
say "";

my $counter = 0;

for (my $c; ; ){
    $r[$_] = $low + rand() * $range for (0 .. $n-1);   # como $low puede ser negativo, no se sabe el signo
    @r = sort { $b <=> $a } @r;  # de más a menos
    $cuts = 0;
    
    my $s = 0;                           # sum of any good and bad iteration
    for my $j (@prio){                   # prio[i] -> prioridad de i normal
	$ppto[$j] = (1+$r[$j]) * $partida[$j];	
	if ($ppto[$j] < $minimos[$j]){
	    $ppto[$j] = $minimos[$j];     # si baja al mínimo
	}elsif ($notocar[$j]){
	    $ppto[$j] = $partida[$j];     # inalterable
	    $r[$j] = 0;
	}
	$s += $ppto[$j];
	if ( $r[$j] < 0 ){               # cut detected
	    $cuts += $ppto[$j];
	}
    }
    $result = ($s / $ingresos) - 1;    
    
    $counter++;
    
    next if ( $result > $INCREMENTO );
    
    if ($result >= $resultant){
	if ( $cuts <= $MINcuts ){
	    $MINcuts = $cuts;
	    $c++;                    # succes
	}else{
	    next;
	}
	$resultant = $result;
	say "-" x 70;
	say "\n          Numeración de propuesta: $c\n";      # espacio reservado para publicidad
	say "Número de intentos calculados = $counter\n";
	for my $j (@prio){
	    say "$j GASTO $gasto[$j] = ", r($ppto[$j]), " €      (", r(100*$r[$j]), " %)";
	}
	say "\nIncremento = $result (tanto por uno)";
	say "Recortes de presupuesto = $cuts €";
	
	say "\nPor prioridades inversas:";
	for my $j (reverse @prio){
	    say "Partida número $j -> ", r($ppto[$j]), " € ";
	}
	say "";
	$sum = 0;
	$sum += $_ for @ppto;
	say "Sumas y saldos:     gasto total próximo año  = $sum €";
	say "                    presupuesto año anterior = $ingresos €";
	say "";
	say "Incremento comprobado = ", 100*( ($sum / $ingresos) -1), " %";
	say "";
    }
}

exit 3;

sub r {
    my $nn = shift;
    if ($nn > 300) {     # se sabe seguro que es dinero y no un porcentaje ni un tanto por uno
	return sprintf ("%.02f", $nn);
    }else{
	return sprintf ("%.06f", $nn);
    }
}


__END__
  
Con un plazo de 5 minutos parece dar muchas versiones "buenas"
  La v.4 introduce supuestos realistas para minimizar las soluciones factibles
  y la progresión hacia mayor adaptación de requisitos.

Recommended usage:
  $ perl ppto4 > LISTADO.txt

jue 05 jun 2025 09:21:59 CEST
  
v5: Embellecimiento y redondeo, y se pueden poner mínimos cualesquiera >= 0