unit genericGraph;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils; 

type
  TGraphNode = class;
  TGraphValueType=longint;

  TGraphNodes= array of TGraphNode;
  TGraphNode = class
//  private
    _visitedFrom: TGraphNode;
    _visitingLink: longint;
    _visit: longint;
    index:longint;
  public
    value:TGraphValueType;
    links: TGraphNodes;
    capacities: array of longint;
  end;

  { TGraph }

  TPath=record
    nodes: TGraphNodes;
    links: array of longint;
  end;
  TOnValueToString = procedure(sender:TObject; value: TGraphValueType; var s: string) of object;
  TOnStringToValue = procedure(sender:TObject; s: string; var value: TGraphValueType) of object;
  TGraph = class
  private
    function doValueToString(value: TGraphValueType):string;
    function doStringToValue(s:string):TGraphValueType;
  public
    onValueToString: TOnValueToString;
    onStringToValue: TOnStringToValue;
  
    nodes: array of TGraphNode;
    procedure clear;

    procedure createBackLinks;

    function findShortestPath(f,t: TGraphNode):TPath;
    function findArticulationPoints(): TGraphNodes; //Dies funktioniert nur in *ungerichteten* *zusammenhängenden* Graphen!!

    procedure addValue(v: TGraphValueType);
    procedure addLink(f,t: TGraphNode);

    function saveToString:string;
    procedure loadFromString(s:string);

    function gnFind(gns: TGraphNodes; gn: TGraphNode): longint;
    function gnAdd(var gns: TGraphNodes; gn: TGraphNode): longint;
    function gnRemove(var ara: TGraphNodes;i:longint):TGraphNode;
    function gnRemoveSorted(var ara: TGraphNodes;i:longint):TGraphNode;
    function gnPop(var ara: TGraphNodes):TGraphNode;
    procedure gnInvert(var ara: TGraphNodes);

  end;


implementation
uses bbutils;
function TGraph.gnAdd(var gns: TGraphNodes; gn: TGraphNode): longint;
begin
  result:=length(gns);
  setlength(gns,length(gns)+1);
  gns[result]:=gn;
end;

function TGraph.gnRemove(var ara: TGraphNodes;i:longint):TGraphNode;
begin
  if length(ara)=0 then exit(nil);
  result:=ara[i];
  ara[i]:=ara[high(ara)];
  setlength(ara,high(ara));
end;

function TGraph.gnRemoveSorted(var ara: TGraphNodes; i: longint): TGraphNode;
begin
  if length(ara)=0 then exit(nil);
  result:=ara[i];
  move(ara[i+1],ara[i],(high(ara)-i)*sizeof(ara[i]));
  setlength(ara,high(ara));
end;

function TGraph.gnPop(var ara: TGraphNodes):TGraphNode;
begin
  result:=gnRemove(ara,high(ara));
end;

procedure TGraph.gnInvert(var ara: TGraphNodes);
var temp: TGraphNodes;
    i:longint;
begin
  temp:=ara;
  SetLength(temp,Length(ara));
  for i:=0 to high(temp) do
    ara[high(ara)-i]:=temp[i];
end;
{ TGraph }

function TGraph.doValueToString(value: TGraphValueType): string;
begin
  result:='?';
  if assigned(onValueToString) then onValueToString(self,value,result);
end;

function TGraph.doStringToValue(s: string): TGraphValueType;
begin
  FillChar(result,sizeof(result),0);
  if assigned(onStringToValue) then onStringToValue(self,s,result);
end;

function TGraph.findShortestPath(f,t: TGraphNode):TPath;
var i,j:longint;
    queue:TGraphNodes;
    c:TGraphNode;
begin
  if (f=nil) or (t=nil) then exit;

  queue:=nil;
  for i:=0 to high(nodes) do nodes[i]._visitedFrom:=nil;
  f._visitedFrom:=f;
  f._visitingLink:=-1;
  gnAdd(queue,f);
  while length(queue)>0 do begin
    c:=gnRemoveSorted(queue,0 );
    if c=t then break;
    for j:=0 to high(c.links) do
      if c.links[j]._visitedFrom=nil then begin
        c.links[j]._visitedFrom:=c;
        c.links[j]._visitingLink:=j;
        gnAdd(queue,c.links[j]);
      end;
  end;
  if c=t then begin
    f._visitedFrom:=nil;
    while c<>nil do begin
      gnAdd(Result.nodes,c);
      if c._visitingLink<>-1 then arrayAdd(result.links,c._visitingLink);
      c:=c._visitedFrom;
    end;
    gnInvert(Result.nodes);
    arrayInvert(Result.links);
    arrayAdd(result.links,-1);
  end;
