## tree and tent puzle solve try

General FreeBASIC programming questions.
bluatigro
Posts: 597
Joined: Apr 25, 2012 10:35
Location: netherlands

### tree and tent puzle solve try

error :
my tree's [ 'T' ] are not visable in the 'solotion'

i dont think this is the solution my code gives

Code: Select all

''bluatigro 24 jul 2018
''tree and tent puzle.

''on a farm there are some tree's
''every tree has a tent near
''tent's do not near tent's also diagonal
''the number's at the end of a
''colom or row are the number
''of tent's in that row or colom

function in( no as integer , x as integer , y as integer ) as integer
return no * 100 + x * 9 + y
end function

dim shared as integer gen( in( 200 , 10 , 8 ) ) , t( 10 , 8 )
dim shared as integer ryy( 200 ) , fout( 200 )
dim shared as integer xx( 10 ) , yy( 8 )

const as integer notent = 0
const as integer empty = 1
const as integer tent = 2
const as integer tree = 3

function neartree( x as integer , y as integer ) as integer
dim as integer uit = 0
if x + 1 <= 10 then
if t( x + 1 , y ) = tree then uit = 1
end if
if x - 1 >= 1 then
if t( x - 1 , y ) = tree then uit = 1
end if
if y + 1 <= 8 then
if t( x , y + 1 ) = tree then uit = 1
end if
if y - 1 >= 0 then
if t( x , y - 1 ) = tree then uit = 1
end if
return uit
end function
function fitness( no as integer ) as integer
dim as integer uit = 0 , tel , x , y
for x = 1 to 10
tel = 0
for y = 0 to 8
if gen( in( no , x , y ) ) = tent then
tel = tel + 1
end if
next y
uit = uit + abs( tel - xx( x ) )
next x
for y = 0 to 8
tel = 0
for x = 1 to 10
if gen( in( no , x , y ) ) = tent then
tel = tel + 1
end if
next x
uit = uit + abs( tel - yy( y ) )
next y
return uit
end function
function rnd_int( l as integer , h as integer ) as integer
return int( rnd * ( h - l + 1 ) + l )
end function
sub crossover( a as integer , b as integer , uit as integer )
dim as integer x , y , z
for x = 1 to 10
for y = 0 to 8
if rnd < .5 then
z = gen( in( a , x , y ) )
else
z = gen( in( b , x , y ) )
end if
gen( in( uit , x , y ) ) = z
next y
next x
end sub
sub mutate( no as integer )
dim as integer x , y
x = rnd_int( 1 , 10 )
y = rnd_int( 0 , 8 )
while gen( in( no , x , y ) ) = tree _
or gen( in( no , x , y ) ) = notent
x = rnd_int( 1 , 10 )
y = rnd_int( 0 , 8 )
wend
if gen( in( no , x , y ) ) = empty then
gen( in( no , x , y ) ) = tent
else
gen( in( no , x , y ) ) = empty
end if
end sub

dim as integer x , y , no
dim as string p , px
for y = 0 to 8
for x = 1 to 10
if mid( p , x , 1 ) = "T" then
t( x , y ) = tree
end if
next x
yy( y ) = val( right( p , 1 ) )
next y
for x = 1 to 10
xx( x ) = val( mid( px , x , 1 ) )
next x
for x = 1 to 10
for y = 0 to 8
if neartree( x , y ) then
t( x , y ) = empty
end if
next y
next x
restore
data " 2 2 1 2 3 2 2 1 3 2"
data "T T   T   2"
data "     T   T2"
data "          1"
data "  T T     3"
data "        TT1"
data "          2"
data "  T T T  T1"
data "  T  T    3"
data "      T T 1"
data " T   T   T4"
for no = 0 to 200
for x = 1 to 10
for y = 0 to 8
if t( x , y ) = empty then
if rnd < .5 then
gen( in( no , x , y ) ) = tent
end if
end if
next y
next x
next no
for no = 0 to 200
ryy( no ) = no
next no

dim as integer done = 0 , a , b
dim as integer tel = 0 , h , l , help
while tel < 1000 and fitness( ryy( 0 ) ) <> 0
tel += 1
for no = 0 to 200
fout( no ) = fitness( no )
next no
for h = 1 to 200
for l = 0 to h - 1
if fout( ryy( h ) ) < fout( ryy( l ) ) then
help = ryy( h )
ryy( h ) = ryy( l )
ryy( l ) = help
end if
next l
next h
for no = 20 to 200
a = rnd_int( 0 , 20 )
b = rnd_int( 0 , 20 )
crossover ryy( a ) , ryy( b ) , ryy( no )
if rnd < .1 then
mutate ryy( no )
end if
next no
print tel , fout( ryy( 0 ) )
wend
for y = 0 to 8
print " " ;
for x = 1 to 10
select case gen( in( ryy(0) , x , y ) )
case tree
print "T " ;
case tent
print "A " ;
case empty
print "  " ;
case else
print ". " ;
end select
next x
print yy( y )
next

