• API
• FAQ
• Tools
• Archive
daily pastebin goal
29%
SHARE
TWEET

# Untitled

a guest May 16th, 2018 101 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. unit UGraphOps;
2.
3. interface
4.
5. const
6.     errCode = -1;
7.
8. type
9.    TGraphIncid = array of array of Integer;
10.
11. var
12.    UsedEdge: array of Integer;
13.
14.    function FindCoreTree(const ParamGraph:TGraphIncid): Integer;
15.    function EdgeIsUsed(const j: integer): boolean;
16.    function OppositVertIsAvailable(const currI,j: integer;var OppositVert: integer): boolean;
17.
18. implementation
19.
20. var
21.    Graph: TGraphIncid;
22.    AvailableVert: array of Integer;
23.
25. var
26.     i: integer;
27.    IsIncluded: boolean;
28. begin
29.     IsIncluded := False;
30.     for i := 0 to High(AvailableVert) do
31.       if AvailableVert[i] = VertOrd then
32.         IsIncluded := True;
33.    if not IsIncluded then
34.    begin
35.       SetLength(AvailableVert, Length(AvailableVert) + 1);
36.       AvailableVert[High(AvailableVert)] := VertOrd
37.    end;
38. end;
39.
41. begin
42.    UsedEdge[j] := Weight;
43. end;
44.
45. function OppositVertIsAvailable(const currI,j: integer;var OppositVert: integer): boolean;
46. var
47.     i: integer;
48. begin
49.    i := 0;
50.    if i = currI then
51.     inc(i);
52.    while (i <= High(Graph)) and (Graph[i, j] = 0) do
53.    begin
54.      inc(i);
55.      if i = currI then
56.         inc(i);
57.    end;
58.    if i > High(Graph) then
59.       OppositVert := errCode;
60.    OppositVert := i;
61.    OppositVertIsAvailable := False;
62.    for I := 0 to High(AvailableVert) do
63.     if (AvailableVert[i] = OppositVert) then
64.         OppositVertIsAvailable := True;
65. end;
66.
67. function EdgeIsUsed(const j: integer): boolean;
68. begin
69.    EdgeIsUsed := (UsedEdge[j] <> 0)
70. end;
71.
72. function FindChipestEdge(): integer;
73. const
75. var
76.     i,j,ChipEdgeJ,ChipVertI: Integer;
77.     OppositVert: integer;
78.    ChippestFound: boolean;
79.    TempMin: integer;
80.    Iteration: integer;
81. begin
82.    Result := 0;
83.    ChippestFound := False;
84.    Iteration := 0;
85.    while not ChippestFound and (Iteration <  ImpossibleTaskIteration) do
86.    begin
87.     inc(Iteration);
88.     i := 0;
89.       OppositVert := 0;
90.       ChipEdgeJ := 0;
91.       ChipVertI := 0;
92.       TempMin := High(Integer);
93.     while (i <= High(AvailableVert)) do
94.       begin
95.         j := 0;
96.         while j <= High(Graph[AvailableVert[i]]) do
97.          begin
98.             if  (Graph[AvailableVert[i], j] < TempMin)
99.                and  (Graph[AvailableVert[i], j] > Result)
100.                and not EdgeIsUsed(j)
101.                and (Graph[AvailableVert[i], j] > 0)
102.             then
103.             begin
104.                TempMin := Graph[AvailableVert[i], j];
105.                ChipEdgeJ := j;
106.                ChipVertI := AvailableVert[i];
107.             end;
108.             inc(j)
109.          end;
110.          inc(i);
111.       end;
112.       if (Length(UsedEdge) = 0)
113.          or ((UsedEdge[ChipEdgeJ] = 0)
114.          and not OppositVertIsAvailable(ChipVertI,ChipEdgeJ,OppositVert))
115.       then
116.          ChippestFound := True;
117.       Result := TempMin;
118.       if Iteration >= ImpossibleTaskIteration then
119.         Result := errCode;
120.    end;
123. end;
124.
125. function FindCoreTree(const ParamGraph:TGraphIncid): integer;
126. var
127.    Temp: Integer;
128. begin
129.     UsedEdge := nil;
130.    AvailableVert := nil;
131.     result := 0;
132.     Graph := ParamGraph;
133.    SetLength(UsedEdge, Length(Graph[0]));
135.    while (Length(AvailableVert) < Length(Graph)) and (Temp <> errCode)  do
136.    begin
137.       Temp := FindChipestEdge;
138.       if Temp <> errCode then
139.         FindCoreTree := result + Temp
140.       else
141.         FindCoreTree := errCode;
142.    end;
143. end;
144.
145. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.

Top