end;

function TGraph.findArticulationPoints(): TGraphNodes;
const VINFITY=99999999;
var presult: TGraphNodes;
  function subVisit(n: TGraphNode;deep:longint):longint;
  var i,t,calledChildren:longint;
      arti:boolean;
  begin
    arti:=false;
    n._visit:=deep;
    result:=deep;
    calledChildren:=0;
    for i:=0 to high(n.links) do
      if n.links[i]._visit=VINFITY then begin
        t:=subVisit(n.links[i],deep+1);
        if (t<result) then result:=t;
        arti:=arti or (t>=deep);
      end else if (n.links[i]._visit<result) then
        result:=n.links[i]._visit;

    n._visit:=result;
    if arti then gnAdd(presult,n);
  end;
var i:longint;
    nullAdded: boolean;
begin
  if length(nodes)=0 then exit;
  if length(nodes[0].links)=0 then exit;
  for i:=0 to high(nodes) do nodes[i]._visit:=VINFITY;
  nodes[0]._visit:=0;
  subVisit(nodes[0].links[0],1);
  nullAdded:=false;
  for i:=1 to high(nodes[0].links) do
    if nodes[0].links[i]._visit=VINFITY then begin
      subVisit(nodes[0].links[i],1);
      if not nullAdded then begin
        gnAdd(presult,nodes[0]);
        nullAdded:=true;
      end;
    end;
  Result:=presult;
end;

procedure TGraph.clear;
var i:longint;
begin
  for i:=0 to high(nodes) do
    nodes[i].free;
  SetLength(nodes,0);
end;

procedure TGraph.createBackLinks;
var i,j:longint;
begin
  for i:=0 to high(nodes) do
    for j:=0 to high(nodes[i].links) do
      addLink(nodes[i].links[j],nodes[i]);
end;

procedure TGraph.addValue(v: TGraphValueType);
var node: TGraphNode;
begin
  node:=TGraphNode.Create;
  node.value:=v;
  gnAdd(nodes,node);
  node.index:=high(nodes);
end;

procedure TGraph.addLink(f, t: TGraphNode);
begin
  if (f=nil) or (t=nil) then exit;
  if gnFind(f.links,t)<>-1 then exit;
  SetLength(f.links,length(f.links)+1);
  f.links[high(f.links)]:=t;
end;

function TGraph.saveToString: string;
var i,j:longint;
begin
  result:=IntToStr(Length(nodes))+#13#10;
  result+='#Values:'+#13#10;
  for i:=0 to high(nodes) do
    result+=doValueToString(nodes[i].value)+#13#10;
  result+='#Link-IDs:'+#13#10;
  for i:=0 to high(nodes) do begin
    result+=IntToStr(length(nodes[i].links));
    for j:=0 to high(nodes[i].links) do
      Result+=' '+IntToStr(nodes[i].links[j].index);
    result+=#13#10;
  end;
end;

procedure TGraph.loadFromString(s: string);
var i,j,k,m,n,c:longint;
    sl:TStringList;
    tempValue: TGraphValueType;
    line:string;
begin
  clear;
  sl:=TStringList.Create;
  sl.text:=s;
  n:=StrToInt(sl[0]);
  if sl[1]<>'#Values:' then raise Exception.Create('Expected #Values: in line 2');
  c:=2;
  for i:=1 to n do begin
    tempValue:=doStringToValue(sl[c]);c+=1;
    addValue(tempValue);
  end;
  if sl[c]<>'#Link-IDs:' then raise Exception.Create('not found');
  c+=1;
  for i:=0 to n-1 do begin
    line:=sl[c]+' ';c+=1;
    m:=StrToInt(splitGet(' ',line));
    for j:=1 to m do begin
      k:=StrToInt(splitGet(' ',line));
      addLink(nodes[i],nodes[k]);
    end;
  end;
  sl.free;
end;

function TGraph.gnFind(gns: TGraphNodes; gn: TGraphNode): longint;
var i:longint;
begin
  for i:=0 to high(gns) do
    if gns[i]=gn then exit(i);
  result:=-1;
end;

end.

