#!/usr/bin/perl -w

use 5.030;
use Safe;

print <<EOT;

El siguiente script corresponde a una simulación sencilla
en la que el coste de contratación normal por empleado es
unitario. Por lo tanto, las decisiones se basarán en hacer
frente de la mejor forma posible a la demanda, contratando
y despidiendo trabajadores.
La demanda se simula mediante una distribución triangular
y los parámetros iniciales de número de períodos, y costes
de contratación y despido expresados en tantos por uno con
respecto a los costes salariales normales unitarios.

EOT

say "-" x 78;
print "Demanda pesimista: ";
chomp(my $a = <STDIN>);
print "        normal   : ";
chomp(my $b = <STDIN>);
print "        optimista: ";
chomp(my $c = <STDIN>);
print "Cálculo puntual en: ";
chomp(my $x = <STDIN>);
m1:
print "Masa central deseada [<1]: ";
chomp(my $masa = <STDIN>);
if ($masa > 1) { 
    goto m1; 
}
say "";

my $h = 2/(($b-$a)+($c-$b));
say "La altura es $h";
my $AP = (($b-$a)*$h/2) / ((($b-$a)*$h/2) + (($c-$b)*$h/2)); # proporción de la izquierda
my $AO = 1-$AP;        # derecha de la punta b del triángulo 
say "El área pesimista es $AP";
say "El área optimista es $AO";
warn "El área no suma 1" if $AP+$AO != 1;
sleep 1;
say "";

my $mediana = puntop(0.5);
say "La mediana es $mediana \n";
sleep 1;
printf "El punto %.5f deja a su izquierda %.5f y a su derecha %.5f\n", $x, probab($x), (1-probab($x));
sleep 1;
say "";

my $prob = (1-$masa)/2;  # triangulitos a los lados
my $xx = puntop($prob);
$prob += $masa;
my $y = puntop($prob);
printf "Entre el punto %.5f y el punto %.5f esta el %.5f de probabilidad\n\n",$xx,$y,$masa;


my ($contrat,$despido,$p,$currantes,$ncontrat,$ingreso,$cdespido,$ccontrat)=0;
my ($beneficio,$beneacu,$demanda,$demacu)=0;
my @duracion;
say "-" x 78;
print "Sobrecoste de contratación (tanto por 1): ";
chomp ($contrat=<STDIN>);
print "Sobrecoste de despido      (tanto por 1): ";
chomp ($despido=<STDIN>);
print "Número de períodos         (entero)     : ";
chomp ($p=<STDIN>);
say "-" x 78;

print "\nComienza la simulación... \n";

$beneacu=$currantes=0;
for (my $i=1; $i<=$p; $i++){
         print "\nIteración $i ";
         sleep 1;
         $prob=rand();
	 $demanda=puntop($prob);
	 say "La demanda es de $demanda \n";
	 $demacu += $demanda;
	 $ncontrat=$cdespido=$ccontrat=0;
	 print "¿Cuántos trabajadores quiere contratar (>0) o despedir (<0)? \n (signo) N = ";
	 $ncontrat = <STDIN>;
	 chomp($ncontrat);
	 if ($ncontrat eq "") { $ncontrat=0; }
	 if ($ncontrat<0){
	        for (my $j=$currantes; $j>$currantes+$ncontrat; $j--){
                     $cdespido += $despido*$duracion[$j];
		     $duracion[$j]=0;
	        }
	 } elsif ($ncontrat>0) {
	        for (my $j=$currantes+1; $j<=$currantes+$ncontrat; $j++){
	             $duracion[$j]=0;
		}
                $ccontrat = $contrat*$ncontrat;
	 }else {
	     # do nothing $ncontrat == 0
	 }
         $currantes += $ncontrat;   # si es negativo, resta
	 if ($currantes>0) {
	        $ingreso = 2*$demanda*($currantes/(1+$demanda));             # SCORE FUNCTION 
		say "\tEl ingreso bruto anual fue de $ingreso \n"; 
	 } else {
	        $ingreso=0;
		say "\tNo hay ingresos por falta trabajadores \a\n";
		$currantes=0;
	 }
	 say "\tLa plantilla actual es $currantes \n";
	 say "\tEl coste de contratación es $ccontrat \n";
	 say "\tEl coste de despido es $cdespido \n";
         $beneficio=$ingreso-$currantes-$ccontrat-$cdespido;
         say "\tSu BENEFICIO ANUAL es de $beneficio \n";
	 $beneacu+=$beneficio;
	 say "\tEl BENEFICIO ACUMULADO es de $beneacu \n"; 
	 say "\ty le quedan ", $currantes," trabajadores con las siguientes antigüedades:\n";
	 for (my $j=1;$j<=$currantes;$j++){
	         ++$duracion[$j];
	         print "\t",$j,") ",$duracion[$j];
		 if ($j%8==0) { print "\n"; }
	 }
	 say "\n";
}
sleep 1;
say "." x 78;
say "\nEl juego ha finalizado. Usted ha ganado $beneacu \n";
say "lo cual supone un beneficio medio de ",$beneacu/$p,"\n";
say "sobre una demanda total de ",$demacu," y media ",$demacu/$p,"\n";
say "." x 78;
say "\a\n";

exit 1;


sub probab{
    my $x = shift;
    if ($x < $b){
          return  $h * ($x-$a)**2 / (2*($b-$a));
    }else{
          return  1 - $h * ($c-$x)**2 / (2*($c-$b));
    }
}

sub puntop{
    my $probabilidad = shift;
    die "Error" if $probabilidad <0;
    if ($probabilidad < $AP){
          return $a + sqrt( 2 * $probabilidad *($b-$a)/$h );
    }else{
          return $b + ( ($probabilidad-$AP)/$h );    
    }
}

__END__

Este programa ha sido vandalizado y restaurado a fecha
30/12/21