#!/usr/bin/perl

use 5.040.3;

my $DEBUG = 1;

# dom 15 mar 2026 14:36:19 CET
# opciones sin normalidad, como fenómeno discreto 

# supongo que era el método similar a lo que se usaba
# sobre commodities antes de las opciones sobre acciones
# y la fórmula de Black-Scholes

# la cosa es que sobre un mercado amplio en número (acciones)
# sí puede tener más sentido suponer normalidad, pero sobre 
# un mercado de pocos agentes y pocos contratos (relativamente)
# la probabilidad puede ser frecuencista y no inferencial

# Lo importante de las opciones es que una vez compradas, es 
# dinero tirado (o no), y el valor que interesa saber es el valor
# esperado a la ejecución, si es 0 o mayor que cero. Menor que 0
# no puede ser, porque lo peor que puede pasar es que la opción
# no se ejerza.

my $Q = 100_000;               # cantidad fija en t = $intervalo
my $coste_fijo = 10;
my $P_objetivo = $ARGV[0] // 111;  
my $intervalo = 12;                    # no puede ser decimal por conveniencia
my $cuota = $ARGV[1] // 0.2;          # hace referencia al porcentaje de $Q
my $interes = 0.05 / $intervalo;       # interés del intervalo

my %V;   # esto es lo que recoge valor de 0 a 1, plazo de la opción o de la ventana de tiempo considerada
$V{0} = $coste_fijo;
my %V2;
$V2{0} = $coste_fijo;

# simular inputs de contratos ya conocidos (lado de la oferta)
# o ya realizados (lado de la demanda). De momento me da igual
my (@p, @q);    # p -> precios obervados, q -> cantidad fracción de < $Q 

my $obs = 2;  # contratos iniciales 
for (my $t = 1; $t <= $intervalo; $t++){
    $obs += int( 1 + 15 * rand() );                        # número de observaciones, contratos. Pueden ser diferentes por tiempo
    for my $i (0 .. $obs){                                    # ser añaden $n datos a la lista de cada momento $t
	$p[$t][0] = $obs;   # el truco del almendruco
	next if $i == 0;
	my $tmp = $P_objetivo * (0.3 + 0.7 * rand());
	$p[$t][$i] = $tmp;                               # ESTOS DATOS SON BASE 0
	$q[$t][$i] = $Q * ($t / $intervalo) * (0.8 + 0.2 * rand()) * $tmp;         # es una cantidad, diferente a lo pensado inicialmente	 
	                                                                                  # directamente proporcional a p[t] y t relativo
    }    # 0j0 : no es matriz rectangular
}
    
################

my ($p_corte, $cantidad, $cantidad2);
my $valor_call = 0;
my $valor_put = 0;

say "El coste fijo de firma no se tiene en cuenta en el valor de ejercicio";

my $sumadigits = 0;
for (my $t = 1; $t <= $intervalo; $t++){
    $sumadigits += $t;
}

for (my $t = 1; $t <= $intervalo; $t++){
    
    ($p_corte, $cantidad) = discrete ( $cuota, $t, \@p, \@q );	
    
    $valor_call = ($P_objetivo > $p_corte) ? ($P_objetivo - $p_corte) * (1 + $interes) ** (-($intervalo-$t)) :0; # - $coste_fijo * (1 + $interes) ** $t : 0; 
    $valor_put = ($p_corte > $P_objetivo) ? ($p_corte - $P_objetivo) * (1 + $interes) ** (-($intervalo-$t)) :0; # - $coste_fijo * (1 + $interes) ** $t : 0;  
    $V{$t} = ($valor_call > 0) ? $valor_call : $valor_put;
    $V{$t} = ($V{$t} - (0 * $V{0} * (1+$interes)**$t) < 0) ? 0 : $V{$t};         # los costes hundidos no aportan valor a $V, que es para comprar $Q
    if ($V{$t} == 0){ $cantidad = 0; }
    print sprintf ("%02d", $t) , ")   nobs= ", sprintf("%02d",$p[$t][0]), "   v1= ",f($V{$t}), " q1= ",f($cantidad);
    my $tacum;
    if ($t < $intervalo){
	# %V2 es el valor que tiene sólo por no estar vencido el plazo de ejecución
	($p_corte, $cantidad2) = discrete ( $cuota, $t+1, \@p, \@q );                  # $cantidad2 == $cantidad del $t siguiente
	# tiene que tener menos valor el $V2 de t que el $V de t+1
	$tacum += $t;
	$valor_call = ($P_objetivo > $p_corte) ? ($P_objetivo - $p_corte) * ((1 + $interes) ** (-($intervalo-$t+1))) : 0; # - $coste_fijo * (1 + $interes) ** $t : 0; 
	$valor_put = ($p_corte > $P_objetivo) ? ($p_corte - $P_objetivo) * ((1 + $interes) ** (-($intervalo-$t+1))) : 0; # - $coste_fijo * (1 + $interes) ** $t : 0;  
	$V2{$t} = ($valor_call > 0) ? $valor_call : $valor_put;
	$V2{$t} = ($V2{$t} -$V{$t} < 0) ? 0 : $V2{$t};             # $V2 podría ser negativo, pero no interesa
	if ($V2{$t} == 0){ $cantidad2 = 0; }
        print "   v2= ", f($V2{$t});
    }
    say "";
}

# my $report;
# $report = discrete(\@p, \@q);
# say $report, "\n";

exit 3;

sub f {
    my $num = shift;
    $num = sprintf "%.02f", $num;
    return " " x (12 - length($num)) . $num; 
}

    
sub discrete {
# generic discrete probability
    my ($prob, $tt, $i, $j) = @_;
    my @px = @$i;
    my @qx = @$j;
    
    # hasta aquí lo conocido
    
    # $prob es el punto para el que se pide probabilidad "<=" y ">" 
    
    my @idx = 1 .. $px[$tt][0];   # BASE 1
    @idx = sort { $px[$tt][$a] <=> $px[$tt][$b] } @idx;   # ascendente por precio, por defecto, pero podría no ser así
    
    # SE ESPERA QUE CONSERVE BASE 0 PARA EL RESTO DE SUB
    my %h;
    for my $i ( @idx ){          # en @idx el 0 no debería estar
	$h{$px[$tt][$i]} += $px[$tt][$i] * $qx[$tt][$i];           # cantidad asociada al precio. Se acumula por si hay precio repetido, si no, no pasa nada
    }
    my $total = $h{$px[$tt][ $idx[-1] ]};
    if ( $DEBUG && !defined( $total ) ){ die "Error: division by undef"; }
    if ( $DEBUG && $total == 0 ){ die "Error: division by 0"; }
    
    my $r = 0;
    for my $i ( @idx ){          # precios ascendentes
	if ( $h{$px[$tt][$i]} / $total <= $prob ) {
	    $r = $px[$tt][$i];
	}else{
	    last;
	}
    }
    my $sum = 0;      # cantidad
    for my $i ( @idx ){                            # precios ascendentes también   
	$sum += $qx[$tt][$i];                           # cantidad acumulada
	last if ($px[$tt][$i] >= $r);
    }	    
    
    return ($r, $sum);   # el precio que deja por abajo aprox. el 50% y por arriba lo mismo, acompañado de la cantidad por debajo que puede probablemente comprar 
                         # y que determina $V{ $t } 
    
####################################################################    
    
#    my $string;
#    $string = "\nListing report of ascendent probability by ocurrence\n\n";
#    for my $k ( sort keys %histogram ) {
#	$string .= "$k -> $histogram{ $k }\n";
#    }
#    return $string;                  # retorna histograma
}