1:
2:
3:

for x:=1 to max1 do  //max1 < 1000
for y:=1 to max2 do  //max2 < 1000
arr[x,y]:=-1                    

1:

FillChar(DeinArray[1][1], #$FF);                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:

type
   tperbox = array [-2..perboxmaxabs,0..perboxmaxabs] of integer; 
   tsmallworld = array[1..perboxmaxabs,1..perboxmaxabs] of integer;

var
  perbox: tperbox; //speichert die Verbindungen
  shortp: tsmallworld; //speichert alle kürzesten Wegverbindungen mit Bitbesetzung
  smallw: tsmallworld; //speichert zu allen Verbindungen die nummer der kürzesten Weglänge



procedure smallworldrec (sp,sp2,lz:integer);  // (am anfang 1,1,laufzahl) sp2 ist der nachfolger
  var
  x:integer;
begin
  for x:=1 to perboxmaxabs do
  begin
    if
    ((smallw[sp,x] = -1) or (smallw[sp,x] > lz))  //noch keine oder kürzere Verbindung
    and (x <> sp)                                 // wenn im kreis nicht den anfang als verbindung zeigen
    and (perbox[sp2,x] > 0)
    and (perbox[sp2,sp2] > 0) and (perbox[x,x] > 0)then    // Verbindung steht in der Perbox
    begin
      smallw[sp,x]:=lz;
      smallworldrec (sp,x,lz+1);
    end;
  end;
end;

procedure smallworld;
var
  x,y,z1,z2:integer;
  lz1:integer;
  mx:integer;
begin

    begin

    smallwordmatrixinit;
    begin
      mx:= form5.StringGrid1.RowCount-1;
      lz1:=1;
      for z1:=1 to mx do
      begin
        smallworldrec(z1,z1,lz1);
      end;
    end;
    perbox[0,0]:=0;

  end;
end;

procedure shortpathrec (sp,sp2,lz:integer; var panr:integer;n85:integer);  // (am anfang 1,1,laufzahl) sp2 ist der nachfolger
  var
  x,y,y1:integer;
begin
  inc(test);
  x:=0;
  repeat
    inc(x);
    if ((smallw2[sp,x] = -1) or (smallw2[sp,x] >= lz))  //noch keine oder kürzere Verbindung
    and (x <> sp) and (perbox[sp2,x] > 0) then        // Verbindung steht in der Perbox  wenn im kreis nicht den anfang als verbindung zeigen
    begin
      smallw2[sp,x]:=lz;
      smallw2[x,sp]:=lz;
      shortp[sp2,x]:=test;
      shortp[x,sp2]:=test;
      if (lz = smallw[sp,x]) and (x = strtoint(form5.label82.Caption)) and (sp = strtoint(form5.label71.Caption))      then
      begin
        shortp[sp2,x]:=test;
        shortp[x,sp2]:=test;
        inc(panr);
        if panr = n85 then
        gefunden:=true
      end
      else
      if (lz < smallw[sp,strtoint(form5.label82.Caption)]) or (not gefunden) then  //label82: Nr. des zweiten Ausgangspartner bei der kürzesten Weglänge
      shortpathrec (sp,x,lz+1,panr,n85);
    end;
  until (x = perboxmaxabs) or gefunden;
  if not gefunden then
  for y:=1 to perboxmax do
  begin
      shortp[sp2,y]:=-1;
      shortp[y,sp2]:=-1;
  end;
end;

procedure shortpathlengthvorbereiten(n85:integer;betfunc:boolean);      //erledigt die komplette shortlength array
var
  lz1,z1:integer;
  x1,x2:integer;
  p:integer;
begin
    test:=0;
    gefunden:=false;
    p:=0;
    lz1:=1;
    z1:=strtoint(form5.label71.Caption);

   shortpathinit;                //alles shortp auf -1
   shortpathrec(z1,z1,lz1,p,n85);
end;





procedure shortestpathlength(n85:integer;betfunc:boolean);
var
  lz1,z1:integer;
  x1,x2:integer;
  p:integer;
begin
    if smallw[strtoint(form5.label71.Caption),strtoint(form5.label82.Caption)]  //Die Nummern der beiden Ausgangspartner für die shortestpathlength
    begin
      shortpathlengthvorbereiten(n85,betfunc);
      form5.Label87.caption:=((form5.label70.Caption)+ ' to '+(form5.label81.Caption));
      form5.Label88.caption:= ('Pathlength: '+inttostr(smallw[strtoint(form5.label71.Caption),strtoint(form5.label82.Caption)]));
      for x1:=1 to perboxmaxabs do
      for x2:=1 to perboxmaxabs do
      if shortp[x1,x2] <> -1 then
      begin
        perbox[x1,x2]:=perbox[x1,x2]+10000;
        perbox[x2,x1]:=perbox[x2,x1]+10000;
      end;
    end
end;


function betweenness (x:integer):integer;
var
  z1,lz1,p:integer;
  n85:integer;
  a,z:integer;
  asp,zsp:integer;
  bz,bzs,bzss:integer;
  ja,jas:boolean;
  xt:integer;
  bt:real;
begin
  deleteshortpathlength;
  bz:=0;
  bzs:=0;
  bzss:=0;
  bt:=0;

  smallworld2init;              //alles smallw auf -1
  smallworld;      //smallw wird gefüllt

  for a:=1 to form5.StringGrid1.RowCount-2 do
  for z:=a+1 to form5.stringgrid1.rowcount-1 do
  if (a <> x) and (z <> x) and (smallw[a,z] > 1)
        and (perbox[a,a] > 0) and (perbox[z,z] > 0) and (perbox[x,x] > 0) then
  begin
    bz:=0;
    p:=0;
    lz1:=1;
    test:=0;
    gefunden:=false;
    n85:=0;
    jas:=false;
    repeat
      inc(n85);
      ja:=false;
      shortpathinit;                //alles shortp auf -1
      shortestpathlength(n85,true);                             //SHORTESTPAHTLENGTH
      for xt:=1 to form5.stringgrid1.RowCount-1 do
      if (xt <> x) and (perbox[xt,x] > 10000) then
      begin
        ja:=true;
        jas:=true;
      end;
      if ja then inc(bz);
      if (n85-1>bzs) and (jas) then bzs:=n85-1;
      deleteshortpathlength;
      if n85>1 then
      begin
        inc(bzss);
     end;
    until not gefunden;
    if bzs > 0 then
    begin                        //bzs: Anzahl der SP zwischen a und z
      bt:=bt+(bz);// / bzs);        //bz: Anzahl der SP wo x beteiligt ist
    end;                        //bt: betweenness von x für a - z
  end;                          //bzss: Summe aller SP

  if bzss > 0 then
  begin
    betweenness:=trunc((bt*10000) / bzss); 
  end
  else
  betweenness:=0;
end;