print
print px
print "[ game over ]"
sleep

Posts: 1545
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: tree and tent puzle solve try

Also, there must be a better solving technique then yours. If I understand correct, you create 200 camping fields with randomly placed tents. These random fields are then evaluated and more random action occurs, which in the end should lead to a solution?
bluatigro
Posts: 597
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: tree and tent puzle solve try

i used a genetic algoritm

GA how :
1 : create some random chromoson's
2 : calc error
3 : sort chromoson's on error
4 : best create kid's
5 : some kid's are mutated
6 : if best.error > wanted and generation < max goto 2

i hope that it is clear now
i added some REM so you can see what code does what

i almost Always use short varname's
i got that out of the time i was using a c64
i have dislexya :
i can not remeber how i wrote stuf
if i use long names

Code: Select all

''bluatigro 24 jul 2018
''tree and tent puzle.

''on a farm there are some tree's
''every tree has a tent near
''tent's do not near tent's also diagonal
''the number's at the end of a
''colom or row are the number
''of tent's in that row or colom

function in( no as integer , x as integer , y as integer ) as integer
return no * 100 + x * 9 + y
end function

dim shared as integer gen( in( 200 , 10 , 8 ) ) , t( 10 , 8 )
dim shared as integer ryy( 200 ) , fout( 200 )
dim shared as integer xx( 10 ) , yy( 8 )

const as integer notent = 0
const as integer empty = 1
const as integer tent = 2
const as integer tree = 3

function neartree( x as integer , y as integer ) as integer
''look if x,y is near tree
dim as integer uit = 0
if x + 1 <= 10 then
if t( x + 1 , y ) = tree then uit = 1
end if
if x - 1 >= 1 then
if t( x - 1 , y ) = tree then uit = 1
end if
if y + 1 <= 8 then
if t( x , y + 1 ) = tree then uit = 1
end if
if y - 1 >= 0 then
if t( x , y - 1 ) = tree then uit = 1
end if
return uit
end function
function fitness( no as integer ) as integer
''calc total error of chromoson no
dim as integer uit = 0 , tel , x , y
for x = 1 to 10
tel = 0
for y = 0 to 8
if gen( in( no , x , y ) ) = tent then
tel = tel + 1
end if
next y
uit = uit + abs( tel - xx( x ) )
next x
for y = 0 to 8
tel = 0
for x = 1 to 10
if gen( in( no , x , y ) ) = tent then
tel = tel + 1
end if
next x
uit = uit + abs( tel - yy( y ) )
next y
return uit
end function
function rnd_int( l as integer , h as integer ) as integer
return int( rnd * ( h - l + 1 ) + l )
end function
sub crossover( a as integer , b as integer , uit as integer )
''mix 2 chromosons into a new one
dim as integer x , y , z
for x = 1 to 10
for y = 0 to 8
if rnd < .5 then
z = gen( in( a , x , y ) )
else
z = gen( in( b , x , y ) )
end if
gen( in( uit , x , y ) ) = z
next y
next x
end sub
sub mutate( no as integer )
''mutate chromoson no
dim as integer x , y
x = rnd_int( 1 , 10 )
y = rnd_int( 0 , 8 )
while gen( in( no , x , y ) ) = tree _
or gen( in( no , x , y ) ) = notent
x = rnd_int( 1 , 10 )
y = rnd_int( 0 , 8 )
wend
if gen( in( no , x , y ) ) = empty then
gen( in( no , x , y ) ) = tent
else
gen( in( no , x , y ) ) = empty
end if
end sub
''init all stuf
dim as integer x , y , no
dim as string p , px
''create tree farm
for y = 0 to 8
for x = 1 to 10
if mid( p , x , 1 ) = "T" then
t( x , y ) = tree
end if
next x
yy( y ) = val( right( p , 1 ) )
next y
for x = 1 to 10
xx( x ) = val( mid( px , x , 1 ) )
next x
''look for near tree spot's
for x = 1 to 10
for y = 0 to 8
if neartree( x , y ) then
t( x , y ) = empty
end if
next y
next x
restore
data " 2 2 1 2 3 2 2 1 3 2"
data "T T   T   2"
data "     T   T2"
data "          1"
data "  T T     3"
data "        TT1"
data "          2"
data "  T T T  T1"
data "  T  T    3"
data "      T T 1"
data " T   T   T4"
''create random chromosons
for no = 0 to 200
for x = 1 to 10
for y = 0 to 8
if t( x , y ) = empty then
''only if pace is near tree
''fil +-half whit tree
if rnd < .5 then
gen( in( no , x , y ) ) = tent
end if
end if
next y
next x
next no
for no = 0 to 200
ryy( no ) = no
next no

