unit UNodo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Math;

type
   TNodo = class;
   TLinea = class;

   TOrdenacion = procedure(Sender: TObject; ANodo:TNodo) of Object;

   TMalla = Class(TObject)
   private
    FPivote: TNodo;
    FLineas: TList;
    FNodos: TList;
    FZona: TForm;
    FSalida: TNodo;
    FDestino: TNodo;
    procedure SetSalida(const Value: TNodo);
    function GetLineas(Indice: Integer): TLinea;
    function GetNodos(Indice: Integer): TNodo;
    procedure InternalOrdenaNodos(Sender: TObject; ANodo: TNodo);
    procedure VaciarLineas;
    procedure VaciarNodos;
    procedure DibujaRuta;
    function CalculaMetricaRuta: Double;
   protected
    procedure DoOrdenaNodos(ANodo: TNodo; AOrdenacion: TOrdenacion); virtual;
    procedure DoDibujarMalla; virtual;
    procedure OrdenarNodos(ANodo: TNodo; ADestino: TNodo);overload; virtual;
   public
    FCambios: TStrings;
    Constructor Create(AForm: TForm); virtual;
    Destructor Destroy; override;
    procedure InicializarMalla;
    procedure OrdenarNodos; overload;
    Function CountLineas: Integer;
    Function CountNodos: Integer;
    procedure ActualizarMalla;
    function AddNodo: Integer;
    function AddLinea: Integer;
    function GenerarRuta: Double;
    property Salida : TNodo read FSalida;
    property Destino: TNodo read FDestino;
    property Lineas[Indice: Integer]: TLinea read GetLineas;
    property Nodos[Indice: Integer]: TNodo read GetNodos;

   End;

   TLinea = Class(TObject)
   private
    FMalla: TMalla;
    FAlfa: TNodo;
    FOmega: TNodo;
    FDistancia: Double;
    FIndice: Integer;
    procedure SetAlfa(const Value: TNodo);
    procedure SetOmega(const Value: TNodo);
    procedure SetIndice(const Value: Integer);
   protected
   public
    function GetDistancia: Double;
    Constructor Create(AMalla: TMalla); virtual;
    Destructor Destroy; override;
    procedure Enlaza(AAlfa,AOmega: TNodo); overload;
    procedure DibujarLinea;
    property Alfa: TNodo read FAlfa write SetAlfa;
    property Omega: TNodo read FOmega write SetOmega;
    property Indice: Integer  read FIndice write SetIndice;
   End;

  TNodo = Class(TObject)
  private
    FMalla: TMalla;
    FShape: TShape;
    FPoint: TPoint;
    FPeso: Integer;
    FTag: Integer;
    function GetX: Integer;
    procedure SetX(const Value: Integer);
    function GetY: Integer;
    procedure SetY(const Value: Integer);
    procedure SetPeso(const Value: Integer);
    procedure SetTag(const Value: Integer);
   protected
   public
    function GetDistancia: Double;
    function GetIndice: Integer;
    function AddLinea(ANodoTarget: TNodo): Integer;
    Constructor Create(AMalla: TMalla); virtual;
    Destructor Destroy; override;
    procedure DibujarNodo;
    property X: Integer read GetX write SetX;
    property Y: Integer read GetY write SetY;
    property Peso: Integer read FPeso write SetPeso;
    property Distancia: Double read GetDistancia;
    property Tag: Integer read FTag write SetTag;
  End;

implementation

function CalcularDistanciaNodos(AAlfa, AOmega: TNodo): Double;

        //Necesitamos dos puntos (x1,y1) (x2,y2)
        // [x1,y1] [x2,y2]
        // Formula Raiz de ( ((x2-x1) al cuadrado) + ((y2-y1) al cuadrado) )

      function CalcularDistancia(X1, Y1, X2, Y2: Integer): Double;
      begin
         Result:= SQrt(Power((X2-X1), 2) + Power((Y2-Y1), 2));
      end;
begin
  if (AAlfa = Nil) or (AOmega = Nil) then Result:= 0
  else Result:= CalcularDistancia(AAlfa.X, AAlfa.Y, AOmega.X, AOmega.Y);
end;

{ TMalla }

procedure TMalla.ActualizarMalla;
begin
  DoDibujarMalla;
end;

function TMalla.AddLinea: Integer;
begin
   Result:= FLineas.Add(TLinea.Create(Self));
   TLinea(FLineas[Result]).Indice:= Result;
end;

function TMalla.AddNodo: Integer;
begin
   Result:= FNodos.Add(TNodo.Create(Self));
end;

constructor TMalla.Create(AForm: TForm);
begin
  if AForm = Nil then
    Raise Exception.Create('Atención: La referencia no es valida');
  FZona:= AForm;

  FSalida:= TNodo.Create(Self);
  FDestino:= TNodo.Create(Self);

  FNodos:= TList.Create;
  FLineas:= TList.Create;
end;

