AI : game : hexagon try

[bluatigro]

try at a game that learns

bad move's wil be removed

first step :
create al board's ans move's

error :
i do noit get the results i expect
also when in getMoves() dy = -dy


'' bluatigro 4 nov 2018
'' hexapawn :
'' a game whit 6 pawn's
'' on a 3 x 3 board
'' you can not move 2 ahead
'' you win when you got a pawn at the opesid side
'' or when the openent can not move
'' or has no pawn's left

dim p( 8 ) , board$( 200 ) , move$( 200 ) , wz$( 2 )
global black , white , empty
black = 1
white = 0
empty = 2
wz$( white ) = "W"
wz$( black ) = "Z"
wz$( empty ) = "."
board$( 0 ) = "ZZZ...WWW"
global tel : tel = 1


print board$( 0 )
print getMove$( board$( 0 ) , white )
print do1move$( board$( 0 ) , "63" )
end
function index( x , y )
 index = x * 3 + y
end function
function save( x , y )
 save = x >= 0 and x <= 2 and y >= 0 and y <= 2
end function
function getMove$( q$ , kl )
 if kl = white then
   dy = -1
 else
   dy = 1
 end if
 for x = 0 to 2
   for y = 0 to 2
     if save( x , y + dy ) then
       if char$( q$ , x , y ) = wz$( kl ) _
       and char$( q$ , x , y + dy ) = wz$( empty ) then
         uit$ = uit$ + str$( index( x , y ) )
         uit$ = uit$ + str$( index( x , y + dy ) ) + " "
       end if
     end if
     if save( x + 1 , y + dy ) then
       if char$( q$ , x , y ) = wz$( kl ) _
       and char$( q$ , x + 1 , y + dy ) = wz$( 1 - kl ) then
         uit$ = uit$ + str$( index( x , y ) )
         uit$ = uit$ + str$( index( x + 1 , y + dy ) ) + " "
       end if
     end if
     if save( x - 1 , y + dy ) then
       if char$( q$ , x , y ) = wz$( kl ) _
       and char$( q$ , x - 1, y + dy ) = wz$( 1 - kl ) then
         uit$ = uit$ + str$( index( x , y ) )
         uit$ = uit$ + str$( index( x - 1 , y + dy ) ) + " "
       end if
     end if
   next y
 next x
 if uit$ = "" then uit$ = "lost"
 getMove$ = uit$
end function
function do1move$( q$ , z$ )
 a = val( left$( z$ , 1 ) )   '' from
 b = val( right$( z$ , 1 ) )  '' to
 f$ = mid$( q$ , a + 1 , 1 )  '' take piece
 l$ = left$( q$ , b - 1 )
 r$ = right$( q$ , 9 - b )
 t$ = l$ + f$ + r$            '' move piece to new spot
 l$ = left$( t$ , a - 1 )
 r$ = right$( t$ , 9 - a )
 do1move$ = l$ + "." + r$     '' make old spot empty
end function
function char$( q$ , x , y )
 char$ = mid$( q$ , index( x , y ) + 1 , 1 )
end function


[bluatigro]

update :
try at next code

error :
sub drawboard is nor good [ i think ]



'' bluatigro 4 nov 2018
'' hexapawn :
'' a game whit 6 pawn's
'' on a 3 x 3 board
'' you can not move 2 ahead
'' you win when you got a pawn at the opesid side
'' or when the openent can not move
'' or has no pawn's left

dim board$( 200 ) , move$( 200 ) , wz$( 1 ) , turn( 200 )
dim memboard$( 9 ) , memmove$( 9 )
global black , white , now$ , movetel
global humanno , pcno , player
black = 1
white = 0
humanno = 0
pcno = 1

wz$( white ) = "O"
wz$( black ) = "X"
board$( 0 ) = "XXX...OOO"


print board$( 0 )
print getMove$( board$( 0 ) , white )
print do1move$( board$( 0 ) , "63" )
print removemove$( "01 23 45 67 " , "23" )
call drawboard
end
sub newgame
 movetel = 0
 now$ = board$( 0 )
[new]
 print "Welkome by hexapawn ."
 print "Try to move your pieces so that :"
 print "they move like pawn's ."
 print "but whitout 2 cel's in 1 move ."
 print "object of the game :"
 print "get 1 pawn @ the oter side ."
 print "or block your oponent ."
 print "you [ O ] - AI [ X ] ."
 input "[ push return ] " ; in$
 i = int( val( in$ ) )
 now$ = board$( 0 )
 while q$ <> "lost" and q$ <> "won"
   if player = humanno then
     q$ = human$( kl )
     if q$ <> "lost" then
       if storemove$( q$ ) = "won" then q$ = "won"
     end if
   else
     q$ = AI$( kl )
     if q$ <> "lost" then
       if storemove$( q$ ) = "won" then q$ = "won"
     end if
   end if
   player = 1 - player
 wend
 if ( movetel mod 2 = 1 ) _
 xor ( q$ = "lost" ) then
   for i = 1 to 7 step 2
     board$( i ) = removemove$( memboard$( i ) _
                              , memmove$( i ) )
   next i
 end if
