Genetic Programming try

[bluatigro]

i m trying to build a GP class in lazarus

GP what :
trying to create a formula from a array of points

GP how :
1 : write some random formula's [ GP.write() ]
2 : calc output of formula's [ GP.run() ]
3 : sort forumla's on fitnes [ evaluate ]
4 : create kid's from best [ GP.mix() ]
5 : mutate some kid's [ GP.mutate() ]
6 : if error > wish and generation < max goto 2

step 1 :
buiding find() and split()

error :
line 10 of geneprog :
, found ) expekted

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 : string ;
15.   word : array of string ;
16.   i : integer ;
17. begin
18.   zin := 'this is a test .' ;
19.   split( zin , word ) ;
20.   for i = low( word ) to high( word ) do
21.     print i , word[i] ;
22. end.
23.  

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

1. unit GeneProg;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils;
9.  
10. function find( a : string , b : char , start : integer ) : integer
11. var
12.   i
13. begin
14.   i = start ;
15.   while a[i] <> b and i < length( a )
16.     i := i + 1 ;
17.   if i < lenght( a ) then
18.     Result := i ;
19.   Result := -1 ;
20. end ;
21.  
22. procedure split( a : string , uit : array of string )
23. var
24.   i , p , tel : integer ;
25. begin
26.    i := 0 ;
27.    tel := 0 ;
28.    while i <> -1
29.    begin
30.      i := find( a , ' ' , i ) ;
31.      tel := tel + 1 ;
32.    end ;
33.    SetLength( uit , tel + 1 ) ;
34.    i := 0 ;
35.    while i <= tel
36.    begin
37.      p := find( a , ' ' , 0 ) ;
38.      uit[i] := StrLeft( a , p ) ;
39.      a := StrRigth( a , length( a ) - p ) ;
40.      i := i + 1 ;
41.    end ;
42. end ;
43.  
44. type GeneProg = class
45. private :
46.   numbermode : string ;
47.   genes[ 200 ] : string ;
48.   gentel : integer ;
49.   var[ 10 ] : real ;
50.   varmax : integer ;
51.   proglenmax : integer ;
52. //  function lastsharp( seed : string ) : string
53. //  function growth( seed : string ) : string
54. public :
55.   procedure init()
56.   function run( prog : string ) : string
57. //  function write( hooks : integer ) : string
58. //  function mix( a , b : string ) : string
59. //  function mutate( prog : string ) : string
60. //  procedure use( gen : string )
61. //  procedure integerlist()
62. //  procedure reallist()
63. end ;
64.  
65. procedure GeneProg.init()
66. begin
67.   numermode := 'only vars' ;
68.   gentel := 0 ;
69.   varmax := 0 ;
70.   prolenmax := 400 ;
71. end ;
72. function GeneProg.run( prog : string ) : string
73. var
74.   start , einde : integer ;
75. begin
76.   Result := 'error' ;
77. end ;
78.  
79. implementation
80.  
81. end.
82.  
83.  

[Handoko]

Don't do it:

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

1.   word: array of string;

Use ":="

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

1.   for i := low ......

It should be:

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

1. function find(a: string; b: Char; start: Integer): Integer;

You forgot to put "Integer":

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

1. var
2.   i: Integer;

You forgot to use "do":

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

1.   while (a[i] <> b) and (i < length(a)) do

This is not good to do:

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

1.   if i < lenght( a ) then
2.     Result := i;
3.   Result := -1;

It should be

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

1. procedure split(a: string; uit: array of string);

Again, you forgot to use "do"

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

1.    while i <> -1 do

Also this one:

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

1.    while i <= tel do

---edit---
Your code has too many syntax errors. You should learn basic Pascal syntax by reading the documentations.

[Thaddy]

I am in a very good mood today. 
Have a look at this and compare to your code. I hope you will learn something. You made way too many mistakes and the compiler told you what they were:

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

1. program GPTestRun;
2. {$ifdef windows}{$apptype console}{$endif}
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   Sysutils, GeneProg
7. var
8.   zin : string ;
9.   woord : TStringArray; // word is a reserved word <sic>
10.   i : integer ;
11. begin
12.   zin := 'this is a test .' ;
13.   split( zin , woord ) ;
14.   for i := low( woord ) to high( woord ) do
15.     writeln( i, woord[i]:25) ;
16. end.

And here your unit:

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

