Author |
Topic: Cartician Genetic Programming (Read 303 times) |
|
bluatigro
Full Member
member is offline
Gender: 
Posts: 111
|
 |
Cartician Genetic Programming
« Thread started on: Mar 24th, 2016, 09:56am » |
|
this is a try at CGP
CGP wat :
creating a grid of functions to calculate
this example trys to find the pytagoras formula
error :
no printing
code frezes
Code:
global inputmax , layers , ftel , infinity
inputmax = 2
layers = 3
infinity = 1e13
dim a( in( 200 , layers , inputmax ) )
dim b( in( 200 , layers , inputmax ) )
dim mem( in( 200 , layers , inputmax ) )
dim f$( in( 200 , layers , inputmax ) )
dim fout( 200 )
dim q$( 10 )
ftel = 0
while a$ <> "a"
read a$
q$( ftel ) = a$
ftel = ftel + 1
wend
data "+","-","/","*","sqr","a"
for i = 0 to 200 * layers * inputmax
a( i ) = int( rnd( 0 ) * inputmax )
b( i ) = int( rnd( 0 ) * inputmax )
f$( i ) = q$( int( rnd( 0 ) * ftel ) )
next i
for gen = 0 to 25
for i = 0 to 200
fout( i ) = 0
for x = -10 to 10
for y = -10 to 10
call calc i
fout( i ) = fout( i ) _
+ abs( uit( i , 0 ) - sqr(x^2+y^2) ) ^ 2
next y
next x
next i
low = infinity
for i = 0 to 200
if fout( i ) < low then
low = fout( i )
best = i
end if
next i
print "generation : " ; gen
for layer = 0 to layers
for in = 0 to inputmax
print tostr$( in( best , layers , in ) ) ;
next in
print
next layer
print "error : " ; fout( best )
for i = 0 to 200 * layers * inputmax
a( i ) = a( best )
b( i ) = b( best )
f$( i ) = f$( best )
next i
for i = 1 to 200
call mutate i
next i
next gen
end
function tostr$( no )
tostr$ = "[ " + f$( no ) + " " ; a( no ) ; " " ; b( no ) ; " ] "
end function
function in( a , b , c )
in = a * layers * inputmax + b * inputmax + c
end function
sub mutate no
i = int( rnd( 0 ) * layers )
j = int( rnd( 0 ) * inputmax )
select case int( rnd( 0 ) * 3 )
case 0
a( in( no , i , j ) ) = int( rnd( 0 ) * inputmax )
case 1
b( in( no , i , j ) ) = int( rnd( 0 ) * inputmax )
case else
f$( in( no , i , j ) ) = q$( int( rnd( 0 ) * ftel ) )
end select
end sub
sub calc no
for layer = 1 to layers
for in = 0 to inputmax
aa = mem( in( no , layer - 1 , a( in( no , layer , in ) ) ) )
bb = mem( in( no , layer - 1 , b( in( no , layer , in ) ) ) )
if aa >= infinity or bb >= infinity then
mem( in( no , layer , in ) ) = infinity
end if
select case f$( in( no , layer , in ) )
case "+"
ab = a + b
case "-"
ab = a - b
case "/"
if b = 0 then
ab = infinity
else
ab = a / b
end if
case "*"
ab = a * b
case "sqr"
if a < 0 then
ab = infinity
else
ab = sqr( a )
end if
case "a"
ab = a
case else
ab = infinity
end select
mem( in( no , layer , in ) ) = ab
next in
next layer
end sub
function uit( no , i )
uit = mem( in( no , layers , i ) )
end function
|
|
 Logged
