unit uauxiliares;

{$MODE Delphi}

interface

uses
  Dialogs, xMatDefs, SysUtils, FDDP;

{***********************************}
{ Constantes y Funciones auxiliares }
{-----------------------------------}
const
  { valor mínimo admisible }
  potEpsilon = 0.1;
  cpEpsilon = 0.01;

type
  TEstacion = (verano, otonio, invierno, primavera);


function MesOfSem(isem: integer): integer;
function EstacionOfSem(isem: integer): TEstacion;
function EstacionOfMes(imes: integer): TEstacion;



{ si x < cpEpsilon; result:= cpEpsilon sino result:= x }
procedure cpSupEpsilon(var x: NReal);

{ si x < potEpsilon; result:= potEpsilon sino result:= x }
procedure potSupEpsilon(var x: NReal);

{ retorna TRUE si paso esta en [paso1, paso2] }
function PasoEnRango(paso1, paso, paso2: integer): boolean;

{ retorna el paso correspondiente al par (ano,sem).
result:= ano*52+sem }
function AnoSemToPaso(ano, sem: integer): integer;

function RndProb(prob1: NReal): boolean;




procedure readln(var f: Text; var r: string);
function NextFloat(var s: string): NReal;
function NextInt(var s: string): integer;
function NextPal(var s: string): string;

function NextStrParam(var s: string; Nombre: string): string; overload;
function NextFloatParam(var s: string; Nombre: string): NReal; overload;
function NextIntParam(var s: string; Nombre: string): integer; overload;

// estas funciones leen una línea y esperan Nombre [separador] valor
function ReadlnStrParam(var f: textfile; Nombre: string): string; overload;
function ReadlnFloatParam(var f: textfile; Nombre: string): NReal; overload;
function ReadlnIntParam(var f: textfile; Nombre: string): integer; overload;


function TextToDArrOfNReal(s: string; sepDec: char): TDAOfNReal;

function InsertionSort_Creciente(const A: TDAOfNReal): TDAofNReal; overload;
function InsertionSort_Decreciente(const A: TDAOfNReal): TDAofNReal; overload;

procedure QuickSort_Creciente(var A: array of integer); overload;
procedure QuickSort_Creciente(var A: TDAOfNReal); overload;

procedure QuickSort_Decreciente(var A: array of integer); overload;
procedure QuickSort_Decreciente(var A: TDAOfNReal); overload;


// Retorna A + (B-A)*alfa
function ponder(A, B, alfa: NReal): NReal;

// Interpola en un vector entre dos valores extremos.
function interpolar(valores: TDAOfNReal; xmin, xmax: NReal; x: Nreal): NReal;

function pertenece(valor: integer; const arreglo: TDAofNInt;
  var posicion: integer): boolean; overload;
function pertenece(valor: NReal; const arreglo: TDAofNReal;
  var posicion: integer): boolean; overload;

{$IFDEF FPC}
procedure ShowMessage(s: string);
{$ENDIF}

implementation


const
  Separadores = [' ', ',', ';', #9, #10, #13];


{$IFDEF FPC}
procedure ShowMessage(s: string);
begin
  writeln;
  writeln('**********ATENCION *********');
  writeln(s);
  writeln('----------------------------');
  writeln('Presione ENTER para continuar ... ');
  system.readln;
end;

{$ENDIF}

function ponder(A, B, alfa: NReal): NReal;
begin
  Result := A + (B - A) * alfa;
end;

function InsertionSort_Creciente(const A: TDAOfNReal): TDAofNReal;
var
  i, j, tope, posNuevoElem: integer;
  valor: NReal;
  res: TDAofNReal;
begin
  SetLength(res, length(A));
  tope := 0;
  for i := 0 to high(A) do
  begin
    posNuevoElem := tope;
    valor := A[i];
    for j := 0 to tope - 1 do
    begin
      if res[j] > valor then
      begin
        posNuevoElem := j;
        break;
      end;
    end;

    for j := tope downto posNuevoElem + 1 do
      res[j] := res[j - 1];
    res[posNuevoElem] := valor;
    Inc(tope);
  end;
  Result := res;
end;

function InsertionSort_Decreciente(const A: TDAOfNReal): TDAofNReal;
var
  i, j, tope, posNuevoElem: integer;
  valor: NReal;
  res: TDAofNReal;
begin
  SetLength(res, length(A));
  tope := 0;
  for i := 0 to high(A) do
  begin
    posNuevoElem := tope;
    valor := A[i];
    for j := 0 to tope - 1 do
    begin
      if res[j] < valor then
      begin
        posNuevoElem := j;
        break;
      end;
    end;

    for j := tope downto posNuevoElem + 1 do
      res[j] := res[j - 1];
    res[posNuevoElem] := valor;
    Inc(tope);
  end;
  Result := res;
end;

procedure QuickSort_creciente(var A: array of integer);

  procedure Quick_Sort(var A: array of integer; iLo, iHi: integer);
  var
    Lo, Hi, Mid, T: integer;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo] < Mid do
        Inc(Lo);
      while A[Hi] > Mid do
        Dec(Hi);
      if Lo <= Hi then
      begin
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then
      Quick_Sort(A, iLo, Hi);
    if Lo < iHi then
      Quick_Sort(A, Lo, iHi);
  end;

