Block world

[BasicCoder2]

@dafhi

In a another post by dafhi made this comment on my efforts at a NLP interface to a block world,

if you had the arm just randomly do stuff (different speeds that would change automatically), that'd provide another layer of entertainment

I have messed about with an even simpler block world. This included one with a random movement of blocks.

Code: Select all

const wWIDTH = 15
const wHEIGHT = 15

dim shared as integer world1(wWIDTH, wHEIGHT)

dim shared as integer armx,army,hold
dim as string k
dim as single clock
'dim shared as integer flag
dim shared as integer leftsensor,rightsensor,downsensor,upsensor
dim shared as integer srcx,srcy,dstx,dsty

armx = 0 'start position of arm
army = 0
hold = 0 '=1 if holding block

sub SetSensors()
  if hold = 0 then
    if world1(armx,army+1)<>0 then
      downsensor = 1
    else
      downsensor = 0
    end if
  else
    if world1(armx,army+2)<>0 or army = wHEIGHT-2 then
      downsensor = 1
    else
      downsensor = 0
    end if
  end if
  
  if army<1 then
    upsensor = 1
  else
    upsensor = 0
  end if
  
  'test left side
  leftsensor = 0
  for i as integer = 0 to army
    if world1(armx-1,i)<>0 then
      leftsensor = 1
    end if
  next i
  if hold = 1 then
    if world1(armx-1,army+1)<>0 then
      leftsensor = 1
    end if
  end if

  'test right side
  rightsensor = 0
  for i as integer = 0 to army
    if world1(armx+1,i)<>0 then
      rightsensor = 1
    end if
  next i
  if hold = 1 then
    if world1(armx+1,army+1)<>0 then
      rightsensor = 1
    end if
  end if
  
end sub


sub DrawArm()
  dim as integer x,y
  x = armx
  y = 0
  while y<>army and y < wHEIGHT-1
    line (x*20+10,y*20)-(x*20+10,y*20+18),15
    y = y + 1
  wend
  line (x*20+10,y*20)-(x*20+10,y*20+18),15
  if hold = 1 then
    LINE (x * 20 + 2, y * 20 + 10)-(x * 20 + 17, y * 20 + 18), 3, BF
  else
    LINE (x * 20 + 2, y * 20 + 10)-(x * 20 + 17, y * 20 + 18), 15, BF
  end if
end sub

sub DisplayWorld()
cls
DrawArm()
FOR y as integer = 0 TO wHEIGHT-1
  FOR x as integer = 0 TO wWIDTH-1
    IF world1(x, y) <> 0 THEN
      LINE (x * 20, y * 20)-(x * 20 + 18, y * 20 + 18), world1(x, y), BF
    END IF
  NEXT x
NEXT y
line (0,0)-(wWIDTH*20,wHEIGHT*20),15,b
locate 27,1
print "left=";leftsensor;" right=";rightsensor;" down=";downsensor;" up=";upsensor
print "hold=";hold;" army";army;
circle (srcx*20+10,srcy*20+10+20),7,15
circle (dstx*20+10,dsty*20+10),7,14
end sub

sub Delay()
  dim as single count
  count = Timer
  while Timer - count < .1
  wend
  DisplayWorld()
  wait &H3DA,8
  screencopy
  setSensors()
end sub

    
sub ArmLeft()
  SetSensors()
  if leftsensor = 0 then
    'move any block left
    if hold = 1 then
      world1(armx-1,army+1)=world1(armx,army+1)
      world1(armx,army+1)=0
    end if
    armx = armx - 1
  end if
  Delay()
end sub

sub ArmRight()
  setSensors()
  if rightsensor = 0 then
    'move any block right
    if hold = 1 then
      world1(armx+1,army+1)=world1(armx,army+1)
      world1(armx,army+1)=0
    end if
    armx = armx + 1
  end if
  Delay()
end sub

sub ArmUp()
  if army > 0 then
    if hold = 1 then
      world1(armx,army)=world1(armx,army+1) 'move block up
      world1(armx,army+1)=0 'erase old block
      army = army - 1
    else
      army = army - 1
    end if
  end if
  Delay()
end sub


sub ArmDown()
  if hold = 1 then
    if army < wHEIGHT-2 then
      if world1(armx,army+2)= 0 then
        world1(armx,army+2)=world1(armx,army+1) 'copy block down
        world1(armx,army+1)=0 'erase old block
        army = army + 1
      end if
    end if
  else
    if army < wHEIGHT-1 then
      if world1(armx,army+1)=0 then
        army = army + 1
      end if
    end if
  end if
  Delay()
end sub

sub MoveArm(posx as integer, posy as integer)

  'move to column
  while armx <> posx
    if armx < posx then
      if rightsensor = 1 then
        ArmUp()
      end if
      ArmRight()
    end if
    if armx > posx then
      if leftsensor = 1 then
        ArmUp()
      end if
      ArmLeft()
    end if
  wend
  
  'move arm down
  while downsensor = 0
    ArmDown()
  wend
  hold = 0

end sub



'create world
sub CreateWorld()
  
  dim as integer x,y,v,i
  FOR y = 0 TO wHEIGHT-1
    FOR x = 0 TO wWIDTH-1
      world1(x, y) = 0
    NEXT x
  NEXT y

  FOR i = 1 TO 15: 'number of blocks
    x = INT(RND(1) * wWIDTH)
    y = wHEIGHT-1
    v = world1(x, y)
    WHILE v <> 0 AND y > 0
      y = y - 1
      v = world1(x, y)
    WEND
    world1(x, y) = i
  NEXT i