|
|
|
|
Richard Russell
Administrator
member is offline
Posts: 1348
|
|
Re: Cartician Genetic Programming
« Reply #1 on: Mar 24th, 2016, 12:48pm » |
|
on Mar 24th, 2016, 09:56am, bluatigro wrote:
It's slow, but it does print eventually (probably quicker in LBB than in JB/LB):
Code:generation : 0
[ - 0 0 ] [ + 0 1 ] [ * 0 0 ]
[ - 0 0 ] [ + 0 1 ] [ * 0 0 ]
[ - 0 0 ] [ + 0 1 ] [ * 0 0 ]
[ - 0 0 ] [ + 0 1 ] [ * 0 0 ]
error : 32340
generation : 1
[ + 1 1 ] [ + 1 1 ] [ + 1 1 ]
[ + 1 1 ] [ + 1 1 ] [ + 1 1 ]
[ + 1 1 ] [ + 1 1 ] [ + 1 1 ]
[ + 1 1 ] [ + 1 1 ] [ + 1 1 ]
error : 32340
generation : 2
[ + 1 1 ] [ + 1 1 ] [ / 1 1 ]
[ + 1 1 ] [ + 1 1 ] [ / 1 1 ]
[ + 1 1 ] [ + 1 1 ] [ / 1 1 ]
[ + 1 1 ] [ + 1 1 ] [ / 1 1 ]
error : 32340
generation : 3
[ + 1 1 ] [ + 1 1 ] [ + 1 1 ]
[ + 1 1 ] [ + 1 1 ] [ + 1 1 ]
[ + 1 1 ] [ + 1 1 ] [ + 1 1 ]
[ + 1 1 ] [ + 1 1 ] [ + 1 1 ]
error : 32340
Richard.
|
|
Logged
|
|
|
|
Richard Russell
Administrator
member is offline
Posts: 1348
|
|
Re: Cartician Genetic Programming
« Reply #2 on: Mar 24th, 2016, 2:54pm » |
|
on Mar 24th, 2016, 09:56am, bluatigro wrote:| this example trys to find the pytagoras formula |
|
The problem looks to be mainly a simple typo. If you change aa to a and bb to b:
Code: a = mem( in( no , layer - 1 , a( in( no , layer , in ) ) ) )
b = mem( in( no , layer - 1 , b( in( no , layer , in ) ) ) )
if a >= infinity or b >= infinity then
mem( in( no , layer , in ) ) = infinity
end if
it produces:
Code:generation : 0
[ + 0 0 ] [ - 0 1 ] [ - 0 1 ]
[ + 0 0 ] [ - 0 1 ] [ - 0 1 ]
[ + 0 0 ] [ - 0 1 ] [ - 0 1 ]
[ + 0 0 ] [ - 0 1 ] [ - 0 1 ]
error : 5736.90513
generation : 1
[ sqr 1 1 ] [ sqr 1 1 ] [ sqr 1 1 ]
[ sqr 1 1 ] [ sqr 1 1 ] [ sqr 1 1 ]
[ sqr 1 1 ] [ sqr 1 1 ] [ sqr 1 1 ]
[ sqr 1 1 ] [ sqr 1 1 ] [ sqr 1 1 ]
error : 4961.57591
generation : 2
[ sqr 1 1 ] [ sqr 1 1 ] [ sqr 1 1 ]
[ sqr 1 1 ] [ sqr 1 1 ] [ sqr 1 1 ]
[ sqr 1 1 ] [ sqr 1 1 ] [ sqr 1 1 ]
[ sqr 1 1 ] [ sqr 1 1 ] [ sqr 1 1 ]
error : 4961.57591
Richard.
|
|
Logged
|
|
|
|
bluatigro
Full Member
member is offline
Gender:
Posts: 111
|
|
Re: Cartician Genetic Programming
« Reply #3 on: Mar 25th, 2016, 11:37am » |
|
@richard :
i spotted that to [ aa bb ]
update :
aa bb to a b
error :
al layers are the same
so mutate does not wat i want
Code:
global inputmax , layers , ftel , infinity
inputmax = 2
layers = 3
infinity = 1e13
dim a( in( 200 , layers , inputmax ) )
dim b( in( 200 , layers , inputmax ) )
dim mem( in( 200 , layers , inputmax ) )
dim f$( in( 200 , layers , inputmax ) )
dim fout( 200 )
dim q$( 10 )
ftel = 0
while a$ <> "a"
read a$
q$( ftel ) = a$
ftel = ftel + 1
wend
data "+","-","/","*","sqr","a"
for i = 0 to 200 * layers * inputmax
a( i ) = int( rnd( 0 ) * inputmax )
b( i ) = int( rnd( 0 ) * inputmax )
f$( i ) = q$( int( rnd( 0 ) * ftel ) )
next i
for gen = 0 to 25
for i = 0 to 200
fout( i ) = 0
for x = -10 to 10
for y = -10 to 10
call calc i
fout( i ) = fout( i ) _
+ abs( uit( i , 0 ) - sqr(x^2+y^2) ) ^ 2
next y
next x
next i
low = infinity
for i = 0 to 200
if fout( i ) < low then
low = fout( i )
best = i
end if
next i
print "generation : " ; gen
for layer = 0 to layers
for in = 0 to inputmax
print tostr$( in( best , layers , in ) ) ;
next in
print
next layer
print "error : " ; fout( best )
for i = 0 to 200 * layers * inputmax
a( i ) = a( best )
b( i ) = b( best )
f$( i ) = f$( best )
next i
for i = 1 to 200
call mutate i
next i
next gen
end
function tostr$( no )
tostr$ = "[ " + f$( no ) + " " ; a( no ) ; " " ; b( no ) ; " ] "
end function
function in( a , b , c )
in = a * layers * inputmax + b * inputmax + c
end function
sub mutate no
i = int( rnd( 0 ) * layers )
j = int( rnd( 0 ) * inputmax )
select case int( rnd( 0 ) * 3 )
case 0
a( in( no , i , j ) ) = int( rnd( 0 ) * inputmax )
case 1
b( in( no , i , j ) ) = int( rnd( 0 ) * inputmax )
case else
f$( in( no , i , j ) ) = q$( int( rnd( 0 ) * ftel ) )
end select
end sub
sub calc no
for layer = 1 to layers
for in = 0 to inputmax
ina = a( in( no , layer , in ) )
inb = b( in( no , layer , in ) )
a = mem( in( no , layer - 1 , ina ) )
b = mem( in( no , layer - 1 , inb ) )
if a >= infinity or b >= infinity then
mem( in( no , layer , in ) ) = infinity
else
select case f$( in( no , layer , in ) )
case "+"
ab = a + b
case "-"
ab = a - b
case "/"
if b = 0 then
ab = infinity
else
ab = a / b
end if
case "*"
ab = a * b
case "sqr"
if a < 0 then
ab = infinity
else
ab = sqr( a )
end if
case "a"
ab = a
case else
ab = infinity
end select
mem( in( no , layer , in ) ) = ab
end if
next in
next layer
end sub
function uit( no , i )
uit = mem( in( no , layers , i ) )
end function
|
|
Logged
|
|
|
|
bluatigro
Full Member
member is offline
Gender:
Posts: 111
|
|
Re: Cartician Genetic Programming
« Reply #4 on: Mar 27th, 2016, 1:20pm » |
|
update :
input in layer 0 added
is this lerning ?
is fout getting smaler ?
if not why ?
Code:
global inputmax , layers , ftel , infinity
inputmax = 2
layers = 3
infinity = 1e13
dim a( in( 200 , layers , inputmax ) )
dim b( in( 200 , layers , inputmax ) )
dim mem( in( 200 , layers , inputmax ) )
dim f$( in( 200 , layers , inputmax ) )
dim fout( 200 )
dim q$( 10 )
ftel = 0
while a$ <> "a"
read a$
q$( ftel ) = a$
ftel = ftel + 1
wend
data "+" , "-" , "/" , "*" , "sqr" , "a"
for i = 0 to 200 * layers * inputmax
a( i ) = int( rnd( 0 ) * inputmax )
b( i ) = int( rnd( 0 ) * inputmax )
f$( i ) = q$( int( rnd( 0 ) * ftel ) )
next i
for gen = 0 to 25
for i = 0 to 200
fout( i ) = 0
for x = -10 to 10
for y = -10 to 10
mem( in( i , 0 , 0 ) ) = x
mem( in( i , 0 , 1 ) ) = y
call calc i
fout( i ) = fout( i ) _
+ abs( uit( i , 0 ) - sqr(x^2+y^2) ) ^ 2
next y
next x
next i
low = infinity
for i = 0 to 200
if fout( i ) < low then
low = fout( i )
best = i
end if
next i
print "generation : " ; gen
for layer = 0 to layers
for in = 0 to inputmax
print tostr$( in( best , layer , in ) ) ;
next in
print
next layer
print "error : " ; fout( best )
for i = 0 to 200 * layers * inputmax
a( i ) = a( best )
b( i ) = b( best )
f$( i ) = f$( best )
next i
for i = 1 to 200
call mutate i
next i
next gen
end
function tostr$( no )
tostr$ = "[ " + f$( no ) + " " _
; a( no ) ; " " ; b( no ) ; " ] "
end function
function in( a , b , c )
in = a * layers * inputmax + b * inputmax + c
end function
sub mutate no
i = int( rnd( 0 ) * layers )
j = int( rnd( 0 ) * inputmax )
select case int( rnd( 0 ) * 3 )
case 0
a( in( no , i , j ) ) = int( rnd( 0 ) * inputmax )
case 1
b( in( no , i , j ) ) = int( rnd( 0 ) * inputmax )
case else
f$( in( no , i , j ) ) = q$( int( rnd( 0 ) * ftel ) )
end select
end sub
sub calc no
for layer = 1 to layers
for in = 0 to inputmax
ina = a( in( no , layer , in ) )
inb = b( in( no , layer , in ) )
a = mem( in( no , layer - 1 , ina ) )
b = mem( in( no , layer - 1 , inb ) )
if a >= infinity or b >= infinity then
mem( in( no , layer , in ) ) = infinity
else
select case f$( in( no , layer , in ) )
case "+"
ab = a + b
case "-"
ab = a - b
case "/"
if b = 0 then
ab = infinity
else
ab = a / b
end if
case "*"
ab = a * b
case "sqr"
if a < 0 then
ab = infinity
else
ab = sqr( a )
end if
case "a"
ab = a
case else
ab = infinity
end select
mem( in( no , layer , in ) ) = ab
end if
next in
next layer
end sub
function uit( no , i )
uit = mem( in( no , layers , i ) )
end function
|
|
Logged
|
|
|
|
|