1. unit GeneProg;
2. {$mode objfpc}{$H+}
3. interface
4. uses sysutils;
5.  
6. type
7. TGeneProg = class
8. private
9.   numbermode : string ;
10.   genes: array[0..199] of string ;// this is the correct syntax to declare an array of 200 elements
11.   gentel : integer ;
12.   variable: array [0..9] of double;// Same as above + var is a reserved word (so I renamed it) and real is a deprecated type, use double
13.   varmax : integer ;
14.   proglenmax : integer ;
15. public
16.   constructor create;  // was your init procedure
17.   function run( prog : string ) : string;
18. end;
19.  
20.  
21.  
22. function find( const a : string ; const b : char ; start : integer ) : integer;
23. procedure split(const a : string ; var uit : TStringArray );
24.  
25. implementation
26.  
27. function find( const a : string ; const b : char ; start : integer ) : integer;
28. begin
29.   result := a.Indexof(b,start) // indexof (find) is a standard function for string
30. end ;
31.  
32. // I editted this as per my later reply.
33. procedure split(const a : string ; var uit : TStringArray );
34. begin
35.    Uit := a.Split(' ');  // split is a standard function for string
36. end ;
37.  
38. constructor TGeneProg.Create;
39. begin
40.   inherited create;
41.   numbermode := 'only vars' ;
42.   gentel := 0 ;
43.   varmax := 0 ;
44.   proglenmax := 400 ;
45. end ;
46.  
47. function TGeneProg.run( prog : string ) : string;
48. var
49.   start , einde : integer ;
50. begin
51.   Result := 'error' ;
52. end ;
53. end.

I left in unused variables, so you can use them later yourself.
 

 

[bluatigro]

thanks for help to al

i m used to basic , c++ and python

so it is posible that it wil take some time to code
pascal whitout mistakes

[Handoko]

Nothing wrong with Basic, C++, Python or whatever. Before I seriously use Pascal, I learned/used Basic, Assembly, MS Access. What you need to do is read the documentations.

The more variety programming languages you learned, the better a programmer you are. I want to learn C++, D, Python if I have time.

[Thaddy]

Note I had a slight oversight: you *must* use the latest release fpc 3.0.4.
I also used a feature that is only in trunk, afaik, implicit dynamic array constructors, so I removed that, also in the above example.
That example is correct ,though, but the next is more elegant:
So:

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

1. procedure split(const a : string ; var uit : TStringArray );
2. begin
3.   Uit := a.Split(' ');  // split is a standard function for string
4. end;

should fix that for 3.0.4.
Or simply drop your split and split the string directly:

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

1. program GPTestRun;
2. {$ifdef windows}{$apptype console}{$endif} {$mode objfpc}{$H+}
3. uses
4.   Sysutils;
5. var
6.   zin : string ;
7.   woord : TStringArray;
8. begin
9.   zin := 'this is a test .' ;
10.   woord := zin.split( ' ') ;
11.   for zin in woord do // re-use zin
12.     writeln(zin) ;
13. end.

 Note I used very modern Pascal features throughout.

[bluatigro]

update :
some error's removed
GP.run() version 0.1 result is inner list

error :
geneprog.pas : line 49 : var found ; expected ?

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 : 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. end.
23.  