destructor TMalla.Destroy;
begin
  //limpiamos la lista de nodos
  VaciarNodos;
  FreeAndNil(FNodos);
  //limpiamos la lista de lineas
  VaciarLineas;
  FreeAndNil(FLineas);
  //nos desvinculamos del objeto padre
  //sobre el que nos mostramos
  FZona:= Nil;

  FreeAndNil(FSalida);
  FreeAndNil(FDestino);

  inherited Destroy;
end;

procedure TMalla.DibujaRuta;
var
  i: Integer;
  FNodo: TNodo;
begin
  VaciarLineas;

  fNodo:= Nil;
  for i := 0 to CountNodos - 1 do begin
    if FNodo <> Nil then begin
       FNodo.AddLinea(Nodos[i]);
    end
    else FSalida.AddLinea(Nodos[i]);
    FNodo:= Nodos[i];
  end;
  FNodo.AddLinea(FDestino);
end;

procedure TMalla.DoDibujarMalla;
var
  i: Integer;
begin
  if Assigned(FZona) then begin
     for i := 0 to CountLineas - 1 do Lineas[i].DibujarLinea;
     for i := 0 to FNodos.Count - 1 do Nodos[i].DibujarNodo;
     Salida.DibujarNodo;
     Destino.DibujarNodo;
  end;
end;

procedure TMalla.DoOrdenaNodos(ANodo: TNodo; AOrdenacion: TOrdenacion);
begin
  AOrdenacion(Self, ANodo);
end;

function TMalla.GenerarRuta: Double;
begin
  if (CountNodos = 0) or (FSalida = Nil) or (FDestino = Nil) then
    Raise Exception.Create('Error: No existe suficente información en la ruta a generar');
  OrdenarNodos;
  DibujaRuta;
  Result:= CalculaMetricaRuta;
end;

function TMalla.GetLineas(Indice: Integer): TLinea;
begin
   if (Indice < 0) or (Indice > FLineas.Count-1) then
      Raise Exception.Create('Error en el valor del indice de la matriz');
  Result:= FLineas[Indice];
end;

function TMalla.GetNodos(Indice: Integer): TNodo;
begin
   if (Indice < 0) or (Indice > FNodos.Count-1) then
      Raise Exception.Create('Error en el valor del indice de la matriz');
   Result:= FNodos[Indice];
end;

procedure TMalla.InicializarMalla;
begin
   VaciarLineas;
   VaciarNodos;
   FPivote:= Nil;
end;

procedure TMalla.InternalOrdenaNodos(Sender: TObject; ANodo: TNodo);

   procedure OrdenaQuickSort(L,R: Integer);
   var
     i,j: Integer;
     piv, aux: TNodo;
   begin
     i:= L;
     j:= R;
     piv:= Nodos[(L+R) div 2]; //pivote
     Repeat
       while (Nodos[i].GetDistancia < piv.GetDistancia) do Inc(i);
       while (piv.GetDistancia < Nodos[j].GetDistancia) do Dec(j);
       if i<= j then begin
          Aux:= Nodos[i];
          FNodos.Exchange(i,j);
          FNodos[j]:= Aux;
          Inc(i);
          Dec(j);
       end;
       if L<j then OrdenaQuickSort(L,j);
       if i<R then OrdenaQuickSort(i,R);
     Until i>j;
   end;  

begin
   OrdenaQuickSort(ANodo.GetIndice, CountNodos-1);
end;

procedure TMalla.OrdenarNodos;
var
  i: Integer;
begin
  FPivote:= FSalida;
  for i := 0 to CountNodos - 1 do
     OrdenarNodos(Nodos[i], FDestino);
end;

procedure TMalla.OrdenarNodos(ANodo: TNodo; ADestino: TNodo);
var
  i: Integer;
begin
  //guardamos el indice del vector para que calcule la distancia
  //correctamente ya que el pivote debe avancar
  i:= ANodo.GetIndice;
  DoOrdenaNodos(ANodo, InternalOrdenaNodos);
  //en este punto el nodo puede haber cambiado
  FPivote:= Nodos[i];
end;

procedure TMalla.SetSalida(const Value: TNodo);
begin
  if FSalida = nil then
     FSalida := Value;
end;

procedure TMalla.VaciarLineas;
var
  i: Integer;
begin
  for i := 0 to CountLineas - 1 do begin
    TLinea(FLineas[i]).Free;
    FLineas[i]:= Nil;
  end;
  FLineas.Clear;
end;

procedure TMalla.VaciarNodos;
var
  i: Integer;
begin
  for i := 0 to CountNodos - 1 do begin
    TNodo(FNodos[i]).Free;
    FNodos[i]:= Nil;
  end;
  FNodos.Clear;
end;

function TMalla.CalculaMetricaRuta: Double;
var
  i: Integer;
begin
  Result:= 0;
  for i := 0 to CountLineas - 1 do begin
    Result:= Result + TLinea(FLineas[i]).GetDistancia;
  end;