end sub



' MAIN
SCREEN 12,2
screenset 0,1

dim as integer x,y,bNumber

CreateWorld()

do
'    DisplayWorld()
    
    'select a random top blocks column
    srcx = int(rnd(1)*wWIDTH)
    while world1(srcx,wHEIGHT-1)=0
      srcx = int(rnd(1)*wWIDTH)
    wend
    
    'find row of top block
    srcy = 0
    while world1(srcx,srcy+1)=0 and srcy < wHEIGHT-1
      srcy = srcy + 1
    wend
    
    'select a random column to put block
    dstx = int(rnd(1)*wWIDTH)
    
    'select row where to put block in column
    dsty = 0
    while world1(dstx,dsty+1)=0 and dsty < wHEIGHT-1
      dsty = dsty + 1
    wend
    
    MoveArm(srcx,srcy-1)
    
    'grab block
    hold = 1
    
    MoveArm(dstx,dsty-1)
    
    hold = 0 'release block
    
loop until multikey(&H01)

This was a setup with the current state of the block world on the left and the desired state of the block world on the right. The problem was to write a program, AI, that would legally move blocks on the left until it was the same as goal state on the right. The demo moves them randomly so it would take a long time for the left side to match the right side!!

Code: Select all

SCREEN 12
      
dim shared as integer world1(10, 10), world2(10, 10)
dim shared as integer xblock1(16),xblock2(16),yblock1(16),yblock2(16)

dim shared as integer x,y,v,i
dim shared as integer pos1,pos2,item



sub DisplayWorlds()
cls
screenlock
LINE (98, 100)-(300, 300), 15, B

FOR y = 0 TO 9
  FOR x = 0 TO 9
    IF world1(x, y) <> 0 THEN
      LINE (x * 20 + 100, y * 20 + 100)-(x * 20 + 118, y * 20 + 118), world1(x, y), BF
    END IF
  NEXT x
NEXT y

LINE (398, 100)-(600, 300), 15, B

FOR y = 0 TO 9
  FOR x = 0 TO 9
    IF world2(x, y) <> 0 THEN
      LINE (x * 20 + 400, y * 20 + 100)-(x * 20 + 418, y * 20 + 118), world2(x, y), BF
    END IF
  NEXT x
NEXT y

screenunlock
end sub

'clear worlds
sub CreateWorlds()
FOR y  = 0 TO 9
FOR x  = 0 TO 9
world1(x, y) = 0
world2(x, y) = 0
NEXT x
NEXT y

CLS
FOR i  = 1 TO 15: 'number of blocks
  x = INT(RND(1) * 10)
  y = 9
  v = world1(x, y)
  WHILE v <> 0 AND y > 0
    y = y - 1
    v = world1(x, y)
  WEND
  world1(x, y) = i
NEXT i

FOR i  = 1 TO 15: 'number of blocks
  x = INT(RND(1) * 10)
  y = 9
  v = world2(x, y)
  WHILE v <> 0 AND y > 0
    y = y - 1
    v = world2(x, y)
  WEND
  world2(x, y) = i
NEXT i
end sub

sub PickUpPutDown(pos1 as integer, pos2 as integer)
  y = 0
  x = pos1
  item = 0

  if world1(pos1,9)<>0 and world1(pos1,0)=0 then
    while world1(x,y)=0
      y = y + 1
    wend
    item = world1(x,y) 'pick up block
    world1(x,y) = 0    'erase old position
    
'    line(0,0)-(19,19),item,bf 'display pickup
'    sleep
    
    y = 0
    x = pos2
    if world1(pos2,9)<>0 then  
      while world1(x,y)=0
        y = y + 1
      wend
      y = y - 1
      world1(x,y) = item 'put down block
    else
      world1(pos2,9) = item 'put block on floor
    end if

  end if
  
end sub

  
' MAIN


CreateWorlds()
'fill in block locations
for y = 0 to 9
  for x = 0 to 9
    if world1(x,y)<>0 then
      xblock1(world1(x,y))=x
      yblock1(world1(x,y))=y
    end if
    if world2(x,y)<>0 then
      xblock2(world2(x,y))=x
      yblock2(world2(x,y))=y
    end if
  next x
next y

DisplayWorlds()

do
    pos1 = int(rnd(1)*10)
    pos2 = int(rnd(1)*10)
    PickUpPutDown(pos1,pos2)
    DisplayWorlds()


    sleep 20
    
loop until multikey(&H01)

[hhr]

Very good, I didn't understand what it was about, but it looks really interesting.

[dafhi]

BasicCoder2 - good to know you already nailed it!

i see potential 'challenges' which interest me which i might try one day

1. combine the 2 demos (1st demo enough]
2. make arm movement accel / decel
3. optimize the search space (if that's even a correct way to think about it)
for example just try building one column

[BasicCoder2]

The purpose was seeing if I could write an AI program which could move the blocks one by one using its hand to end up with some goal state (given block arrangement). The program is just the simple simulated world it would use.

[neil]

Machine learning has come a long way in the last decade.
After an autonomous robot learned the maze.
If finished the maze in 6 seconds.
https://www.youtube.com/watch?v=ZMQbHMgK2rw