package Siru::IntegradorGLM;

# Un motor para los bloques GLM declarados en el .din. libdin genera sus
# ecuaciones; aqui se suministran coeficientes y memoria y se confirma cada
# paso. La representacion efectiva de BDF2 (20) conserva su adaptador.

use strict;
use warnings;
use Carp qw(croak);
use POSIX qw(isfinite);
use Scalar::Util qw(looks_like_number);
use Siru::Salida;
use Siru::CatalogoGLM;
use Siru::Paso;
use Siru::Historia;
use Siru::ControlPaso;

sub _numero {
    my ($v, $nombre) = @_;
    croak "$nombre debe ser un numero finito"
        unless defined($v) && looks_like_number($v) && isfinite(0 + $v);
    return 0 + $v;
}

sub _nombre {
    my ($v) = @_;
    croak 'nombre de variable invalido'
        unless defined($v) && $v =~ /\A[A-Za-z_][A-Za-z0-9_]*\z/;
    return $v;
}

sub integrar {
    my ($clase, %op) = @_;
    my $ids = $op{glm} // croak 'falta la lista GLM';
    croak 'GLM inicial: se admite un metodo por corrida'
        unless ref($ids) eq 'ARRAY' && @$ids == 1 && defined($ids->[0]);
    my $metodo = $op{descriptor} // Siru::CatalogoGLM->metodo($ids->[0]);
    Siru::CatalogoGLM->validar($metodo);
    croak 'descriptor GLM no corresponde al selector' unless $metodo->{id} eq $ids->[0];
    my $adaptacion = Siru::CatalogoGLM->adaptacion($metodo, $op{adaptacion}, $op{estados});
    my $estad = $op{estadisticas} // {};
    croak 'estadisticas debe ser un hash' unless ref($estad) eq 'HASH';
    %$estad = (motor=>'GLM', intentos=>0, aceptados=>0, rechazados_error=>0,
        fallos_evaluacion=>0, consultas_paso=>0, rearranques=>0, completa=>0);
    my $transaccion;
    my $sesion = $op{sesion} // croak 'falta sesion de Calcula';
    my $parametros = $op{parametros} // {};
    my $estados = $op{estados} // croak 'faltan los estados';
    croak 'parametros debe ser un hash' unless ref($parametros) eq 'HASH';
    croak 'estados debe ser un arreglo no vacio' unless ref($estados) eq 'ARRAY' && @$estados;
    my $t = _numero($op{desde}, 'desde');
    my $final = _numero($op{hasta}, 'hasta');
    my $paso = _numero($op{paso}, 'paso');
    croak 'hasta debe ser mayor o igual que desde' if $final < $t;
    croak 'paso debe ser positivo' unless $paso > 0;
    if ($adaptacion) {
        $paso = $adaptacion->{paso_min} if $paso < $adaptacion->{paso_min};
        $paso = $adaptacion->{paso_max} if $paso > $adaptacion->{paso_max};
    }
    $estad->{t_aceptado} = $t;
    my $max_pasos = $op{max_pasos} // 1_000_000;
    # Con SIRU_PASO_FACTOR = F < 1 (siru --paso-factor, siru/corpus/convergencia)
    # la corrida da 1/F veces los pasos: el tope crece igual. Si no, Pared.d
    # (86400 s a paso 0.1, 864000 pasos) se cortaba con la mitad del paso.
    {
        my $f = $ENV{SIRU_PASO_FACTOR};
        $max_pasos = int($max_pasos / $f + 0.5)
            if defined $f && $f =~ /\A\s*(?:\d+\.?\d*|\.\d+)(?:[eE][-+]?\d+)?\s*\z/ && $f > 0 && $f < 1;
    }
    croak 'max_pasos debe ser entero positivo' unless $max_pasos =~ /\A[1-9][0-9]*\z/;
    my $nombre_paso = _nombre($op{nombre_paso} // 'dt');
    my $nombre_tiempo = defined($op{nombre_tiempo}) ? _nombre($op{nombre_tiempo}) : undef;
    my $nombre_pasos = defined($op{nombre_pasos}) ? _nombre($op{nombre_pasos}) : undef;
    my (@columnas, @pedidos, %inicial, %nombres);
    for my $p (keys %$parametros) {
        _nombre($p); _numero($parametros->{$p}, "parametro $p");
        croak "nombre repetido: $p" if $nombres{$p}++;
    }
    for my $e (@$estados) {
        croak 'cada estado debe ser un hash' unless ref($e) eq 'HASH';
        my $y = _nombre($e->{actual});
        my $p = _nombre($e->{siguiente});
        croak "nombre repetido: $y" if $nombres{$y}++;
        croak "nombre repetido: $p" if $nombres{$p}++;
        $inicial{$y} = _numero($e->{inicial}, "estado inicial $y");
        push @columnas, $y;
        push @pedidos, $p;
    }
    for my $n ($nombre_paso, (defined($nombre_tiempo) ? $nombre_tiempo : ()),
               (defined($nombre_pasos) ? $nombre_pasos : ())) {
        croak "nombre repetido: $n" if $nombres{$n}++;
    }
    my $salidas = $op{salidas};
    croak 'salidas debe traer columnas y valores'
        if $salidas && !(ref($salidas->{columnas}) eq 'ARRAY' && ref($salidas->{valores}) eq 'CODE');
    my $al_empezar = $op{al_empezar_paso};
    croak 'al_empezar_paso debe ser una funcion'
        if defined($al_empezar) && ref($al_empezar) ne 'CODE';
    my $archivo = $op{salida} // croak 'falta salida';
    my $escritor = Siru::Salida->abrir(
        dato => $op{dato},
        archivo => $archivo, columnas => ($salidas ? $salidas->{columnas} : \@columnas),
        ($salidas && $salidas->{nombres} ? (nombres => $salidas->{nombres}) : ()),
        productor => __PACKAGE__, nota => 'a partir del sistema que resuelve Calcula.',
        (defined($op{bloque}) ? (bloque => $op{bloque}) : ()));

    # Capacidad maxima requerida por el metodo: uno o dos estados.
    # Solo los pasos aceptados ocupan una posicion; los intentos fallidos
    # no modifican el anillo ni el indice del metodo.
    my $dimension = $metodo->{historia}; # memoria externa del metodo
    my $capacidad = $metodo->{historia_fisica} // $dimension;
    my @anillo = ({ t => $t, estado => { %inicial }, h => undef });
    my $proximo = 1 % $capacidad;
    # Memoria externa canonica, independiente del anillo fisico. Para una
    # componente hderivada se conserva f sin escalar; cada intento usa su h.
    my @memoria = map { { map { $_ => 0 } @columnas } } 0 .. $dimension-1;
    $memoria[0] = { %inicial };
    my $numero_paso = 0;
    my $filas = 0;
    my $parar = 0;
    eval {
        my $actual = sub { $anillo[($proximo - 1 + $capacidad) % $capacidad]{estado} };
        my $escribir = sub {
            my $e = $actual->();
            if ($salidas) {
                my $v = $salidas->{valores}->($t, { %$e }, $numero_paso);
                $filas = $escritor->fila($t, map { _numero($v->{$_}, "salida $_") } @{$salidas->{columnas}});
            } else {
                $filas = $escritor->fila($t, @$e{@columnas});
            }
        };
        my $empezar = sub {
            return unless $al_empezar;
            my $cambio = $al_empezar->($t, { %{$actual->()} }, $numero_paso);
            return unless ref($cambio) eq 'HASH';
            if ($cambio->{parar}) { $parar = 1; return }
            croak 'GLM: cambios de estado/topologia aun no implementados'
                if $cambio->{estado};
            croak 'GLM: cambio de sesion requiere reiniciar la historia'
                if $numero_paso && $cambio->{sesion} && $cambio->{sesion} != $sesion;
            if ($numero_paso && $cambio->{parametros}) {
                my $nuevo = $cambio->{parametros};
                croak 'GLM: cambio de parametros requiere reiniciar la historia'
                    unless ref($nuevo) eq 'HASH' && keys(%$nuevo) == keys(%$parametros)
                    && !grep { !exists($parametros->{$_}) || _numero($nuevo->{$_}, "parametro $_") != $parametros->{$_} } keys %$nuevo;
            }
            $sesion = $cambio->{sesion} if $cambio->{sesion};
            $parametros = $cambio->{parametros} if $cambio->{parametros};
        };
        $empezar->();
        $escribir->();
        # quiebres: los saltos de las fuentes (Siru::Din->quiebres), como en
        # Siru::Integrador: un paso termina en q - delta, uno minimo cruza
        # hasta q + delta y el siguiente vuelve a la grilla. Un metodo
        # multipaso no puede seguir con la historia de antes del salto ni con
        # una razon de pasos de 1e6 (los coeficientes de paso variable se
        # vuelven inestables): el paso que cruza y el siguiente se dan como
        # el primero de la corrida, con los coeficientes de arranque (pedido
        # del autor, 04/10/2026).
        my @quiebres = grep { $_ > $t && $_ <= $final } @{ $op{quiebres} // [] };
        my $delta = 1e-6 * $paso;
        my ($t0, $paso0) = ($t, $paso);
        my ($volver_a_la_grilla, $arranques) = (0, 0);
        # Cada avance recibe su propia historia y memoria. Los comparadores
        # no modifican el confirmado ni la memoria del candidato principal.
        my $avanzar = sub {
            my ($base, $h, $arranque) = @_;
            my ($t, $proximo, $numero_paso) = @$base{qw(t proximo numero_paso)};
            my @anillo = @{$base->{anillo}};
            my @memoria = @{$base->{memoria}};
            croak "paso sin avance en t=$t" unless $h > 0 && $t+$h > $t;
        my %efectivo = %{$anillo[($proximo - 1 + $capacidad) % $capacidad]{estado}};
        my ($h_efectivo, $t_efectivo) = ($h, $t);
        my $h_previo = $numero_paso ? $anillo[($proximo - 1 + $capacidad) % $capacidad]{h} : $h;
        my $coef = Siru::CatalogoGLM->coeficientes($metodo, $arranque, $arranque ? 1 : $h/$h_previo);
        my @entrada = map {
            my $j=$_; +{ map { $_ => _numero($memoria[$j]{$_} * ($metodo->{memoria}[$j] eq 'hderivada' ? $h : 1), 'memoria GLM') } @columnas }
        } 0 .. $dimension-1;
        if ($metodo->{representacion} eq 'efectivos') {
            croak 'descriptor efectivo incompatible' unless $coef->{c}[0] == 1 && $coef->{a}[0][0] == $coef->{b}[0][0]
                && $coef->{u}[0][0] == $coef->{v}[0][0] && $coef->{u}[0][1] == $coef->{v}[0][1]
                && $coef->{b}[1][0] == 0 && $coef->{v}[1][0] == 1 && $coef->{v}[1][1] == 0;
            for my $y (@columnas) {
                $efectivo{$y} = _numero(
                    $coef->{u}[0][0]*$entrada[0]{$y} + $coef->{u}[0][1]*$entrada[1]{$y},
                    "estado efectivo $y");
            }
            $h_efectivo = _numero($h * $coef->{a}[0][0], 'paso efectivo BDF2');
            $t_efectivo = _numero($t + $h - $h_efectivo, 'tiempo efectivo BDF2');
        }
        croak 'paso efectivo BDF2 sin avance' unless $h_efectivo > 0;
        my %datos = (%$parametros, %efectivo, $nombre_paso => $h_efectivo);
        $datos{$nombre_tiempo} = $t_efectivo if defined $nombre_tiempo;
        $datos{$nombre_pasos} = $numero_paso if defined $nombre_pasos;
        my @consulta = @pedidos;
        if ($metodo->{representacion} eq 'bloques') {
            for my $k (qw(a u b v c)) {
                for my $i (0 .. $#{$coef->{$k}}) {
                    my $fila = $k eq 'c' ? [$coef->{$k}[$i]] : $coef->{$k}[$i];
                    $datos{"glm_${k}_${i}_$_"} = $fila->[$_] for 0 .. $#$fila;
                }
            }
            for my $j (1 .. $dimension-1) {
                for my $y (@columnas) {
                    $datos{"glm_h${j}_$y"} = $entrada[$j]{$y};
                    push @consulta, "glm_next${j}_$y";
                }
            }
        }
        $estad->{consultas_paso}++;
        my $r = eval { $sesion->evaluar(\%datos, \@consulta) };
        if ($@) { $estad->{fallos_evaluacion}++; croak "paso $numero_paso, t=$t: $@" }
        my %nuevo = map {
            $columnas[$_] => _numero($r->{$pedidos[$_]}, "resultado $pedidos[$_]")
        } 0 .. $#columnas;
        my @nueva_memoria = ({ %nuevo });
        for my $j (1 .. $dimension-1) {
            $nueva_memoria[$j] = { map { $_ => $metodo->{representacion} eq 'efectivos'
                ? $entrada[0]{$_}
                : _numero(_numero($r->{"glm_next${j}_$_"}, 'resultado de memoria GLM') / ($metodo->{memoria}[$j] eq 'hderivada' ? $h : 1), 'memoria GLM nueva') } @columnas };
        }

            my $historia = Siru::Historia->agregar(
                {capacidad=>$capacidad, anillo=>\@anillo, proximo=>$proximo},
                {t=>$t+$h, h=>$h, estado=>\%nuevo});
            return {%$base, %$historia, t=>$t+$h,
                memoria=>\@nueva_memoria, numero_paso=>$numero_paso+1};
        };
        $transaccion = Siru::Paso->preparar(
            %{ $op{proveedor_paso} // {proveedor=>'independiente'} },
            estado => { t=>$t, capacidad=>$capacidad, anillo=>\@anillo, proximo=>$proximo,
                memoria=>\@memoria, numero_paso=>$numero_paso, quiebres=>\@quiebres,
                volver_a_la_grilla=>$volver_a_la_grilla, arranques=>$arranques, paso=>$paso });
        while ($t < $final && !$parar) {
            $empezar->() if $numero_paso > 0;
            last if $parar;
            croak "paso $numero_paso, t=$t: se alcanzo max_pasos=$max_pasos, el tope de pasos de la corrida"
                if $numero_paso >= $max_pasos;
            my $intentos = 0;
            my $h_propuesto = $paso;
            while (1) {
                $estad->{intentos}++;
                my $candidato = $transaccion->intentar_paso(sub {
                    my ($base) = @_;
                    my $t = $base->{t};
                    my $restante = $final-$t;
                    my $h = $h_propuesto < $restante ? $h_propuesto : $restante;
                    $h = $restante if $restante-$h <= 1e-9*$h_propuesto;
                    my @quiebres = @{$base->{quiebres}};
                    my $arranques = $base->{arranques};
                    if ($base->{volver_a_la_grilla} && !$adaptacion) {
                        my $g = $t0+$paso0*(int(($t-$t0)/$paso0+1e-9)+1);
                        $h = $g-$t if $g-$t > 0 && $g-$t < $h;
                    }
                    shift @quiebres while @quiebres && $quiebres[0]+$delta <= $t;
                    my $cruza;
                    if (@quiebres && $quiebres[0]-$t <= $h+1e-9*$h_propuesto) {
                        my $q = $quiebres[0];
                        if ($q-$t > 2*$delta) { $h = $q-$delta-$t }
                        elsif ($q+$delta < $final) { $h=$q+$delta-$t; $cruza=1; $arranques=2 }
                        else { $h=$restante }
                    }
                    my $previo = Siru::Historia->ultimo($base);
                    my $arranque = !$numero_paso || $arranques > 0;
                    # Un cambio extremo de paso no transporta memoria vieja:
                    # se recomienza con Euler. El crecimiento normal se limita
                    # a dos; la reduccion puede ser mayor por rechazo/final.
                    $arranque = 1 if $adaptacion && $numero_paso && (
                        $h/$previo->{h} < 0.2 || $h/$previo->{h} > 2*(1+1e-12));
                    my $nuevo = $avanzar->($base, $h, $arranque);
                    my $error = 0;
                    if ($adaptacion) {
                        my $factor = 1;
                        my $comparado = $transaccion->rama(sub {
                        if ($arranque || $metodo->{orden} == 1) {
                            # Solo el metodo de arranque de UN paso se dobla,
                            # las dos mitades usan Euler, no BDF2/AB2.
                            my $medio = $avanzar->($base, $h/2, 1);
                            $medio->{numero_paso} = $base->{numero_paso}; # TICK cuenta pasos fisicos, no comparadores
                            $factor = 2; # estima el error del paso completo que se acepta
                            return $avanzar->($medio, $h/2, 1);
                        } else {
                            return $avanzar->($base, $h, 1);
                        }
                        });
                        my %e = map { $_ => $factor*($nuevo->{memoria}[0]{$_}-$comparado->{memoria}[0]{$_}) } @columnas;
                        $error = Siru::ControlPaso->error($base->{memoria}[0], $nuevo->{memoria}[0], \%e, $adaptacion);
                    }
                    my $nuevo_t = $nuevo->{t};
                    my $escala = abs($final)>abs($nuevo_t) ? abs($final) : abs($nuevo_t);
                    $nuevo->{t} = $final if $h == $restante || abs($final-$nuevo_t) <= 8*2.220446049250313e-16*$escala;
                    $nuevo->{anillo}[($nuevo->{proximo}-1+$capacidad)%$capacidad]{t} = $nuevo->{t};
                    shift @quiebres if $cruza;
                    $nuevo->{quiebres} = \@quiebres;
                    $nuevo->{volver_a_la_grilla} = $cruza ? 1 : 0;
                    $nuevo->{arranques} = $arranques > 0 ? $arranques-1 : 0;
                    $nuevo->{paso} = $adaptacion ? Siru::ControlPaso->siguiente($h, $error, $adaptacion, 2) : $paso;
                    return {estado=>$nuevo, error=>$error, h=>$h, arranque=>$arranque};
                });
                if ($candidato->{error} > 1) {
                    $transaccion->descartar_intento;
                    $estad->{rechazados_error}++;
                    my $h = $candidato->{h};
                    croak "paso $numero_paso, t=$t: error GLM no tolerado con paso minimo"
                        if $h <= $adaptacion->{paso_min};
                    croak "paso $numero_paso, t=$t: demasiados intentos GLM"
                        if ++$intentos >= $adaptacion->{intentos_max};
                    $h_propuesto = $candidato->{estado}{paso};
                    next;
                }
                my $confirmado = $transaccion->aceptar_paso;
                ($t, $proximo, $numero_paso, $paso) = @$confirmado{qw(t proximo numero_paso paso)};
                @anillo = @{$confirmado->{anillo}};
                @memoria = @{$confirmado->{memoria}};
                $estad->{aceptados}++;
                $estad->{rearranques}++ if $candidato->{arranque} && $numero_paso > 1;
                $estad->{t_aceptado} = $t;
                my $h = $candidato->{h};
                $estad->{paso_min_aceptado}=$h if !defined($estad->{paso_min_aceptado}) || $h<$estad->{paso_min_aceptado};
                $estad->{paso_max_aceptado}=$h if !defined($estad->{paso_max_aceptado}) || $h>$estad->{paso_max_aceptado};
                last;
            }
            $escribir->();
        }
        $op{al_terminar}->($t, { %{$actual->()} }) if $op{al_terminar};
        $escritor->publicar();
        $estad->{transacciones} = $transaccion->estadisticas;
        $estad->{completa} = 1;
        1;
    } or do {
        my $error = $@ || 'error desconocido';
        $estad->{transacciones} = $transaccion->estadisticas if $transaccion;
        $escritor->descartar();
        die $error;
    };
    return $filas;
}

1;