dim as integer done = 0 , a , b
dim as integer tel = 0 , h , l , help
while tel < 1000 and fitness( ryy( 0 ) ) <> 0
''let chromoson's live
tel += 1
for no = 0 to 200
''store error of chromoson
fout( no ) = fitness( no )
next no
''sort chromoson's on error
for h = 1 to 200
for l = 0 to h - 1
if fout( ryy( h ) ) < fout( ryy( l ) ) then
help = ryy( h )
ryy( h ) = ryy( l )
ryy( l ) = help
end if
next l
next h
''create kid chromoson's
for no = 20 to 200
a = rnd_int( 0 , 20 )
b = rnd_int( 0 , 20 )
crossover ryy( a ) , ryy( b ) , ryy( no )
if rnd < .1 then
''mutate sometimes the kid
mutate ryy( no )
end if
next no
print tel , fout( ryy( 0 ) )
wend
''print best farm
for y = 0 to 8
print " " ;
for x = 1 to 10
select case gen( in( ryy(0) , x , y ) )
case tree
print "T " ;
case tent
print "A " ;
case empty
print "  " ;
case else
print ". " ;
end select
next x
print yy( y )
next

print
print px
print "[ game over ]"
sleep

Posts: 1545
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: tree and tent puzle solve try

Too hot to think today

Your field is 10 x 10, but you loop y form 0 to 8 (9 in total). Is that correct? I would expect both x and y from 0 to 9.

Your neartree function should also check that no tree is actually on place x,y, otherwise a tree can be deleted. Camping in a tree is not allowed.

At reading tree farm: xx( x ) = val( mid( px , x , 1 ) ) is not correct. Remove spaces in the first data row, or change this line of code.

At ''create random chromosons", you never copy the trees from array t ( ) to gen ( ). Something only happens when t (x, y) = empty. Something like this should be added:

Code: Select all

...
else
gen( in( no , x , y ) ) = t( x , y )
...

I hope this helps.
bluatigro
Posts: 597
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: tree and tent puzle solve try

thank for help

update :
it checks if a tent is near a tent
and if so fitness adds a errorpoint

Code: Select all

''bluatigro 24 jul 2018
''tree and tent puzle.

''on a farm there are some tree's
''every tree has a tent near
''tent's do not near tent's also diagonal
''the number's at the end of a
''colom or row are the number
''of tent's in that row or colom

function in( no as integer , x as integer , y as integer ) as integer
return no * 100 + x * 9 + y
end function

dim shared as integer gen( in( 200 , 10 , 8 ) ) , t( 10 , 8 )
dim shared as integer ryy( 200 ) , fout( 200 )
dim shared as integer xx( 10 ) , yy( 8 )

const as integer notent = 0
const as integer empty = 1
const as integer tent = 2
const as integer tree = 3

