Luxophia

Core.pas
282 строки · 8.3 Кб
Перенос по словам
1
unit Core;
2

3
interface //#################################################################### ■
4

5
uses FMX.Types, FMX.TreeView,
6
     LUX.Graph.Tree;
7

8
type //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【型】
9

10
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
11

12
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
13

14
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTreeNode
15

16
     TTreeNode = class( LUX.Graph.Tree.TTreeNode<TTreeNode> )
17
     private
18
     protected
19
     public
20
       Name :String;
21
       /////
22
       constructor Create; override;
23
     end;
24

25
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TMyMaterialSource
26

27
//const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
28

29
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
30

31
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
32

33
function RandString( const N_:Integer ) :String;
34

35
procedure ShowTree( const TreeView_:TTreeView; const Root_:TTreeNode );
36

37
function RandNode( const Node_:TTreeNode ) :TTreeNode;
38
function RandKnot( const Node_:TTreeNode ) :TTreeNode;
39

40
function FindNode( const Node_:TTreeNode ) :TTreeNode;
41
function FindKnot( const Knot_:TTreeNode ) :TTreeNode;
42
function FindLeaf( const Node_:TTreeNode ) :TTreeNode;
43

44
procedure AddNode( const Root_:TTreeNode );
45
procedure TransNode( const Root0_,Root1_:TTreeNode );
46
procedure SwapSibliNodes( const Root_:TTreeNode );
47
procedure SwapOtherNodes( const Root1_,Root2_:TTreeNode );
48
procedure DelNode( const Root_:TTreeNode );
49

50
implementation //############################################################### ■
51

52
uses System.SysUtils;
53

54
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
55

56
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
57

58
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTreeNode
59

60
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
61

62
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
63

64
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
65

66
constructor TTreeNode.Create;
67
begin
68
     inherited;
69

70
     Name := RandString( 8 );
71
end;
72

73
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
74

75
function RandString( const N_:Integer ) :String;
76
const
77
     Cs = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
78
var
79
   I :Integer;
80
begin
81
     Result := '';
82

83
     for I := 1 to N_ do Result := Result + Cs.Chars[ Random( 26 ) ];
84
end;
85

86
//------------------------------------------------------------------------------
87

88
procedure ShowTree( const TreeView_:TTreeView; const Root_:TTreeNode );
89
//･･･････････････････････････････････････････････････････････････････････････
90
     procedure AddNode( const Parent_:TFmxObject; const TreeNode_:TTreeNode );
91
     var
92
        I :Integer;
93
        P :TTreeViewItem;
94
        S :String;
95
     begin
96
          P := TTreeViewItem.Create( TreeView_ );
97

98
          P.Parent := Parent_;
99

100
          if Assigned( TreeNode_.Paren ) then S := TreeNode_.Order.ToString
101
                                         else S := '-';
102

103
          P.Text   := S + ' [' + TreeNode_.Name + '] ' + TreeNode_.ChildsN.ToString;
104

105
          with TreeNode_ do
106
          begin
107
               for I := 0 to ChildsN-1 do AddNode( P, Childs[ I ] );
108
          end;
109
     end;
110
//･･･････････････････････････････････････････････････････････････････････････
111
begin
112
     TreeView_.Clear;
113

114
     AddNode( TreeView_, Root_ );
115

116
     TreeView_.ExpandAll;
117
end;
118

119
//------------------------------------------------------------------------------
120

121
function RandNode( const Node_:TTreeNode ) :TTreeNode;
122
begin
123
     Result := Node_.Childs[ Random( Node_.ChildsN ) ];
124
end;
125

126
function RandKnot( const Node_:TTreeNode ) :TTreeNode;
127
var
128
   I, N :Integer;
129
   P :TTreeNode;
130
   Ps :TArray<TTreeNode>;
131
begin
132
     with Node_ do
133
     begin
134
          SetLength( Ps, ChildsN );
135

136
          N := 0;
137
          for I := 0 to ChildsN-1 do
138
          begin
139
               P := Childs[ I ];
140

141
               if P.ChildsN > 0 then
142
               begin
143
                    Ps[ N ] := P;  Inc( N );
144
               end;
145
          end;
146
     end;
147

148
     if N = 0 then Result := nil
149
              else Result := Ps[ Random( N ) ];
150
end;
151

152
//------------------------------------------------------------------------------
153