geneprog.pas :

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( const a : string ; const 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.   function Run( prog : string ) : string ;
27. //  function write( hooks : integer ) : string
28. //  function mix( a , b : string ) : string
29. //  function mutate( prog : string ) : string
30. //  procedure use( gen : string )
31. //  procedure integerlist()
32. //  procedure reallist()
33. end ;
34.  
35. implementation
36.  
37. constructor TGeneProg.create ;
38. begin
39.   inherited Create ;
40.   numbermode := 'only vars' ;
41.   gentel := 0 ;
42.   varmax := 0 ;
43.   proglenmax := 400 ;
44. end ;
45. function TGeneProg.Run( prog : string ) : string
46. // calc output of formula
47. // when iligal calc result := 'error'
48. // 21-12-2017 : version 0.1 : result is inner list
49. var
50.   start , einde : integer ;
51.   temp : string ;
52.   a , b , ab : double ;
53.   q : TSringArray ;
54. begin
55.   einde := find( prog , ']' , 0 ) ;
56.   start := einde ;
57.   while prog[start] <> '[' do
58.     start := start - 1 ;
59.   temp := StrLeft( prog , einde ) ;
60.   temp := StrRight( temp , length( temp ) - start ) ;
61.   Result :=  temp ;
62. end ;
63.  
64. function find( a : string , b : char , start : integer ) : integer
65. var
66.   i : integer ;
67. begin
68.   i := start ;
69.   while ( a[i] <> b ) and ( i < length( a ) ) do
70.     i := i + 1 ;
71.   if i < lenght( a ) then
72.     Result := i ;
73.   else
74.     Result := -1 ;
75. end ;
76.  
77. var
78.   ADD , SUB , DIV , MUL , SQR , LETTERS : string ;
79.  
80. begin
81.   GP := GeneProg.create ;
82.   ADD := '[ + # # ]' ;
83.   SUB := '[ - # # ]' ;
84.   DIV := '[ / # # ]' ;
85.   MUL := '[ * # # ]' ;
86.   SQR := '[ sqr # # ]' ;
87.   LETTERS := 'abcdefgh' ;
88. end.
89.  

[Josh]

 line 49 : var found ; expected ?

original code

Code: [Select]

function TGeneProg.Run( prog : string ) : string
// calc output of formula
// when iligal calc result := 'error'
// 21-12-2017 : version 0.1 : result is inner list
var

The missing ; is at end of function declaration
new code

Code: [Select]

function TGeneProg.Run( prog : string ) : string ;  // <-- the semicolon was missing
// calc output of formula
// when iligal calc result := 'error'
// 21-12-2017 : version 0.1 : result is inner list
var


[schuler]

  Hello ,
This post adds comments to whom may find it interesting.

The main difference from genetic algorithm to evolutionary algorithm is sex (chromosomal crossover). Sex is useful when combining 2 solutions gives a working solution. Combining 2 pieces of pascal code hardly ever gives a working code. Technically speaking, some problems benefit from sex while other problems don't. I have passion for plain evolutionary algorithms. They have solved problems for me before.

In the case that you would like to have a look at a plain evolutionary algorithm implemented in pascal, here we go:
https://sourceforge.net/p/cai/svncode/HEAD/tree/trunk/lazarus/libs/uevolutionary.pas

There is an OpenCL example here:
https://sourceforge.net/p/cai/svncode/HEAD/tree/trunk/lazarus/opencl/easy-trillion-test/

  Wish everyone happy pascal coding

[bluatigro]

@ schuler :
sex can be done whit GP
you wil see it later [ GP.mix() ]
i agree that it is not Always useful code
but sometimes it is

i removed most of the error's

error :
81 : ; expected else fount

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 , DIV , MUL , SQR , LETTERS : string ;
87.  
88. begin
89.   GP := GeneProg.create ;
90.   ADD := '[ + # # ]' ;
91.   SUB := '[ - # # ]' ;
92.   DIV := '[ / # # ]' ;
93.   MUL := '[ * # # ]' ;
94.   SQR := '[ sqr # # ]' ;
95.   LETTERS := 'abcdefgh' ;
96. end.
97.  
98.  
99.  

how do i do :
string to double
and
double to string ?

[Thaddy]

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

1. {$mode objfpc}{$H+}
2. uses sysutils;
3. var
4.   s:string ='100';
5.   d:double;
6. begin
7.   d:= s.ToDouble; //string to double
8.   writeln(s);
9.   s:= d.ToString;  // double to string
10.   writeln(s); // writeln can handle both
11. end.

[bytebites]

81 : ; expected else fount

No semicolon before else.

[Thaddy]

True. No semicolumn until your block has finished is a simple syntax rule. A semi-column indicates block termination.
(It is also parser generator hell, because it is ambiguous)

[bluatigro]

i tryed several cominations
including a begin - end block

i got the same error

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.   ;
82.   else
83.     Result := -1 ;
84. end ;
85.  
86. var
87.   ADD , SUB , DIV , MUL , SQR , LETTERS : string ;
88.  
89. begin
90.   GP := GeneProg.create ;
91.   ADD := '[ + # # ]' ;
92.   SUB := '[ - # # ]' ;
93.   DIV := '[ / # # ]' ;
94.   MUL := '[ * # # ]' ;
95.   SQR := '[ sqr # # ]' ;
96.   LETTERS := 'abcdefgh' ;
97. end.
98.  
99.  

[djzepi]

try this

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,SysUtils, unit1
10.   { you can add units after this };
11.  
12.  
13. var
14.   zin : 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.   readln;
23. end.
24.  

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( const a : string ; const 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.   function Run( prog : string ) : string ;
27. //  function write( hooks : integer ) : string
28. //  function mix( a , b : string ) : string
29. //  function mutate( prog : string ) : string
30. //  procedure use( gen : string )
31. //  procedure integerlist()
32. //  procedure reallist()
33. end ;
34.  
35. implementation
36.  
37. constructor TGeneProg.create ;
38. begin
39.   inherited Create ;
40.   numbermode := 'only vars' ;
41.   gentel := 0 ;
42.   varmax := 0 ;
43.   proglenmax := 400 ;
44. end ;
45. function TGeneProg.Run( prog : string ) : string ;
46. // calc output of formula
47. // when iligal calc result := 'error'
48. // 21-12-2017 : version 0.1 : result is inner list
49. var
50.   start , einde : integer ;
51.   temp : string ;
52.   a , b , ab : double ;
53.   q : TStringArray ;
54. begin
55.   einde := find( prog , ']' , 0 ) ;
56.   start := einde ;
57.   while prog[start] <> '[' do
58.     start := start - 1 ;
59.   temp := LeftStr( prog , einde ) ;
60.   temp := RightStr( temp , length( temp ) - start ) ;
61.   Result :=  temp ;
62. end ;
63.  
64. function find( const a : string ; const b : char ; start : integer ) : integer ;
65.  
66. var
67.   i : integer ;
68. begin
69.   i := start ;
70.   while ( a[i] <> b ) and ( i < length( a ) ) do
71.     i := i + 1 ;
72.   if i < length( a ) then
73.     Result := i
74.   else
75.     Result := -1 ;
76. end ;
77.  
78. {
79. var
80.   ADD , SUB , DIVi , MUL , SQR , LETTERS : string ;
81.  
82. begin
83.   GP := GeneProg.create ;
84.   ADD := '[ + # # ]' ;
85.   SUB := '[ - # # ]' ;
86.   DIVi := '[ / # # ]' ;
87.   MUL := '[ * # # ]' ;
88.   SQR := '[ sqr # # ]' ;
89.   LETTERS := 'abcdefgh' ;   }
90. end.
91.