tree and tent puzle solve try

[bluatigro]

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
read px
for y = 0 to 8
  read p
  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 

[badidea]

I had a look, but your code is difficult to read (no comments and short cryptic variable names).

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]

@ badidea :
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
read px
''create tree farm
for y = 0 to 8
  read p
  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 

[badidea]

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]

@ badidea :
thank for help

update :
i added a neartent function
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
  read xx( x )
next x
''create tree farm
randomize timer
for y = 0 to 9
  read p
  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