154
function FindNode( const Node_:TTreeNode ) :TTreeNode;
155
begin
156
     Result := Node_;
157

158
     while ( Result.ChildsN > 0 )
159
       and ( Random( 4 )    > 0 ) do Result := RandNode( Result );
160
end;
161

162
function FindKnot( const Knot_:TTreeNode ) :TTreeNode;
163
var
164
   P :TTreeNode;
165
begin
166
     Result := Knot_;
167

168
     while Random( 4 ) > 0 do
169
     begin
170
          P := RandKnot( Result );
171

172
          if not Assigned( P ) then Exit;
173

174
          Result := P;
175
     end;
176
end;
177

178
function FindLeaf( const Node_:TTreeNode ) :TTreeNode;
179
begin
180
     Result := Node_;
181

182
     while Result.ChildsN > 0 do Result := RandNode( Result );
183
end;
184

185
//------------------------------------------------------------------------------
186

187
procedure AddNode( const Root_:TTreeNode );
188
var
189
   P :TTreeNode;
190
begin
191
     P := FindNode( Root_ );
192

193
     case Random( 2 ) of
194
       0: TTreeNode.Create.Paren := P;
195
       1: TTreeNode.Create( P );
196
     end;
197
end;
198

199
procedure TransNode( const Root0_,Root1_:TTreeNode );
200
var
201
   C, P :TTreeNode;
202
begin
203
     if Root0_.ChildsN > 0 then
204
     begin
205
          C := FindLeaf( RandNode( Root0_ ) );
206
          P := FindNode( Root1_ );
207

208
          if P.ChildsN = 0 then
209
          begin
210
               case Random( 3 ) of
211
                 0: C.Paren := P;
212
                 1: P.InsertHead( C );
213
                 2: P.InsertTail( C );
214
               end;
215
          end
216
          else
217
          begin
218
               case Random( 9 ) of
219
                 0: C.Paren := P;
220
                 1: P.InsertHead( C );
221
                 2: P.InsertTail( C );
222
                 3: TTreeNode( P.Head ).InsertPrev( C );                           {本来キャスト不要}
223
                 4: TTreeNode( P.Head ).InsertNext( C );                           {本来キャスト不要}
224
                 5: TTreeNode( P.Tail ).InsertPrev( C );                           {本来キャスト不要}
225
                 6: TTreeNode( P.Tail ).InsertNext( C );                           {本来キャスト不要}
226
                 7: TTreeNode( P.Childs[ Random( P.ChildsN ) ] ).InsertPrev( C );  {本来キャスト不要}
227
                 8: TTreeNode( P.Childs[ Random( P.ChildsN ) ] ).InsertNext( C );  {本来キャスト不要}
228
               end;
229
          end;
230
     end;
231
end;
232

233
procedure SwapSibliNodes( const Root_:TTreeNode );
234
var
235
   P, C1, C2 :TTreeNode;
236
   I1, I2 :Integer;
237
begin
238
     if Root_.ChildsN > 0 then
239
     begin
240
          P := FindKnot( Root_ );
241

242
          if Assigned( P ) then
243
          begin
244
               C1 := RandNode( P );  I1 := C1.Order;
245
               C2 := RandNode( P );  I2 := C2.Order;
246

247
               case Random( 4 ) of
248
                 0: C1.Order := I2;
249
                 1: C2.Order := I1;
250
                 2: P.Swap( I1, I2 );
251
                 3: TTreeNode.Swap( C1, C2 );
252
               end;
253
          end;
254
     end;
255
end;
256

257
procedure SwapOtherNodes( const Root1_,Root2_:TTreeNode );
258
var
259
   C1, C2 :TTreeNode;
260
begin
261
     if ( Root1_.ChildsN > 0 )
262
     or ( Root2_.ChildsN > 0 ) then
263
     begin
264
          C1 := FindLeaf( RandNode( Root1_ ) );
265
          C2 := FindLeaf( RandNode( Root2_ ) );
266

267
          TTreeNode.Swap( C1, C2 );
268
     end;
269
end;
270

271
procedure DelNode( const Root_:TTreeNode );
272
begin
273
     if Root_.ChildsN > 0 then FindLeaf( RandNode( Root_ ) ).Free;
274
end;
275

276
//############################################################################## □
277

278
initialization //######################################################## 初期化
279

280
finalization //########################################################## 最終化
281

282
end. //######################################################################### ■
283
Luxophia

Использование cookies
