#!/usr/bin/perl

use 5.034;
# use utf8;

my $DEBUG = 1;
my $VERSION = 0.903;
my $timeout = 120;      # minutos, una hora mínimo
my $MAGIC_RANGE_VARIATION = 5;   # esto determina la posible distancia entre el % vertical de la máxima (prio 1) y la mínima (prio 9) partida del presupuesto

# En esta versión se eligen varios de varios incrementos

my @INCREMENTO = (0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.10);  # este va a ser el objetivo

# 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, 2026 ###################################################################

# 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

# mié 10 jun 2026 15:19:25 CEST
# mié 10 jun 2026 13:19:31 GMT
# Ayuntamiento de Gijón 2026 -> trasladar a 2027 según nuevas priorizaciones
# versión 7

my ($line1, $line2);
my (@gastosname, @gastosnum, @ingresosname, @ingresosnum);

my $clin = 0;
my $flag = 0;
# procedimiento ultracomplicado de lectura de datos pasados 2026
while( $line1 = <DATA> ){
    $flag = 0;
    rtrim ( $line1 );
    chomp $line1;
    next if ( $line1 =~ /^#/ );
    next if ( $line1 =~ /^\+/ );    # El dato del ingreso está muy bien, pero hay que gastar e invertir bien el montante que sea, sin presuponer presupuesto base 0
    last if ( $line1 =~ /ENDDATA/ );                                    # Realmente va matchear "ENDDATA" no en end of code, lo cual es de interés para inventarse varios DATA, p.ej. DATA1, DATA2, etc. 
    $clin++;
    
    # espacios no van a ser porque lo dije en DATA
    next unless (defined $line1);
    
    if ($line1 =~ /GASTO/ || $line1 =~ /FONDO/ || $line1 !~ /ENAJENACION/){                   # Esto va a ser un gasto, lo que interesa
	my ($name,$num) = (split (/\,/, $line1))[0,1];
	push @gastosname, $name;
	push @gastosnum, $num;
	$flag++;
	say "Lectura línea $clin" if $DEBUG; 
    }else{
	$flag = 0;
    }
}
# quitar EOL
chomp @ingresosname;
chomp @ingresosnum;
chomp @gastosname;
chomp @gastosnum;

# quitar el signo negativo a los gastos
my $sum = 0;
my @rinit;
for my $ind ( 0 .. scalar(@gastosnum)-1 ){
    $gastosnum[$ind] =~ s/\-//;
    $gastosnum[$ind] =~ s/\_//g;
    $sum += $gastosnum[$ind];
}
for my $ind ( 0 .. scalar(@gastosnum)-1 ){
    $rinit[$ind] = $gastosnum[$ind] / $sum;
}

my @prio;
my @pri;
my $index = 0;
for my $g (@gastosname){
    if ($g =~ /P\s?(\d+)/){
	$pri[$1]= $index;                          # las prioridades comienzan en 1 para poder ser sumadas
	$prio[$index] = $1;
    }
    $index++;
}
@prio = sort { $a <=> $b } @prio;  

# ¡¡¡Equipo de depuradores!!!   ->   :-)

@gastosname = sort { $prio[$b] <=> $prio[$a] } @gastosname;
@gastosnum = sort { $prio[$b] <=> $prio[$a] } @gastosnum;

# my @presupuestado_2026 = qw(Personal GastosCorrientes GastosFinancieros GastosGenerales Provisiones Inversiones Mantenimiento 
#    Ingresos_fiscales Ingresos_transferencias Ingresos_Empresas Ingresos_licencias Subvenciones_conced Subvenciones_recibidas);  

# 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
# version 7 -> intereactivamente poner mínimo de cada partida de gasto o sí se debiese, un 1 (verdadero) para congelar partida de gasto 

my (@minimos, @notocar);
@minimos = (100000) x scalar(@gastosname);
@notocar = (0) x scalar(@gastosname);                         # No congelar por defecto
for my $index (0 .. scalar(@gastosname)-1){
input:
    say "Partida de gastos $gastosname[$index] con dotación año previo de $gastosnum[$index]";
    print "Mínimo (no valen no digitos)? : ";
    chomp( my $r = <STDIN> );                           
    push @minimos, $r;
    
    unless (length $r >= 1){
	print "Congelar? [un carácter y/N] : ";
	chomp( my $r2 = <STDIN> );
	if ($r =~ /\D/) {
	    goto input;
	}
	$r2 = 0 if ( $r2 );
	$r2 = 1 if ( $r2 =~ /[Y|y|s|S]/ );        # Congelar
	push @notocar, $r2;
    }
}
say "\nData completed.\n"; 

# 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

# sáb 20 jun 2026 11:06:35 CEST
# sáb 20 jun 2026 09:06:44 GMT

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

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

# MANUAL JOB  <--- ATTENTION!!!
# my @prio = qw(0 1 2 4 5 3 6 8 7);  # ordenación por prioridades de gasto, THE HACK!
# END OF MANUAL JOB 

# supuesto de ingresos incremento = $INCREMENTO (rango)

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

# 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.

# v.7 Pues se trata de probar todo con todo

my $disponibleanual = 0;
my $sumprio = 0;
if ($DEBUG == 1){
    say "=" x 120;
    for my $i (0 .. scalar(@gastosnum)-1){
	say "Partida $i) $gastosname[$i] -> presupuesto base y su mínimo =     $gastosnum[$i]     min $minimos[$i]     cogelado $notocar[$i]";
	$disponibleanual += $gastosnum[$i];
	$sumprio += ($prio[$i]*$prio[$i]);     # cuadrado de la prioridad
    }
    say "TOTAL = $disponibleanual";
    say "=" x 120;
}

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

# my $range = $high - $low;

# my $nsol = 20; # número de soluciones

# my $low = (sort { $b <=> $a } @gastosnum)[-1];      # el menor
# my $range = (sort { $b <=> $a } @gastosnum)[0] - $low;    # max - min

alarm (61 * $timeout); # timeout minutos más hack de 61 segundos por minuto para que no falte tiempo real de comp, independendientemente de los descansos de calor  
say "TIMEOUT = 60 min.\n";

my (@ppto, $result, $cuts, $MINcuts, $resultant, $counter, $suma);
for my $incremento (@INCREMENTO){
    say "\nPROYECCION = ", $disponibleanual * (1 + $incremento);
    my $i;
    $MINcuts = $resultant = 9e99;
    $counter = 0;
    for ( my $c = 0 ; ; ){            # menos o 20 soluciones
	my @r;
	for my $i ( 0 .. scalar(@gastosnum)-1 ){
	    $r[$i] = (1 + $MAGIC_RANGE_VARIATION * $incremento * (rand()-0.5) * ($sumprio - ($prio[$i]**2)) / $sumprio);   # como $low puede ser negativo, no se sabe el signo
	}    
    
	$suma = $cuts = 0;                           # sum of any good and bad iteration
	for my $j (@prio){                           # prio[i] -> prioridad de i normal
	    $i = $pri[$j];
	    
	    $ppto[$i] = $r[$i] * $gastosnum[$i];	
	    
	    if ($ppto[$i] <= $minimos[$i]){
		$ppto[$i] = $minimos[$i];     # si baja al mínimo
		$r[$i] = $minimos[$i] / $gastosnum[$i];
	    }elsif ($notocar[$i]){
		$ppto[$i] = $gastosnum[$i];     # inalterable
		$r[$i] = 1;
	    }
	    $suma += $ppto[$i];
	    if ( $r[$i] < 0 ){               # cut detected
		$cuts += $gastosnum[$i] - $ppto[$i];
	    }
	}
	$result = ($suma / $disponibleanual) -1;   # se supone que $incremento > 0 (no siempre válido) 
    
	$counter++;
	select (undef,undef,undef,0.001);        # microsleep, es el bucle principal
	next unless (abs($incremento - $result) <= $resultant);
	$resultant = abs($incremento - $result);

#	    if ( $cuts <= $MINcuts ){
#		$MINcuts = $cuts;
# success	   
	say "-" x 120;
	say "\n          Numeración de propuesta: $c\n";      # espacio reservado para publicidad
	say "Número de intentos calculados = $counter\n";
	for my $j (@prio){
	    $i = $pri[$j];
	    say "prio $j) $gastosname[$i] -> $gastosnum[$i]     =>       ", p($ppto[$i]), " u.m.      (", p(100000*$r[$i])/1000, " %)";
	}
#		say "\nIncremento = $result (tanto por uno)";
	say "Recortes de presupuesto anterior = $cuts u.m.";
	
	say "\nPor prioridades inversas:";
	for my $j (reverse @prio){
	    $i = $pri[$j];
	    say "Partida número $i -> ", p($ppto[$i]), " u.m. ";
	}
	say "";
	say "Sumas y saldos:     gasto total próximo año  = ", p( $suma ), " u.m.";
	say "                    presupuesto año anterior = $disponibleanual u.m.";
	say "";
	say "Incremento comprobado = ", p( 100000*$result )/1000, " % \n";
	say "Terminado incremento de $incremento \n";
#	say "-" x 120;
	
	if (++$c > 3){
	    open my $fo, '>>', "ppto2027.out" or die $!;
	    say $fo "=" x 120;
	    say $fo "incr $incremento)";
	    say $fo "@r";
	    for my $i (0 .. scalar(@gastosnum)-1){
		say $fo "$gastosname[$i]    $gastosnum[$i]     ppto2027 = ",int($ppto[$i]),"     ", int((100000*$ppto[$i]/$gastosnum[$i]))/1000, " %";
	    }
	    say $fo "-" x 120;
	    close $fo;
	    last if ($resultant <= 0.0001);
	}
	sleep 1;
    }
    # fin de intento para el mismo incremento 
    sleep 1;
}  # sale por aquí del número de soluciones

say "\n $0 v$VERSION       ", scalar(localtime()), "\n";

exit 2;

sub rtrim {
    my $f = shift;
    $f =~ s/^\s+(\S+)/$1/g;
    return $f;
}

sub p {
    my $nn = shift;
    # se sabe seguro que es dinero y no un porcentaje ni un tanto por uno
    return int(0.5 + $nn);
#    return sprintf ("%f", $nn);
#    }else{
#	return sprintf ("%.02f", $nn);
#   }
}

__DATA__
# no poner lineas en blanco                                         /* blank lines not allowed */   
# AYUNTAMIENTO DE GIJÓN/XIXÓN
# Resumen por capítulos del presupuesto
# Periodo: 2026
# 
# Capítulos / Descripción
# Importe
# Ingresos
# OPERACIONES NO FINANCIERAS
# OPERACIONES CORRIENTES
+IMPUESTOS DIRECTOS, 11_4292_700
+IMPUESTOS INDIRECTOS, 16_016_000
+TASAS, PRECIOS PÚBLICOS Y OTROS INGRESOS, 23_723_900
# +TRANSFERENCIAS CORRIENTES INGRESOS, 117_784_500
+INGRESOS PATRIMONIALES, 2_923_900
# OPERACIONES DE CAPITAL
+ENAJENACION DE INVERSIONES REALES, 2_700_000
+TRANSFERENCIAS RECIBIDAS, 5_101_000
# OPERACIONES FINANCIERAS
+INGRESOS ACTIVOS FINANCIEROS, 2_448_900
+INGRESOS PASIVOS FINANCIEROS, 25_000_000
+INGRESOS ACTIVOS FINANCIEROS, 473_000
# Total Ingresos, 309_990_900
#
# Gastos
# OPERACIONES NO FINANCIERAS
# OPERACIONES CORRIENTES
#
######################################### AQUI EMPIEZA DE IMPORTANTE: PPTO DE GASTOS EN 'U' APALANCADO
#
#  
#
#
GASTOS DE PERSONAL P1, -77_213_700
GASTOS CORRIENTES P2, -55_751_500
# TRANSFERENCIAS RECIBIDAS P0, -117_474_900
FONDO DE CONTINGENCIA P3, -300_000
INVERSIONES Y TECONOLOGIA P4, -34_576_300
GASTOS FINANCIEROS P5, -1_842_800
TRANSFERENCIAS DADAS P6, -6_054_300
COSTE PASIVOS FINANCIEROS P7, -16_304_400
# Total Gastos, 309_990_900
ENDDATA
__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 ppto2027 > LISTADO.txt

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

v7: Hay un rango de incrementos de ppto, hay mínimos de partidas y hay posibilidad de congelar lo antiguo