end sub
function AI$( kl )
 q$ = getMove$( nu$ , kl )
 if q$ = "lost" then
   uit$ = "lost"
 else
   i = 1
   while word$( q$ , i ) <> ""
     i = i + 1
   wend
   dice = int( rnd(0) * ( i - 1 ) + 1 )
   uit$ = word$( q$ , dice )
 end if
 AI$ = uit$
end function
function human$( kl )
 q$ = getMove$( nu$ , kl )
 if q$ = "lost" then
   uit$ = "lost"
 else
[fout]
   call drawboard
   print
   print "What is your move ?"
   print "Type a numbver of 2 digit's ."
   input "Number > " ; in$
   if len( in$ ) <> 2 then
     print "ERROR : 2 digit's please !!"
     goto [fout]
   end if
   if not( instr( q$ , in$ ) ) then
     print "ERROR : iligal move !!"
     goto [fout]
   end if
   uit$ = in$
 end if
 human$ = uit$
end function
sub drawboard
 print
 for y = 0 to 2
   for x = 0 to 2
     print index( x , y ) ; " " ; char$( now$ , x , y ) ; "   " ;
   next x
   print
 next y
 print
end sub
function storemove$( z$ )
 memmove$( movetel ) = z$
 now$ = do1move$( now$ , z$ )
 memboard$( movetel ) = now$
 storemove$ = now$
end function
function index( x , y )
 index = x * 3 + y
end function
function save( x , y )
 save = x >= 0 and x <= 2 and y >= 0 and y <= 2
end function
function getMove$( q$ , kl )
 if kl = white then
   dy = -1
 else
   dy = 1
 end if
 for x = 0 to 2
   for y = 0 to 2
     if save( x , y + dy ) then
       if char$( q$ , x , y ) = wz$( kl ) _
       and char$( q$ , x , y + dy ) = "." then
         uit$ = uit$ + str$( index( x , y ) )
         uit$ = uit$ + str$( index( x , y + dy ) ) + " "
       end if
     end if
     if save( x + 1 , y + dy ) then
       if char$( q$ , x , y ) = wz$( kl ) _
       and char$( q$ , x + 1 , y + dy ) = wz$( 1 - kl ) then
         uit$ = uit$ + str$( index( x , y ) )
         uit$ = uit$ + str$( index( x + 1 , y + dy ) ) + " "
       end if
     end if
     if save( x - 1 , y + dy ) then
       if char$( q$ , x , y ) = wz$( kl ) _
       and char$( q$ , x - 1, y + dy ) = wz$( 1 - kl ) then
         uit$ = uit$ + str$( index( x , y ) )
         uit$ = uit$ + str$( index( x - 1 , y + dy ) ) + " "
       end if
     end if
   next y
 next x
 if uit$ = "" then uit$ = "lost"
 getMove$ = uit$
end function
function do1move$( q$ , z$ )
 a = val( left$( z$ , 1 ) )   '' from
 b = val( right$( z$ , 1 ) )  '' to
 f$ = mid$( q$ , a + 1 , 1 )  '' take piece
 l$ = left$( q$ , b - 1 )
 r$ = right$( q$ , 9 - b )
 t$ = l$ + f$ + r$            '' move piece to new spot
 l$ = left$( t$ , a - 1 )
 r$ = right$( t$ , 9 - a )
 if instr( "012678" , str$( b ) ) then
   uit$ = "won"
 else
 uit$ = l$ + "." + r$     '' make old spot empty
 end if
 do1move$ = uit$
end function
function char$( q$ , x , y )
 char$ = mid$( q$ , index( x , y ) + 1 , 1 )
end function
function exsist( q$ )
 i = 0
 while q$ <> board$( i ) and board$( i ) <> ""
   i = i + 1
 wend
 if q$ = board$( i ) then
   uit = i - 1
 else
   uit = -1
 end if
 exsist = uit
end function
sub createGameTree
 tel = 0
 kl = white
 q$ = getMove$( board$( 0 ) , white )
 i = 1
 kl = white
 while word$( q$ , i ) <> ""
   z$ = word$( q$ , i )
   a$ = do1move$( board$( 0 ) , z$ )
 wend
end sub
function leaf$( in$ , kl , tel )
 if exsist( in$ ) = -1 then
'' board does not exsist so create one
   tel = tel + 1
 end if
 board$( tel ) = in$
 turn( tel ) = kl
 q$ = getMove$( in$ , kl )
 i = 1
 if q$ = "lost" then
'' if board has no move's this game is lost
   uit$ = "lost"
 else
'' if board has move's play them al
   while word$( q$ , i ) <> "" _
   and uit$ <> "won" and uit$ <> "lost"
'' get 1 move from arraylist
     z$ = word$( q$ , i )
'' play move
     u$ = do1move$( in$ , z$ )
     if u$ = "won" then
'' if won end game
       uit$ = "won"
     else
'' if not won play one move deeper
       uit$ = leaf$( u$ , 1 - kl , tel )
     end if
     i = i + 1
   wend
 end if
 leaf$ = uit$
end function
sub createMemory
 i = 0
 while board$( i ) <> ""
   move$( i ) = getMove$( board$( i ) , turn( i ) )
   i = i + 1
 wend
end sub
function removemove$( q$ , z$ )
 p = instr( q$ , z$ )
 l$ = left$( q$ , p - 1 )
 r$ = right$( q$ , len( q$ ) - 3 - p + 1 )
 removemove$ = l$ + r$
end function