begin
  Quick_Sort(A, Low(A), High(A));
end;


procedure QuickSort_Creciente(var A: TDAOfNReal);

  procedure Quick_Sort(var A: TDAOfNReal; iLo, iHi: integer);
  var
    Lo, Hi: integer;
    T, Mid: NReal;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo] < Mid do
        Inc(Lo);
      while A[Hi] > Mid do
        Dec(Hi);
      if Lo <= Hi then
      begin
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then
      Quick_Sort(A, iLo, Hi);
    if Lo < iHi then
      Quick_Sort(A, Lo, iHi);
  end;

begin
  Quick_Sort(A, Low(A), High(A));
end;

//**************** DECRECIENTES
procedure QuickSort_Decreciente(var A: array of integer);

  procedure Quick_Sort(var A: array of integer; iLo, iHi: integer);
  var
    Lo, Hi, Mid, T: integer;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo] > Mid do
        Inc(Lo);
      while A[Hi] < Mid do
        Dec(Hi);
      if Lo <= Hi then
      begin
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then
      Quick_Sort(A, iLo, Hi);
    if Lo < iHi then
      Quick_Sort(A, Lo, iHi);
  end;

begin
  Quick_Sort(A, Low(A), High(A));
end;

procedure QuickSort_Decreciente(var A: TDAOfNReal);

  procedure Quick_Sort(var A: TDAOfNReal; iLo, iHi: integer);
  var
    Lo, Hi: integer;
    T, Mid: NReal;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo] > Mid do
        Inc(Lo);
      while A[Hi] < Mid do
        Dec(Hi);
      if Lo <= Hi then
      begin
        T := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := T;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then
      Quick_Sort(A, iLo, Hi);
    if Lo < iHi then
      Quick_Sort(A, Lo, iHi);
  end;

begin
  Quick_Sort(A, Low(A), High(A));
end;

function TextToDArrOfNReal(s: string; sepDec: char): TDAOfNReal;
var
  i: integer;
  tmpArr, tmpArr2: TDAOfNReal;
  cnt: integer;
  pal: string;
  r: NReal;
begin
  if sepDec <> '.' then
  begin
    i := pos('.', s);
    while i > 0 do
    begin
      Delete(s, i, 1);
      i := pos('.', s);
    end;

    for i := 1 to length(s) do
      if s[i] = sepDec then
        s[i] := '.';
  end;


  setlength(tmpArr, 100);

  cnt := 0;

  pal := nextpal(s);
  while pal <> '' do
  begin
    try
      r := StrToFloat(pal);
      if cnt >= length(tmpArr) then
      begin
        setlength(tmpArr2, length(tmpArr) + 100);
        for i := 0 to high(tmpArr) do
          tmpArr2[i] := tmpArr[i];
        setlength(tmpArr, 0);
        tmpArr := tmpArr2;
      end;
      tmpArr[cnt] := r;
      Inc(cnt);
    except
      ShowMessage('OJO, no logré interpretar : (' + pal + ') como un número.');
    end;
    pal := nextpal(s);
  end;
  Result := copy(tmpArr, 0, cnt);
  setlength(tmpArr, 0);
end;

{ Lee una l¡nea sin importar si es UNIX o DOS }
procedure readln(var f: Text; var r: string);
var
  c: char;
