Genetic Programming try

[bluatigro]

@ djzepi :
done that

error :
GeneProg.pas(89,1) Fatal: Syntax error, "identifier" expected but "BEGIN" found

Code: Pascal  [Select][+][-]

1. // genetic programming lib
2. unit GeneProg;
3.  
4. {$mode objfpc}{$H+}
5.  
6. interface
7.  
8. uses
9.   Classes, SysUtils;
10.  
11.  
12. function find( a : string ; b : char ; start : integer ) : integer ;
13.  
14. type TGeneProg = class
15. private
16.   numbermode : string ;
17.   genes : array[ 0 .. 200 ] of string ;
18.   gentel : integer ;
19.   variable : array[ 0 .. 10 ] of double ;
20.   varmax : integer ;
21.   proglenmax : integer ;
22. //  function lastsharp( seed : string ) : string
23. //  function growth( seed : string ) : string
24. public
25.   constructor Create() ;
26.   destructor distroy() ;
27.   function Run( prog : string ) : string ;
28. //  function write( hooks : integer ) : string
29. //  function mix( a , b : string ) : string
30. //  function mutate( prog : string ) : string
31. //  procedure use( gen : string )
32. //  procedure integerlist()
33. //  procedure doublelist()
34. //  procedure setVar()
35. //  procedure setVarMax()
36. end ;
37.  
38. implementation
39.  
40. constructor TGeneProg.create ;
41. begin
42.   inherited Create ;
43.   numbermode := 'only vars' ;
44.   gentel := 0 ;
45.   varmax := 0 ;
46.   proglenmax := 400 ;
47. end ;
48. destructor TGeneProg.distroy() ;
49. begin
50.   // what do i do here ?
51. end;
52.  
53. function TGeneProg.Run( prog : string ) : string ;
54. // calc output of formula
55. // when iligal calc result := 'error'
56. // 21-12-2017 : version 0.1 : result is inner list
57. var
58.   start , einde : integer ;
59.   temp : string ;
60. //  a , b , ab : double ;
61. //  q : TStringArray ;
62. begin
63.   einde := find( prog , ']' , 0 ) ;
64.   start := einde ;
65.   while prog[start] <> '[' do
66.     start := start - 1 ;
67.   temp := LeftStr( prog , einde ) ;
68.   temp := RightStr( temp , length( temp ) - start ) ;
69.   Result :=  temp ;
70. end ;
71.  
72. function find( a : string ; b : char ; start : integer ) : integer ;
73. var
74.   i : integer ;
75. begin
76.   i := start ;
77.   while ( a[i] <> b ) and ( i < length( a ) ) do
78.     i := i + 1 ;
79.   if i < length( a ) then
80.     Result := i
81.   else
82.     Result := -1 ;
83. end ;
84.  
85. var
86.   ADD , SUB , DIVI , MUL , SQR , LETTERS : string ;
87.   GP : GeneProg .
88.  
89. begin
90.   GP := GeneProg.create ;
91.   ADD  := '[ + # # ]' ;
92.   MUB  := '[ - # # ]' ;
93.   DIVI := '[ / # # ]' ;
94.   MUL  := '[ * # # ]' ;
95.   SQR  := '[ sqr # # ]' ;
96.   LETTERS := 'abcdefgh' ;
97. end.
98.  

[Thaddy]

Code: Pascal  [Select][+][-]

1. destructor TGeneProg.Destroy;override; // needs override and distroy()  is a spelling mistake
2. begin
3.   // what do i do here ?
4.  // well clean up anything that needs finalization and then call at last:
5.  inherited Destroy; // in most if not all normal cases you *must* call inherited;
6. end;

Also don't use spaces between keywords and ;

[Handoko]

@Thaddy

You found a bug in his code. But I think that error message that the OP got is telling us the dot on line #87.

GeneProg.pas(89,1) Fatal: Syntax error, "identifier" expected but "BEGIN" found