end;

function TMalla.CountLineas: Integer;
begin
   Result:= FLineas.Count;
end;

function TMalla.CountNodos: Integer;
begin
  Result:= FNodos.Count;
end;

{TNodo}

procedure TNodo.DibujarNodo;
begin
  if not Assigned(Self) then Exit;

  if (Self = FMalla.Salida) or
     (Self = FMalla.FDestino) then begin
    if (Self = FMalla.Salida) then begin
      FShape.Brush.Color:= clRed;
      FShape.Pen.Color:= clRed;
    end
    else begin
      FShape.Brush.Color:= clBlue;
      FShape.Pen.Color:= clBlue;
    end;
  end
  else begin
    FShape.Brush.Color:= clLime;
    FShape.Pen.Color:= clGreen;
    FMalla.FZona.Canvas.Font.Size:= 7;
    FMalla.FZona.Canvas.TextOut(X-12,Y-12,'('+InTToStr(GetIndice)+')')
  end;
end;

function TNodo.AddLinea(ANodoTarget: TNodo): Integer;
var
  fLin: TLinea;
begin
   if ANodoTarget = Nil then
     Raise Exception.Create('Atención: La referencia al nodo no es valida');
   Result:= FMalla.AddLinea;
   if Result >= 0 then
      FMalla.Lineas[Result].Enlaza(Self, ANodoTarget);
end;

constructor TNodo.Create(AMalla: TMalla);
begin
  if AMalla = Nil then
     Raise Exception.Create('Atención: La referencia no es valida');
  FMalla:= AMalla;

  FShape:= TShape.Create(Nil);
  FShape.Parent:= AMalla.FZona;
  FShape.Shape:= stCircle;
  FShape.Height:= 8;
  FShape.Width:= 8;
  if Self = FMalla.Salida then begin
    FShape.Brush.Color:= clRed;
    FShape.Pen.Color:= clRed;
  end
  else begin
    FShape.Brush.Color:= clLime;
    FShape.Pen.Color:= clGreen;
  end;

  FPeso:= 0;

  x:= 0;
  y:= 0;

end;

destructor TNodo.Destroy;
begin
  FMalla:= Nil;
  FreeAndNil(FShape);
  inherited;
end;

function TNodo.GetDistancia: Double;
begin
  Result:= CalcularDistanciaNodos(FMalla.FPivote, Self);
end;

function TNodo.GetIndice: Integer;
var
  i: Integer;
begin
   i:= 0;
   while i < FMalla.CountNodos do begin
     if FMalla.Nodos[i] = Self then begin
       Result:= i;
       Exit;
     end;
     Inc(i);
   end;
   Result:= -1;
end;

function TNodo.GetX: Integer;
begin
  Result:= FPoint.X;
end;

procedure TNodo.SetTag(const Value: Integer);
begin
  FTag := Value;
end;

procedure TNodo.SetPeso(const Value: Integer);
begin
  FPeso := Value;
end;

procedure TNodo.SetX(const Value: Integer);
begin
  FPoint.X := Value;
  FShape.Left:= FPoint.X;
end;

function TNodo.GetY: Integer;
begin
  Result:= FPoint.Y;
end;

procedure TNodo.SetY(const Value: Integer);
begin
  FPoint.Y := Value;
  FShape.Top:= FPoint.Y;
end;

{ TLinea }

constructor TLinea.Create(AMalla: TMalla);
begin
  FMalla:= AMalla;
  FAlfa:= Nil;
  FOmega:= Nil;
end;

destructor TLinea.Destroy;
begin
  FMalla:= Nil;
  inherited;
end;

procedure TLinea.DibujarLinea;
begin
   if Assigned(FMalla) then begin
      FMalla.FZona.Canvas.MoveTo(FAlfa.X, FAlfa.Y);
      FMalla.FZona.Canvas.LineTo(FOmega.X, FOmega.Y);
   end;
end;

function TLinea.GetDistancia: Double;
begin
  Result:= FDistancia;
end;

procedure TLinea.Enlaza(AAlfa, AOmega: TNodo);
begin
   if AAlfa = AOmega then
      Raise Exception.Create('No se pueden enlazar dos nodos iguales');

   if AAlfa <> FAlfa then FAlfa:= AAlfa;
   if AOmega <> FOmega then FOmega:= AOmega;

   FDistancia:= CalcularDistanciaNodos(FAlfa, FOmega);
end;

procedure TLinea.SetAlfa(const Value: TNodo);
begin
  if Value <> FOmega then FAlfa := Value;
  FDistancia:= CalcularDistanciaNodos(FAlfa, FOmega);
end;

procedure TLinea.SetIndice(const Value: Integer);
begin
  FIndice := Value;
end;

procedure TLinea.SetOmega(const Value: TNodo);
begin
  if Value <> FAlfa then FOmega := Value;
  FDistancia:= CalcularDistanciaNodos(FAlfa, FOmega);
end;

end.