function neartree( x as integer , y as integer ) as integer
''look if x,y is near tree
dim as integer uit = 0
if x + 1 <= 10 then
if t( x + 1 , y ) = tree then uit = 1
end if
if x - 1 >= 1 then
if t( x - 1 , y ) = tree then uit = 1
end if
if y + 1 <= 9 then
if t( x , y + 1 ) = tree then uit = 1
end if
if y - 1 >= 0 then
if t( x , y - 1 ) = tree then uit = 1
end if
if t( x , y ) = tree then uit = 0
return uit
end function
function neartent( no as integer , x as integer , y as integer ) as integer
dim as integer uit = 0
if x + 1 <= 10 and y + 1 <= 9 then
if gen( in( no , x + 1 , y + 1 ) ) = tent then uit = 1
end if
if x + 1 <= 10 then
if gen( in( no , x + 1 , y ) ) = tent then uit = 1
end if
if x + 1 <= 10 and y - 1 >= 0 then
if gen( in( no , x + 1 , y - 1 ) ) = tent then uit = 1
end if
if y - 1 >= 0 then
if gen( in( no , x , y - 1 ) ) = tent then uit = 1
end if
if x - 1 >= 0 and y - 1 >= 0 then
if gen( in( no , x - 1 , y - 1 ) ) = tent then uit = 1
end if
if x - 1 >= 0 then
if gen( in( no , x - 1 , y ) ) = tent then uit = 1
end if
if x - 1 >= 0 and y + 1 >= 9 then
if gen( in( no , x + 1 , y + 1 ) ) = tent then uit = 1
end if
if y + 1 <= 9 then
if gen( in( no , x , y + 1 ) ) = tent then uit = 1
end if
return uit
end function
function fitness( no as integer ) as integer
''calc total error of chromoson no
dim as integer uit = 0 , tel , tel2 , x , y
for x = 1 to 10
tel = 0
for y = 0 to 8
if gen( in( no , x , y ) ) = tent then
tel = tel + 1
if neartent( no , x , y ) then tel2 = tel2 + 1
end if
next y
uit = uit + abs( tel - xx( x ) )
next x
for y = 0 to 8
tel = 0
for x = 1 to 10
if gen( in( no , x , y ) ) = tent then
tel = tel + 1
if neartent( no , x , y ) then tel2 = tel2 + 1
end if
next x
uit = uit + abs( tel - yy( y ) )
next y
return uit + tel2
end function
function rnd_int( l as integer , h as integer ) as integer
return int( rnd * ( h - l + 1 ) + l )
end function
sub crossover( a as integer , b as integer , uit as integer )
''mix 2 chromosons into a new one
dim as integer x , y , z
for x = 1 to 10
for y = 0 to 8
if rnd < .5 then
z = gen( in( a , x , y ) )
else
z = gen( in( b , x , y ) )
end if
gen( in( uit , x , y ) ) = z
next y
next x
end sub
sub mutate( no as integer )
''mutate chromoson no
dim as integer x , y
x = rnd_int( 1 , 10 )
y = rnd_int( 0 , 9 )
while t( x , y ) = tree _
or t( x , y ) = notent
x = rnd_int( 1 , 10 )
y = rnd_int( 0 , 9 )
wend
if gen( in( no , x , y ) ) = empty then
gen( in( no , x , y ) ) = tent
else
gen( in( no , x , y ) ) = empty
end if
end sub
''init all stuf
dim as integer x , y , no
dim as string p , px
for x = 1 to 10
next x
''create tree farm
randomize timer
for y = 0 to 9
for x = 1 to 10
if mid( p , x , 1 ) = "T" then
t( x , y ) = tree
end if
next x
yy( y ) = val( right( p , 1 ) )
next y
''look for near tree spot's
for x = 1 to 10
for y = 0 to 9
if neartree( x , y ) then
t( x , y ) = empty
end if
next y
next x
restore
data 2 , 2 , 1 , 2 , 3 , 2 , 2 , 1 , 3 , 2
data "T T   T   2"
data "     T   T2"
data "          1"
data "  T T     3"
data "        TT1"
data "          2"
data "  T T T  T1"
data "  T  T    3"
data "      T T 1"
data " T   T   T4"
''create random chromosons
for no = 0 to 200
for x = 1 to 10
for y = 0 to 9
if t( x , y ) = empty then
''only if place is near tree
''fil +-half whit tent
''or leave it empty
if rnd < .5 then
gen( in( no , x , y ) ) = tent
else
gen( in( no , x , y ) ) = empty
end if
end if
if t( x , y ) = tree then
gen( in( no , x , y ) ) = tree
end if
next y
next x
next no
for no = 0 to 200
ryy( no ) = no
next no

dim as integer done = 0 , a , b
dim as integer tel = 0 , h , l , help
while tel < 2000 and fitness( ryy( 0 ) ) <> 0
''let chromoson's live
tel += 1
for no = 0 to 200
''store error of chromoson
fout( no ) = fitness( no )
next no
''sort chromoson's on error
for h = 1 to 200
for l = 0 to h - 1
if fout( ryy( h ) ) < fout( ryy( l ) ) then
help = ryy( h )
ryy( h ) = ryy( l )
ryy( l ) = help
end if
next l
next h
''create kid chromoson's
for no = 20 to 200
a = rnd_int( 0 , 20 )
b = rnd_int( 0 , 20 )
crossover ryy( a ) , ryy( b ) , ryy( no )
if rnd < .1 then
''mutate sometimes the kid
mutate ryy( no )
end if
next no
if tel mod 100 = 0 then print tel , fout( ryy( 0 ) )
wend
''print best farm
for y = 0 to 9
print " " ;
for x = 1 to 10
select case gen( in( ryy(0) , x , y ) )
case tree
print "T " ;
case tent
print "^ " ;
case empty
print "_ " ;
case else
print ". " ;
end select
next x
print yy( y )
next

print
for x = 1 to 10
print xx( x ) ;
next x
print
print "[ game over ]"
sleep