It said it found problem on #89,1. It usually means something wrong preceding that location.

[lainz]

Code: Pascal  [Select][+][-]

1. var
2.   ADD , SUB , DIVI , MUL , SQR , LETTERS : string ;
3.   GP : GeneProg .
4.  

There is a dot "." instead of ";"

[Thaddy]

Dead pixel bug  Indeed a dot instead of a semi-column at line 87.
Note the bug I found is also a bug and he should fix that too.

[mangakissa]

Besides of the dot, the unit will not compile. There's no function name available and this structure is only working in a project file.

@bluatigro
If the function find only created to search in the string given in the object /class, don't make it public, but put it in your class as a private function.
If there's only 1 '[' in the string, use function pos

Code: Pascal  [Select][+][-]

1. einde := pos(']',prog);
2. start  := pos('[',prog);
3.  

[bluatigro]

@  mangakissa :
a frormula has a unkown number of '[' and ']'
it wil have to be the same number
einde := firsts ']' in prog
start := last '[' for einde

i tryed a ';' after the var's
but i got the same error

[howardpc]

The attached project has little to do with gene programming, but may help you with parsing the command strings you will need.

Regarding your question about what is needed in the gene class destructor: for your purposes it is sufficient to use the inherited (TObject)  constructor and destructor, so you do not need to override the inherited destructor and add more code.

[bluatigro]

@ howardpc :
done a first use
GP.run() has to return the inner list of the formula

Code: Pascal  [Select][+][-]

1. program GPTestRun;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   {$IFDEF UNIX}{$IFDEF UseCThreads}
7.   cthreads,
8.   {$ENDIF}{$ENDIF}
9.   Classes, GeneProg
10.   { you can add units after this };
11.  
12.  
13. var
14.   zin , proga , progb : string ;
15.   woord : TStringArray ;
16.   i : integer ;
17. begin
18.   zin := 'this is a test .' ;
19.   woord := zin.Split( ' ' ) ;
20.   for i = low( woord ) to high( woord ) do
21.     writeln( i , woord[i] ) ;
22.   proga := '[ + 7 [ - 2 3 ] ]' ;
23.   progb := '[ * 8 [ / 9 10 ] ]' ;
24.   writeln( '[ test run ]' ) ;
25.   writeln( 'prog a = ' , proga ) ;
26.   writeln( 'prog b = ' , progb ) ;
27. // shoot return '[ - 2 3 ]'
28.   writeln( 'run a = ' , GP.run( proga ) ) ;
29. // shoot return '[ / 9 10 ]'
30.   writeln( 'run b = ' , GP.run( progb ) ) ;
31.   write( '[ push return ]' ) ;
32.   readln() ;
33. end.
34.  
35. [code]

[howardpc]

Try this:

Code: Pascal  [Select][+][-]

1. program GPTestRun;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   sysutils, GeneProg;
7.  
8. var
9.   zin, progA, progB: String;
10.   woord: TStringArray;
11.   i: Integer;
12.   GP: TGP;
13.  
14. begin
15.   zin := 'this is a test .';
16.   woord := zin.Split(' ');
17.   for i := Low(woord) to High(woord) do
18.     WriteLn(i, ' ', woord[i]);
19.   progA := '[ + 7 [ - 2 3 ] ]';
20.   progB := '[ * 8 [ / 9 10 ] ]';
21.   WriteLn;
22.   WriteLn('[ test Run ]');
23.   WriteLn('prog A = ', progA, '  // should return [ - 2 3 ]');
24.   WriteLn('Run A = ', GP.Run(progA));
25.   WriteLn;
26.   WriteLn('prog B = ', progB, '  // should return [ / 9 10 ]');
27.   WriteLn('Run B = ', GP.Run(progB));
28.   WriteLn;
29.   WriteLn('[ Press return to quit ]');
30.   ReadLn;
31. end.

The unit GeneProg is as follows:

Code: Pascal  [Select][+][-]

1. unit GeneProg;
2.  
3. {$mode objfpc}{$H+}
4. {$ModeSwitch advancedrecords}
5.  
6. interface
7.  
8. uses
9.   SysUtils;
10.  
11. type
12.   TGP = record
13.     function HasCorrectlyNestedBrackets(const aText: AnsiString; out start, endd: Integer): Boolean;
14.     function Run(aText: String): String;
15.     function Find(const s: AnsiString; c: AnsiChar; startPos: Integer): Integer;
16.   end;
17.  
18. function Split(aText: String; atChar: Char): TStringArray;
19.  
20. implementation
21.  
22. function Split(aText: String; atChar: Char): TStringArray;
23. var
24.   index: Integer = 0;
25.   start: Integer =1;
26.   i: Integer;
27. begin
28.   aText:=Trim(aText);
29.   if aText = '' then
30.     Exit(Nil);
31.   SetLength(Result, 100);
32.   for i:=1 to Length(aText) do
33.     if (aText[i] = atChar) then begin
34.       Result[index]:=Copy(aText, start, i-start);
35.       start:=i + 1;
36.       Inc(index);
37.     end;
38.   if start <= Length(aText) then begin
39.     Result[index]:=Copy(aText, start, Length(aText) + 1 - start);
40.     Inc(Index);
41.   end;
42.   SetLength(Result, index);
43. end;
44.  
45. { TGP }
46.  
47. function TGP.Find(const s: AnsiString; c: AnsiChar; startPos: Integer): Integer;
48. var
49.   p: Integer;
50. begin
51.   if (s = '') or (startPos > Length(s)) or (startPos < 1) then
52.     Exit(0);
53.  
54.   for p := startPos to Length(s) do
55.     if (s[p] = c) then
56.       Exit(p);
57.  
58.   Result := 0;
59. end;
60.  
61. function TGP.HasCorrectlyNestedBrackets(const aText: AnsiString; out start,
62.   endd: Integer): Boolean;
63. const
64.   LBracket = '[';
65.   RBracket = ']';
66. var
67.   s1, e2: Integer;
68. begin
69.   start:=0;
70.   endd:=0;
71.   s1:=Find(aText, LBracket, 1);
72.   if s1 = 0 then
73.     Exit(False);
74.   start:=Find(aText, LBracket, s1+1);
75.   if start = 0 then
76.     Exit(False);
77.   endd:=Find(aText, RBracket, start+1);
78.   if endd = 0 then
79.     Exit(False);
80.   e2:=Find(aText, RBracket, endd+1);
81.   if e2 = 0 then
82.     Exit(False)
83.   else Exit(True);
84. end;
85.  
86. function TGP.Run(aText: String): String;
87. var
88.   s, e: Integer;
89. begin
90.   if HasCorrectlyNestedBrackets(aText, s, e) then
91.     Exit(Copy(aText, s, e-s+1))
92.   else Exit('< invalid string: "'+aText+'"');
93. end;
94.  
95. end.

[bluatigro]

@ howardpc
when GP.mix() GP.write() and GP.mutate()
are ready then the place and number of '[' and ']'
is almost unpreditelble
so a hascorectbractets() function only can count
the number of '[' and ']' and look if thet are the same
GP.run() wil expect that

[howardpc]

Yes, if your program is meant to deal with an arbitrary number of nested [  ] bracket pairs, then the parsing code will have to be much more complex.
It should not merely check that numbers of [ and ] are equal, but that each [ is correctly paired with a corresponding ] in a valid position in the parsed string. This task is not trivial.

[bluatigro]

for showing that it wil work
justbasic version see :
http://libertybasic.nl/viewtopic.php?f=4&t=649
python 2.7 version see :
http://www.helpmij.nl/forum/showthread.php/928919-python-2-7-Geneties-Programmeren
i have not jet a working c++ and freebasic version
in these you can see proof of consept