begin
  r := '';
  c := 'm';
  while not EOF(f) and (c <> #10) do
  begin
    Read(f, c);
    r := r + c;
  end;
  if c = #10 then
    Delete(r, length(r), 1);
  if r[length(r)] = #13 then
    Delete(r, length(r), 1);
end;

{ saca la primer palabra del string s}
function NextPal(var s: string): string;
var
  k1, k2: integer;
  ts: string;
begin
  k1 := 1;
  while (k1 <= Length(s)) and (s[k1] in Separadores) do
    Inc(k1);
  k2 := k1;
  while (k2 <= Length(s)) and not (s[k2] in Separadores) do
    Inc(k2);
  ts := copy(s, k1, k2 - k1);
  Delete(s, 1, k2);
  Result := ts;
end;



function NextInt(var s: string): integer;
begin
  Result := StrToInt(NextPal(s));
end;

function NextFloat(var s: string): NReal;
begin
  Result := StrToFloat(NextPal(s));
end;


function NextStrParam(var s: string; Nombre: string): string;
var
  ts: string;
begin
  ts := nextPal(s);
  if pos(Nombre, ts) > 0 then
    Result := nextPal(s)
  else
    raise Exception.Create('NextParam( ' + Nombre + ' ) Leí: ' + ts + ' y s:' + s);
end;

function NextFloatParam(var s: string; Nombre: string): NReal;
var
  sval: string;
begin
  sval := NextStrParam(s, nombre);
  Result := StrToFloat(sval);
end;

function NextIntParam(var s: string; Nombre: string): integer; overload;
var
  sval: string;
begin
  sval := NextStrParam(s, nombre);
  Result := StrToInt(sval);
end;

function ReadlnStrParam(var f: textfile; Nombre: string): string;
var
  r: string;
begin
  readln(f, r);
  Result := nextStrParam(r, Nombre);
end;

function ReadlnFloatParam(var f: textfile; Nombre: string): NReal;
var
  r: string;
begin
  readln(f, r);
  Result := nextFloatParam(r, Nombre);
end;

function ReadlnIntParam(var f: textfile; Nombre: string): integer;
var
  r: string;
begin
  readln(f, r);
  Result := nextIntParam(r, Nombre);
end;


function MesOfSem(isem: integer): integer;
var
  m: integer;
begin
  m := trunc(isem / 52.0 * 12.0) + 1;
  if m > 12 then
    MesOfSem := 12
  else
    MesOfSem := m;
end;


function EstacionOfMes(imes: integer): TEstacion;
var
  r: TEstacion;
begin
  case imes of
    12, 1, 2: r := verano;
    3, 4, 5: r := otonio;
    6, 7, 8: r := invierno;
    9, 10, 11: r := primavera;
    else
      raise Exception.Create('auxiliares.pas, EstacionOfMes (imes fuera de rango )');
  end;
  EstacionOfMes := r;
end;

function EstacionOfSem(isem: integer): TEstacion;
begin
  EstacionOfSem := EstacionOfMes(MesOfSem(isem));
end;

function RndProb(prob1: NReal): boolean;
begin
  RndProb := system.random < prob1;
end;

procedure cpSupEpsilon(var x: NReal);
begin
  if x < cpEpsilon then
    x := cpEpsilon;
end;

procedure potSupEpsilon(var x: NReal);
begin
  if x < potEpsilon then
    x := potEpsilon;
end;

{ retorna TRUE si paso está en [paso1, paso2] }
function PasoEnRango(paso1, paso, paso2: integer): boolean;
begin
  PasoEnRango := (paso1 <= paso) and (paso <= paso2);
end;

{ retorna el paso correspondiente al par ano,sem. }
function AnoSemToPaso(ano, sem: integer): integer;
begin
  AnoSemToPaso := ano * 52 + sem;
end;

function interpolar(valores: TDAOfNReal; xmin, xmax: NReal; x: Nreal): NReal;
var
  rix: NReal;
  ix: integer;
  dx: NReal;
begin
  dx := xmax - xmin;
  if dx <= AsumaCero then
    raise Exception.Create('ERROR, interpolar rango absurdo, xmin: ' +
      FloatToStr(xmin) + ' xmax: ' + FloatToStr(xmax));
  rix := (x - xmin) / dx;
  ix := trunc(rix);
  if ix >= length(valores) then
    Result := valores[high(valores)]
  else
  begin
    rix := frac(rix);
    Result := valores[ix] * (1 - rix) + valores[ix + 1] * rix;
  end;
end;

function pertenece(valor: integer; const arreglo: TDAofNInt;
  var posicion: integer): boolean;
var
  i: integer;
begin
  posicion := -1;
  for i := 0 to high(arreglo) do
    if arreglo[i] = valor then
    begin
      posicion := i;
      break;
    end;
  Result := posicion <> -1;
end;

function pertenece(valor: NReal; const arreglo: TDAofNReal;
  var posicion: integer): boolean;
var
  i: integer;
begin
  posicion := -1;
  for i := 0 to high(arreglo) do
    if arreglo[i] = valor then
    begin
      posicion := i;
      break;
    end;
  Result := posicion <> -1;
end;

end.
