Evolving RI (Robot Intelligence) for a room vacuum

[bplus]

I am developing an Agent in AI lingo that is able to act on it's own without human intervention in real time

Here is first crude effort. You press spacebar for each step, or just lean on it to run through process. There is no stop signal, it just keeps on sweeping the random room.

What surprises the heck out of me is that it always, eventually, covers the whole room! So far I've not seen it fail. True  there is a lot of redundant over sweeps of cells but eventually it covers the room.

The sweeper only moves up/down or left/right each step and can only sense if there is an obstacle in these directions.

Code: QB64: [Select]

1. _Title "I Robot - Room Mapper 1 (IR-RM1)" ' b+ 2022-02-11
2. ' 2022-02-23 started writing code
3. ' The little guy, say a vaccum cleaner, is plopped down somewhere in it's new home.
4. ' The first order of business is to map out it's area of duty,
5. ' say sweep the whole floor without getting stuck or wasting allot of moves.
6. ' It is square and can sense, resistence on any of its edges.
7. ' It is allowed to go N,S,E,W - the four directions
8. ' If something is sensed on one side it is forbidden to
9. ' enter that square from that direction.
10. ' Rule of economy - don't reenter a square already occupied
11. ' unless that is the only way to go.
12. ' Do we have enough spelled out to map a room?
13.  
14. ' A room is a grid of squares, we don't know the dimensions
15. ' and there are objects in many of the middle squares or along
16. ' the walls. Later we may encounter objects that move around
17. ' like pets or results of fickle home decorators.
18.  
19. ' God provides a room with objetcs and randomly drops the robot
20. ' into it.
21.  
22. ' 2022-02-23 first goal is to get an edges mapped. so make up a room
23. ' Upon some more thinking and just to get the ball rolling, I will
24. ' allow robot vaccum sweeper to use the room map and mark it with it's
25. ' own numbers, so now the walls are -1, empty areas 0, places visited
26. ' are positive numbers, everytime the vacuum reoccupies the square
27. ' the number is increased.
28. ' OK the room setup seems satisfactory onto RI = Robot Intelligence
29.  
30. ' OK first run it does eventually cover the whole room.
31. ' Need to know when it has done the whole room. There are some
32. ' places that have to be left 0
33.  
34. Randomize Timer
35. Const SW = 601, SH = 601
36. Screen _NewImage(SW, SH, 32)
37. _ScreenMove 200, 70
38.  
39. ReDim Shared As Integer dx(3), dy(3)
40. dx(0) = 0: dy(0) = -1
41. dx(1) = 1: dy(1) = 0
42. dx(2) = 0: dy(2) = 1
43. dx(3) = -1: dy(3) = 0
44.  
45. ReDim Shared As Long Room(1 To 20, 1 To 20) ' 0 = empty -1 = wall see MakeRoom
46. Dim Shared As Long rx, ry ' robot location
47. rx = 10: ry = 10 ' starts here in middle of room should be clear
48. MakeRoom
49. Do
50.     drawRoom 'ok the middle of room is staying clear of stuff
51.     _Display
52.     RI ' ok roby make your move
53.     Sleep
54.     Cls
55. Loop
56.  
57. Sub RI ' the robot appraises it's current postition rx, ry in Room(20x20) and makes a move changing rx, ry and that ends the sub
58.  
59.     ' I was here!
60.     Room(rx, ry) = Room(rx, ry) + 1 ' sweeps the spot
61.     Dim d(3)
62.     d(0) = Room(rx, ry - 1)
63.     d(1) = Room(rx + 1, ry)
64.     d(2) = Room(rx, ry + 1)
65.     d(3) = Room(rx - 1, ry)
66.  
67.     If d(0) = 0 Then ' one must have ones priorities
68.         ry = ry - 1: Exit Sub
69.     ElseIf d(1) = 0 Then
70.         rx = rx + 1: Exit Sub
71.     ElseIf d(2) = 0 Then
72.         ry = ry + 1: Exit Sub
73.     ElseIf d(3) = 0 Then
74.         rx = rx - 1: Exit Sub
75.     End If
76.  
77.     ' still here ?  where is min number of visits?
78.     Dim As Long min, saveI
79.     min = 10000000
80.     For i = 0 To 3
81.         If d(i) <> -1 Then
82.             If d(i) < min Then min = d(i): saveI = i
83.         End If
84.     Next
85.     rx = rx + dx(saveI)
86.     ry = ry + dy(saveI)
87. End Sub
88.  
89. Sub drawRoom
90.     drawGridSq 0, 0, 30, 30
91.     For x = 1 To 20
92.         For y = 1 To 20
93.             If Room(x, y) = -1 Then
94.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), , BF
95.             ElseIf Room(x, y) > 0 Then
96.                 s$ = _Trim$(Str$(Room(x, y)))
97.                 _PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
98.             End If
99.         Next
100.     Next
101.     ' and robot
102.     Line ((rx - 1) * 30, (ry - 1) * 30)-Step(30, 30), &HFFFFFF00, BF
103. End Sub
104.  
105. Sub MakeRoom
106.     ReDim As Long Room(1 To 20, 1 To 20) ' 0 = empty -1 = wall
107.     ' Here are the walls
108.     For x = 1 To 20
109.         For y = 1 To 2
110.             If y = 2 Then z = 20 Else z = 1
111.             Room(x, z) = -1
112.             Room(z, x) = -1
113.         Next
114.     Next
115.  
116.     ' add random rectangles around the edges
117.     For i = 1 To 20
118.         rw = Int(Rnd * 4) + 1: rh = Int(Rnd * 4) + 1
119.         wall = Int(Rnd * 4)
120.         Select Case wall
121.             Case 0 ' top
122.                 If Rnd < .5 Then ys = 1 Else ys = 4
123.                 xs = Int(Rnd * (20 - rw)) + 1
124.                 For y = ys To ys + rh - 1
125.                     For x = xs To xs + rw - 1
126.                         Room(x, y) = -1
127.                     Next
128.                 Next
129.             Case 1 'right
130.                 If Rnd < .5 Then xs = 20 - rw + 1 Else xs = 16 - rw + 1
131.                 ys = Int(Rnd * (20 - rh)) + 1
132.                 For y = ys To ys + rh - 1
133.                     For x = xs To xs + rw - 1
134.                         Room(x, y) = -1
135.                     Next
136.                 Next
137.             Case 2 ' bottom
138.                 If Rnd < .5 Then ys = 20 - rh + 1 Else ys = 16 - rh + 1
139.                 xs = Int(Rnd * (20 - rw)) + 1
140.                 For y = ys To ys + rh - 1
141.                     For x = xs To xs + rw - 1
142.                         Room(x, y) = -1
143.                     Next
144.                 Next
145.             Case 3 'left
146.                 If Rnd < .5 Then xs = 1 Else xs = 4
147.                 ys = Int(Rnd * (20 - rh)) + 1
148.                 For y = ys To ys + rh - 1
149.                     For x = xs To xs + rw - 1
150.                         Room(x, y) = -1
151.                     Next
152.                 Next
153.         End Select
154.     Next
155.  
156. End Sub
157.  
158. Sub drawGridSq (x, y, sq, n)
159.     Dim d As Long, i As Long
160.     d = sq * n
161.     For i = 0 To n
162.         Line (x + sq * i, y)-(x + sq * i, y + d)
163.         Line (x, y + sq * i)-(x + d, y + sq * i)
164.     Next
165. End Sub
166.  
167.  

BTW don't expect the vacuum to access sections that are completely walled off by room obstacles. A bit of a problem picking up on those isolated areas so the code knows when everything that could be swept has been as seen in next code reply.

[bplus]

Here's how it looks after I've added a path finding tool and allowed it to magically find the next empty square when it is surrounded with obstacles or cells it's already vacuumed.

It runs quite well on it's own, random room after random room, complete coverage occurs much quicker with smaller amount of redundant sweeping cells.

Code: QB64: [Select]

1. Option _Explicit
2. _Title "I Robot - Room Mapper 2 (IR-RM2)" ' b+ 22-02-11
3. ' 22-02-23 started writing code
4. ' The little guy, say a vaccum cleaner, is plopped down somewhere in it's new home.
5. ' The first order of business is to map out it's area of duty,
6. ' say sweep the whole floor without getting stuck or wasting allot of moves.
7. ' It is square and can sense, resistence on any of its edges.
8. ' It is allowed to go N,S,E,W - the four directions
9. ' If something is sensed on one side it is forbidden to
10. ' enter that square from that direction.
11. ' Rule of economy - don't reenter a square already occupied
12. ' unless that is the only way to go.
13. ' Do we have enough spelled out to map a room?
14.  
15. ' A room is a grid of squares, we don't know the dimensions
16. ' and there are objects in many of the middle squares or along
17. ' the walls. Later we may encounter objects that move around
18. ' like pets or results of fickle home decorators.
19.  
20. ' God provides a room with objetcs and randomly drops the robot
21. ' into it.
22.  
23. ' 22-02-23 first goal is to get an edges mapped. so make up a room
24. ' Upon some more thinking and just to get the ball rolling, I will
25. ' allow robot vaccum sweeper to use the room map and mark it with it's
26. ' own numbers, so now the walls are -1, empty areas 0, places visited
27. ' are positive numbers, everytime the vacuum reoccupies the square
28. ' the number is increased.
29. ' OK the room setup seems satisfactory onto RI = Robot Intelligence
30.  
31. ' OK first run it does eventually cover the whole room.
32. ' Need to know when it has done the whole room. There are some
33. ' places that have to be left 0
34.  
35. ' IR-RM2 next mod
36. ' 2022-02-24 what I need is path finder, then I can see which squares are
37. ' accessible to robot from middle of the room, so I can mark and then
38. ' I will be able to tell when Robot has visited all spaces it can.
39. ' ALSO I can use pathfinder to get at next closest enpty square.
40. ' OK the subs from PathFinder 3a are loaded and working with Option _Explicit.
41.  
42. ' Next job is to mark all places vacuum can access checks, so we can then
43. ' have a check to see if all areas covered by vac.
44.  
45. ' 2022-02-26 Got the bug causing once in a blue moon problem with room fills
46. ' ie leaving empty spaces not accessible to vacuum. Could the other once in a blue
47. ' moon problem be similar. RI is trying to path to target at 0,0.
48. ' Ho, ho yes! very likely the same problem!!!
49.  
50. Randomize Timer
51. Const SW = 1021, SH = 721 ' cell @30 max 34x24
52. Const Cell = 30
53. Const MapW = 27, MapH = 17 ' min @30 cell is 17, 17
54. Screen _NewImage(SW, SH, 12)
55. _ScreenMove 150, 20
56.  
57. Dim Shared As Long BeeLine, Done ' Roby is in beeLine Mode heading to closet empty (unvac'd) cell using steps from Path Finder app
58. ReDim Shared As Long StepMap(1 To MapW, 1 To MapH) ' for making paths that you step through
59. Dim Shared As Long StepI, StepDist
60. ReDim Shared As Long StepX(1 To MapW * MapH), StepY(1 To MapW * MapH)
61.  
62. ReDim Shared As Long Room(1 To MapW, 1 To MapH) ' 0 = empty -1 = wall see MakeRoom
63. Dim Shared As Long rx, ry ' robot location
64. Dim As Long sweeps
65. Do
66.     Done = 0: rx = Int(MapW / 2 + .5): ry = Int(MapH / 2 + .5) ' starts here in middle of room should be clear
67.     MakeRoom
68.     Do
69.         drawRoom 'ok the middle of room is staying clear of stuff
70.  
71.         ' debug check path works
72.         'path rx, ry, 5, 5 'does this still work  OH YEAH! Better than ever!
73.         '_Display
74.  
75.         RI ' ok roby make your move
76.         _Display
77.         _Limit 10
78.         If Done Then Cls: drawRoom: Exit Do
79.  
80.         ' debug just checking rooms made right
81.         'Sleep
82.         'Cls
83.         'Exit Do
84.     Loop
85.     'Print "Finished press any for next run   zzz..."
86.     'Sleep
87.     sweeps = sweeps + 1
88.     _Title "I Robot - Room Mapper 2 (IR-RM2) " + Str$(sweeps) + " successful rooms swept."
89.     _Display
90.     _Delay 1
91. Loop
92.  
93. Sub RI ' the robot appraises it's current postition rx, ry in Room(x) and makes a move changing rx, ry and that ends the sub
94.     Dim As Long mini, x, y, saveX, saveY
95.     ' I was here!  sweeps the spot (again?)
96.     'If rx > 0 And rx <= MapW And ry > 0 And ry <= MapH Then
97.     Room(rx, ry) = Room(rx, ry) + 1 ' put roby's presense on map
98.     'End If
99.  
100.     ' after marking current spot see if we have swept all possible
101.     If swept% Then Done = -1: Exit Sub
102.  
103.     If BeeLine = 0 Then ' normal sweeping pattern, hey try up/down then right/left see if leaves less spots
104.         If Room(rx, ry - 1) = 0 Then ' one must have ones priorities
105.             ry = ry - 1: Exit Sub
106.         ElseIf Room(rx + 1, ry) = 0 Then
107.             rx = rx + 1: Exit Sub
108.         ElseIf Room(rx, ry + 1) = 0 Then
109.             ry = ry + 1: Exit Sub
110.         ElseIf Room(rx - 1, ry) = 0 Then
111.             rx = rx - 1: Exit Sub
112.         End If
113.  
114.         ' still here ?  ========== Decide to make a BeeLine - find the closet empty and make a bee-line to it
115.         BeeLine = -1 'put us into BeeLine Mode
116.         prepStepMap rx, ry
117.         mini = 10000000
118.         For y = 1 To MapH ' now run through step map and find the mini closest empty room
119.             For x = 1 To MapW
120.                 If StepMap(x, y) > 1 Then ' has to be > 1 because 0 is robot and 1 the robot will detect!
121.                     If StepMap(x, y) < mini And Room(x, y) = 0 Then mini = StepMap(x, y): saveX = x: saveY = y
122.                 End If
123.             Next
124.         Next
125.  
126.         'OK we have our target not find a clear short path to it from roby
127.         path rx, ry, saveX, saveY ' path sets stepI, stepX(i), stepY(I) that are shared
128.         StepI = 1 ' roby is on it's way to closet empty cell
129.  
130.         'debug
131.         'Print StepI, StepX(StepI), StepY(StepI)
132.         '_display
133.         'Beep
134.         'Sleep ' let me see that path we made
135.  
136.         rx = StepX(StepI): ry = StepY(StepI)
137.     Else
138.         ' beeline mode
139.         StepI = StepI + 1 ' roby is on it's way to closet empty cell
140.         rx = StepX(StepI): ry = StepY(StepI)
141.  
142.         'turn of beeLine mode when we have hit target
143.         If StepI = StepDist - 1 Then BeeLine = 0 ' we have arrived at our target turn off beeLine mode
144.     End If
145. End Sub
146.  
147. Sub drawRoom
148.     Dim As Long x, y
149.     Dim s$
150.     Cls
151.     drawGridSq
152.     For y = 1 To MapH
153.         For x = 1 To MapW
154.             If Room(x, y) = -1 Then
155.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), 8, BF
156.             ElseIf Room(x, y) = -2 Then
157.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), 0, BF
158.             ElseIf Room(x, y) < -2 Then
159.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), Abs(Room(x, y)) - 15, BF
160.             ElseIf Room(x, y) > 0 Then
161.                 s$ = _Trim$(Str$(Room(x, y)))
162.                 _PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
163.             End If
164.         Next
165.     Next
166.     ' and robot
167.     Line ((rx - 1) * 30, (ry - 1) * 30)-Step(30, 30), 14, BF
168. End Sub
169.  
170. Sub MakeRoom
171.     ReDim As Long Room(1 To MapW, 1 To MapH) ' 0 = empty, -1 = wall, -2 = area vac can't access because walled out
172.     Dim As Long x, y, i, rw, rh, wall, ys, xs, clr
173.     ' Here are the walls
174.     For x = 1 To MapW
175.         Room(x, 1) = -1
176.         Room(x, MapH) = -1
177.     Next
178.     For y = 1 To MapH
179.         Room(1, y) = -1
180.         Room(MapW, y) = -1
181.     Next
182.  
183.     ' add random rectangles around the edges
184.     For i = 1 To Int(Sqr(1.5 * MapW * MapH))
185.         rw = Int(Rnd * 4) + 1: rh = Int(Rnd * 4) + 1: clr = -1 * ((Int(Rnd * 13) + 1) + 15)
186.         wall = Int(Rnd * 4)
187.         Select Case wall
188.             Case 0 ' top
189.                 If Rnd < .5 Then ys = 2 Else ys = 4
190.                 xs = irnd&(2, MapW - 1 - rw)
191.                 For y = ys To ys + rh - 1
192.                     For x = xs To xs + rw - 1
193.                         Room(x, y) = clr
194.                     Next
195.                 Next
196.             Case 1 'right
197.                 If Rnd < .5 Then xs = MapW - 1 - rw Else xs = (MapW - 3) - rw
198.                 ys = irnd(2, MapH - 1 - rh)
199.                 For y = ys To ys + rh - 1
200.                     For x = xs To xs + rw - 1
201.                         Room(x, y) = clr
202.                     Next
203.                 Next
204.             Case 2 ' bottom
205.                 If Rnd < .5 Then ys = MapH - rh - 1 Else ys = (MapH - 2) - rh - 1
206.                 xs = irnd(2, MapW - 1 - rw)
207.                 For y = ys To ys + rh - 1
208.                     For x = xs To xs + rw - 1
209.                         Room(x, y) = clr
210.                     Next
211.                 Next
212.             Case 3 'left
213.                 If Rnd < .5 Then xs = 2 Else xs = 5
214.                 ys = irnd(2, MapH - rh - 1)
215.                 For y = ys To ys + rh - 1
216.                     For x = xs To xs + rw - 1
217.                         Room(x, y) = clr
218.                     Next
219.                 Next
220.         End Select
221.     Next
222.  
223.     ' before make map make sure rx, ry is set or reset
224.     prepStepMap rx, ry ' see what cells not accessible to vac mark them -1
225.     For y = 1 To MapH
226.         For x = 1 To MapW
227.             If Room(x, y) = 0 Then
228.                 If StepMap(x, y) = 0 Then Room(x, y) = -2
229.             End If
230.         Next
231.     Next
232.     Room(rx, ry) = 0 ' not a -2 room!
233. End Sub
234.  
235. Sub drawGridSq
236.     Dim As Long x, y
237.     For x = 0 To Cell * MapW Step Cell
238.         Line (x, 0)-Step(0, Cell * MapH)
239.     Next
240.     For y = 0 To Cell * MapH Step Cell
241.         Line (0, y)-Step(Cell * MapW, 0)
242.     Next
243. End Sub
244.  
245. Function swept%
246.     Dim As Long x, y
247.     For y = 1 To MapH
248.         For x = 1 To MapW
249.             If Room(x, y) = 0 Then Exit Function 'not swept
250.         Next
251.     Next
252.     swept% = -1 ' all clean!
253. End Function
254.  
255. Sub path (sx As Long, sy As Long, tx As Long, ty As Long) ' start x, y to target x, y
256.     Dim As Long dist, cx, cy, cf, y, x
257.     prepStepMap tx, ty
258.     dist = StepMap(sx, sy) 'STEPMAP is DIM SHARED as INTEGER
259.     StepDist = dist
260.     If dist = 0 Or Room(tx, ty) = -1 Then
261.         StepI = 0
262.         ' Beep
263.         Color 0, 15
264.         _PrintString (200, 300), "Target:" + Str$(tx) + "," + Str$(ty) + " is bad, fatal error."
265.         _Display
266.         Sleep
267.         End
268.     End If
269.     'refresh
270.     ReDim As Long StepX(1 To MapW * MapH), StepY(1 To MapW * MapH)
271.     StepI = 0 'DIM SHARED error signal
272.     cx = sx: cy = sy
273.     While dist >= 2
274.         'LOCATE 2, 1: PRINT "cx, cy: "; cx, cy '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< debug
275.         cf = 0
276.         For y = cy - 1 To cy + 1
277.             For x = cx - 1 To cx + 1
278.                 'PRINT "x, y, STEPMAP(x, y) "; x, y, STEPMAP(x, y)
279.                 If StepMap(x, y) = dist - 1 Then
280.                     StepI = StepI + 1
281.                     StepX(StepI) = x: StepY(StepI) = y
282.                     Line ((StepX(StepI) - 1) * 30 + 4, (StepY(StepI) - 1) * 30 + 4)-Step(30 - 8, 30 - 8), 6, BF
283.                     cf = 1: Exit For
284.                 End If
285.             Next
286.             If cf = 1 Then Exit For
287.         Next
288.         If cf = 0 Then 'lost path
289.             Exit Sub
290.         Else
291.             cx = StepX(StepI): cy = StepY(StepI)
292.             dist = dist - 1
293.         End If
294.     Wend
295.     _Display
296.     _Delay .25
297. End Sub
298.  
299. Sub prepStepMap (tx As Long, ty As Long) ' ========================================== no more diagonal steps
300.     Dim As Long x, y, tick, changes, ystart, ystop, xstart, xstop
301.     Dim s$ 'debug
302.  
303.     ReDim As Long StepMap(1 To MapW, 1 To MapH)
304.     If tx > 0 And tx <= MapW And ty > 0 And ty <= MapH Then
305.         StepMap(tx, ty) = 1: tick = 1: changes = 1
306.         While changes
307.             tick = tick + 1: changes = 0
308.             ystart = max(ty - tick, 1): ystop = min(ty + tick, MapH)
309.             For y = ystart To ystop
310.                 xstart = max(tx - tick, 1): xstop = min(tx + tick, MapW)
311.                 For x = xstart To xstop
312.                     'check out the neighbors
313.                     If Room(x, y) >= 0 Then ' places OK to go
314.                         'cf = 0
315.                         ' ============================================================= new >>> path finder  that won't take diagonal steps
316.                         'need to check 4 cells around x, y for parent
317.                         If StepMap(x - 1, y) = tick - 1 And StepMap(x, y) = 0 Then
318.                             StepMap(x, y) = tick
319.                             ' 2 line debug  =====================================================
320.                             's$ = _Trim$(Str$(StepMap(x, y)))
321.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
322.                             changes = 1: GoTo skip
323.                         End If
324.                         If StepMap(x + 1, y) = tick - 1 And StepMap(x, y) = 0 Then
325.                             StepMap(x, y) = tick
326.                             ' debug
327.                             's$ = _Trim$(Str$(StepMap(x, y)))
328.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
329.                             changes = 1: GoTo skip
330.                         End If
331.                         If StepMap(x, y - 1) = tick - 1 And StepMap(x, y) = 0 Then
332.                             StepMap(x, y) = tick
333.                             ' debug
334.                             's$ = _Trim$(Str$(StepMap(x, y)))
335.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
336.                             changes = 1: GoTo skip
337.                         End If
338.                         If StepMap(x, y + 1) = tick - 1 And StepMap(x, y) = 0 Then
339.                             StepMap(x, y) = tick
340.                             ' debug
341.                             's$ = _Trim$(Str$(StepMap(x, y)))
342.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
343.                             changes = 1
344.                         End If
345.                         skip:
346.                     End If
347.                 Next
348.             Next
349.         Wend
350.     Else
351.         'Beep
352.         Color 0, 13
353.         _PrintString (200, 300), "Target:" + Str$(tx) + "," + Str$(ty) + " is bad, fatal error."
354.         _Display
355.         Sleep
356.         End
357.     End If
358. End Sub
359.  
360. Function min (n1, n2)
361.     If n1 > n2 Then min = n2 Else min = n1
362. End Function
363.  
364. Function max (n1, n2)
365.     If n1 < n2 Then max = n2 Else max = n1
366. End Function
367.  
368. Function irnd& (n1, n2) 'return an integer between 2 numbers
369.     Dim l%, h%
370.     If n1 > n2 Then l% = n2: h% = n1 Else l% = n1: h% = n2
371.     irnd& = Int(Rnd * (h% - l% + 1)) + l%
372. End Function
373.  
374.  

Next step I think I need to give the RI a stack to save locations of empty cells as it passes them by, so no magic is called upon to know where they are. Hopefully it will get to missed sections a little faster, instead of jumping across room from one incomplete section to next after most the room is finished.

[STxAxTIC]

this impresses me

[SpriggsySpriggs]

bump n' go cars 2.0

[bplus]

Well neither a FIFO nor FILO Stack worked, at least not the way I coded it. Gave up and just created another array for the RI to "remember" all the places that had empty cells as it rolled by, array called mt. When RI rolls over one of these remembers to mark it as no longer mt. Turns out that was easier to code and with less lines.

So it's true no magic is needed to find the nearest mt cell, the RI always seems to have one in memory to goto. What makes me groan is as it's going to the closest one it sometimes misses royally the opportunity to take a bunch of mt's along the way. Gotta fix that! This is because the mt as the crow flies is closest but getting there can be quite round about because of obstacles... hmm maybe I should check path lengths for shortest one to an empty cell. Yeah that's tomorrow.

Anyway here's proof no magic is needed to find an empty cell because RI has rolled by and memorized plenty enough.
The cells marked with a star are cells the RI has recorded in it's memory as empty.

Code: QB64: [Select]

1. Option _Explicit
2. _Title "I Robot - Room Mapper 4 (IR-RM4)" ' b+ 22-02-11
3. ' 22-02-23 started writing code
4. ' The little guy, say a vaccum cleaner, is plopped down somewhere in it's new home.
5. ' The first order of business is to map out it's area of duty,
6. ' say sweep the whole floor without getting stuck or wasting allot of moves.
7. ' It is square and can sense, resistence on any of its edges.
8. ' It is allowed to go N,S,E,W - the four directions
9. ' If something is sensed on one side it is forbidden to
10. ' enter that square from that direction.
11. ' Rule of economy - don't reenter a square already occupied
12. ' unless that is the only way to go.
13. ' Do we have enough spelled out to map a room?
14.  
15. ' A room is a grid of squares, we don't know the dimensions
16. ' and there are objects in many of the middle squares or along
17. ' the walls. Later we may encounter objects that move around
18. ' like pets or results of fickle home decorators.
19.  
20. ' God provides a room with objetcs and randomly drops the robot
21. ' into it.
22.  
23. ' 22-02-23 first goal is to get an edges mapped. so make up a room
24. ' Upon some more thinking and just to get the ball rolling, I will
25. ' allow robot vaccum sweeper to use the room map and mark it with it's
26. ' own numbers, so now the walls are -1, empty areas 0, places visited
27. ' are positive numbers, everytime the vacuum reoccupies the square
28. ' the number is increased.
29. ' OK the room setup seems satisfactory onto RI = Robot Intelligence
30.  
31. ' OK first run it does eventually cover the whole room.
32. ' Need to know when it has done the whole room. There are some
33. ' places that have to be left 0
34.  
35. ' IR-RM2 next mod
36. ' 2022-02-24 what I need is path finder, then I can see which squares are
37. ' accessible to robot from middle of the room, so I can mark and then
38. ' I will be able to tell when Robot has visited all spaces it can.
39. ' ALSO I can use pathfinder to get at next closest enpty square.
40. ' OK the subs from PathFinder 3a are loaded and working with Option _Explicit.
41.  
42. ' Next job is to mark all places vacuum can access checks, so we can then
43. ' have a check to see if all areas covered by vac.
44.  
45. ' 2022-02-26 Got the bug causing once in a blue moon problem with room fills
46. ' ie leaving empty spaces not accessible to vacuum. Could the other once in a blue
47. ' moon problem be similar. RI is trying to path to target at 0,0.
48. ' Ho, ho yes! very likely the same problem!!!
49. ' 2022-02-27 fix some things color the furniture, debug the way the furniture
50. ' was supposed to be placed around the room ie not into the walls!
51.  
52. ' IR-RM3 next mod,
53. ' 2022-02-28  give RI a stack to save locations of empty cells it passes by.
54. ' I think that might improve performance because it will get unswept sections
55. ' while it's still nearby? That is the hypothesis, now for the experiment.
56. ' Stack is NOT WORKING this code is dead end!
57.  
58. ' IR_RM4 next mod
59. ' Every space the RI occupies, update the 4 cell neighbor status as empty or not
60. ' in an empty cell array, then when RI needs to know closest empty use that map.
61.  
62. Randomize Timer
63. Const SW = 1021, SH = 721 ' cell @30 max 34x24
64. Const Cell = 30
65. Const MapW = 17, MapH = 17 ' min @30 cell is 17, 17
66. Screen _NewImage(SW, SH, 12)
67. _ScreenMove 150, 20
68.  
69. ReDim Shared As Long mt(1 To MapW, 1 To MapH)
70. Dim Shared As Long MagicRequired ' this is to signal that RI could not find the next empty cell without appeal to Gods
71.  
72. Dim Shared As Long BeeLine, Done ' Roby is in beeLine Mode heading to closet empty (unvac'd) cell using steps from Path Finder app
73. ReDim Shared As Long StepMap(1 To MapW, 1 To MapH) ' for making paths that you step through
74. Dim Shared As Long StepI, StepDist
75. ReDim Shared As Long StepX(1 To MapW * MapH), StepY(1 To MapW * MapH)
76.  
77. ReDim Shared As Long Room(1 To MapW, 1 To MapH) ' 0 = empty -1 = wall see MakeRoom
78. Dim Shared As Long rx, ry ' robot location
79. Dim As Long sweeps
80. Do
81.     Done = 0
82.     rx = Int(MapW / 2 + .5): ry = Int(MapH / 2 + .5) ' starts here in middle of room should be clear
83.     ReDim Shared As Long mt(1 To MapW, 1 To MapH)
84.     MakeRoom
85.     Do
86.         drawRoom 'ok the middle of room is staying clear of stuff
87.  
88.         ' debug check path works
89.         'path rx, ry, 5, 5 'does this still work  OH YEAH! Better than ever!
90.         '_Display
91.  
92.         RI ' ok roby make your move
93.         _Display
94.         _Limit 5
95.         If Done Then Cls: drawRoom: Exit Do
96.  
97.         ' debug just checking rooms made right
98.         'Sleep
99.         'Cls
100.         'Exit Do
101.     Loop
102.     'Print "Finished press any for next run   zzz..."
103.     'Sleep
104.     sweeps = sweeps + 1
105.     _Title "I Robot - Room Mapper 2 (IR-RM2) " + Str$(sweeps) + " successful rooms swept, magic needed" + Str$(MagicRequired) + " times."
106.     _Display
107.     _Delay 1
108. Loop
109.  
110. Sub RI ' the robot appraises it's current postition rx, ry in Room(x) and makes a move changing rx, ry and that ends the sub
111.     Dim As Long mini, x, y, saveX, saveY, mtDist, delayFlag
112.  
113.     ' I was here!  sweeps the spot (again?)
114.     Room(rx, ry) = Room(rx, ry) + 1 ' put roby's presense on map
115.     mt(rx, ry) = 0 'no longer mt
116.  
117.     ' remember what we found here when we need an empty cell loaction
118.     If Room(rx, ry - 1) = 0 Then mt(rx, ry - 1) = -1
119.     If Room(rx + 1, ry) = 0 Then mt(rx + 1, ry) = -1
120.     If Room(rx, ry + 1) = 0 Then mt(rx, ry + 1) = -1
121.     If Room(rx - 1, ry) = 0 Then mt(rx - 1, ry) = -1
122.  
123.  
124.     ' after marking current spot see if we have swept all possible
125.     If swept% Then Done = -1: Exit Sub
126.  
127.     If BeeLine = 0 Then ' normal sweeping pattern, hey try up/down then right/left see if leaves less spots
128.         If Room(rx, ry - 1) = 0 Then ry = ry - 1: Exit Sub
129.         If Room(rx + 1, ry) = 0 Then rx = rx + 1: Exit Sub
130.         If Room(rx, ry + 1) = 0 Then ry = ry + 1: Exit Sub
131.         If Room(rx - 1, ry) = 0 Then rx = rx - 1: Exit Sub
132.  
133.         ' still here ?  ========== Decide to make a BeeLine - find the closet empty and make a bee-line to it
134.         BeeLine = -1 'put us into BeeLine Mode
135.         'do we have an empty cell location in the stack
136.         mini = 10000000: delayFlag = 0
137.         For y = 1 To MapH ' now run through step map and find the mini closest empty room
138.             For x = 1 To MapW
139.                 If mt(x, y) = -1 Then ' a known empty cell we passed
140.                     mtDist = Abs(rx - x) + Abs(ry - y)
141.                     If mtDist < mini And mtDist > 1 Then mini = mtDist: saveX = x: saveY = y
142.                 End If
143.             Next
144.         Next
145.  
146.         If mini = 10000000 Then 'we did not find an empty cell we passed by not a single one!?!?
147.             ' I hope we never have to here!!!  I am betting we never should unless a really odd perfect storm
148.             Beep ' signal we had to resort to magically finding and empty cell
149.             MagicRequired = MagicRequired + 1 'set flag, no the amount of times
150.             delayFlag = -1 ' I want to see where I had to use magic
151.             prepStepMap rx, ry
152.             For y = 1 To MapH ' now run through step map and find the mini closest empty room
153.                 For x = 1 To MapW
154.                     If StepMap(x, y) > 1 Then ' has to be > 1 because 0 is robot and 1 the robot will detect!
155.                         If StepMap(x, y) < mini And Room(x, y) = 0 Then mini = StepMap(x, y): saveX = x: saveY = y
156.                     End If
157.                 Next
158.             Next
159.         End If
160.  
161.         'OK we have our target not find a clear short path to it from roby
162.         path rx, ry, saveX, saveY ' path sets stepI, stepX(i), stepY(I) that are shared
163.  
164.         If delayFlag Then Sleep ' let's get a good look at the empty cell we had to magically find
165.  
166.         StepI = 1 ' roby is on it's way to closet empty cell
167.  
168.         'debug
169.         'Print StepI, StepX(StepI), StepY(StepI)
170.         '_display
171.         'Beep
172.         'Sleep ' let me see that path we made
173.  
174.         rx = StepX(StepI): ry = StepY(StepI)
175.     Else
176.         ' beeline mode
177.         StepI = StepI + 1 ' roby is on it's way to closet empty cell
178.         rx = StepX(StepI): ry = StepY(StepI)
179.  
180.         'turn of beeLine mode when we have hit target
181.         If StepI = StepDist - 1 Then BeeLine = 0 ' we have arrived at our target turn off beeLine mode
182.     End If
183. End Sub
184.  
185. Sub drawRoom
186.     Dim As Long x, y
187.     Dim s$
188.     Cls
189.     drawGridSq
190.     For y = 1 To MapH
191.         For x = 1 To MapW
192.             If Room(x, y) = -1 Then
193.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), 8, BF
194.             ElseIf Room(x, y) = -2 Then
195.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), 0, BF
196.             ElseIf Room(x, y) < -2 Then
197.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), Abs(Room(x, y)) - 15, BF
198.             ElseIf Room(x, y) > 0 Then
199.                 s$ = _Trim$(Str$(Room(x, y)))
200.                 _PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
201.             ElseIf Room(x, y) = 0 Then ' i want to see if the room is listed in the stack between pull and stack
202.                 If mt(x, y) = -1 Then 'signal an mt cell that is known to RI
203.                     _PrintString ((x - 1) * 30 + (30 - 8) / 2, (y - 1) * 30 + 7), "*"
204.                 End If
205.             End If
206.         Next
207.     Next
208.     ' and robot
209.     Line ((rx - 1) * 30, (ry - 1) * 30)-Step(30, 30), 14, BF
210. End Sub
211.  
212. Sub MakeRoom
213.     ReDim As Long Room(1 To MapW, 1 To MapH) ' 0 = empty, -1 = wall, -2 = area vac can't access because walled out
214.     Dim As Long x, y, i, rw, rh, wall, ys, xs, clr
215.     ' Here are the walls
216.     For x = 1 To MapW
217.         Room(x, 1) = -1
218.         Room(x, MapH) = -1
219.     Next
220.     For y = 1 To MapH
221.         Room(1, y) = -1
222.         Room(MapW, y) = -1
223.     Next
224.  
225.     ' add random rectangles around the edges
226.     For i = 1 To Int(Sqr(1.5 * MapW * MapH))
227.         rw = Int(Rnd * 4) + 1: rh = Int(Rnd * 4) + 1: clr = -1 * ((Int(Rnd * 13) + 1) + 15)
228.         wall = Int(Rnd * 4)
229.         Select Case wall
230.             Case 0 ' top
231.                 If Rnd < .5 Then ys = 2 Else ys = 4
232.                 xs = irnd&(2, MapW - 1 - rw)
233.                 For y = ys To ys + rh - 1
234.                     For x = xs To xs + rw - 1
235.                         Room(x, y) = clr
236.                     Next
237.                 Next
238.             Case 1 'right
239.                 If Rnd < .5 Then xs = MapW - 1 - rw Else xs = (MapW - 3) - rw
240.                 ys = irnd(2, MapH - 1 - rh)
241.                 For y = ys To ys + rh - 1
242.                     For x = xs To xs + rw - 1
243.                         Room(x, y) = clr
244.                     Next
245.                 Next
246.             Case 2 ' bottom
247.                 If Rnd < .5 Then ys = MapH - rh - 1 Else ys = (MapH - 2) - rh - 1
248.                 xs = irnd(2, MapW - 1 - rw)
249.                 For y = ys To ys + rh - 1
250.                     For x = xs To xs + rw - 1
251.                         Room(x, y) = clr
252.                     Next
253.                 Next
254.             Case 3 'left
255.                 If Rnd < .5 Then xs = 2 Else xs = 5
256.                 ys = irnd(2, MapH - rh - 1)
257.                 For y = ys To ys + rh - 1
258.                     For x = xs To xs + rw - 1
259.                         Room(x, y) = clr
260.                     Next
261.                 Next
262.         End Select
263.     Next
264.  
265.     ' before make map make sure rx, ry is set or reset
266.     prepStepMap rx, ry ' see what cells not accessible to vac mark them -1
267.     For y = 1 To MapH
268.         For x = 1 To MapW
269.             If Room(x, y) = 0 Then
270.                 If StepMap(x, y) = 0 Then Room(x, y) = -2
271.             End If
272.         Next
273.     Next
274.     Room(rx, ry) = 0 ' not a -2 room!
275. End Sub
276.  
277. Sub drawGridSq
278.     Dim As Long x, y
279.     For x = 0 To Cell * MapW Step Cell
280.         Line (x, 0)-Step(0, Cell * MapH)
281.     Next
282.     For y = 0 To Cell * MapH Step Cell
283.         Line (0, y)-Step(Cell * MapW, 0)
284.     Next
285. End Sub
286.  
287. Function swept%
288.     Dim As Long x, y
289.     For y = 1 To MapH
290.         For x = 1 To MapW
291.             If Room(x, y) = 0 Then Exit Function 'not swept
292.         Next
293.     Next
294.     swept% = -1 ' all clean!
295. End Function
296.  
297. Sub path (sx As Long, sy As Long, tx As Long, ty As Long) ' start x, y to target x, y
298.     Dim As Long dist, cx, cy, cf, y, x
299.     prepStepMap tx, ty
300.     dist = StepMap(sx, sy) 'STEPMAP is DIM SHARED as INTEGER
301.     StepDist = dist
302.     If dist = 0 Or Room(tx, ty) = -1 Then
303.         StepI = 0
304.         ' Beep
305.         Color 0, 15
306.         _PrintString (200, 300), "Target:" + Str$(tx) + "," + Str$(ty) + " is bad, fatal error."
307.         _Display
308.         Sleep
309.         End
310.     End If
311.     'refresh
312.     ReDim As Long StepX(1 To MapW * MapH), StepY(1 To MapW * MapH)
313.     StepI = 0 'DIM SHARED error signal
314.     cx = sx: cy = sy
315.     While dist >= 2
316.         'LOCATE 2, 1: PRINT "cx, cy: "; cx, cy '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< debug
317.         cf = 0
318.         For y = cy - 1 To cy + 1
319.             For x = cx - 1 To cx + 1
320.                 'PRINT "x, y, STEPMAP(x, y) "; x, y, STEPMAP(x, y)
321.                 If StepMap(x, y) = dist - 1 Then
322.                     StepI = StepI + 1
323.                     StepX(StepI) = x: StepY(StepI) = y
324.                     Line ((StepX(StepI) - 1) * 30 + 1, (StepY(StepI) - 1) * 30 + 2)-Step(30 - 2, 30 - 1), 13, B
325.                     Line ((StepX(StepI) - 1) * 30 + 2, (StepY(StepI) - 1) * 30 + 2)-Step(30 - 2, 30 - 2), 13, B
326.                     Line ((StepX(StepI) - 1) * 30 + 3, (StepY(StepI) - 1) * 30 + 2)-Step(30 - 2, 30 - 3), 13, B
327.                     cf = 1: Exit For
328.                 End If
329.             Next
330.             If cf = 1 Then Exit For
331.         Next
332.         If cf = 0 Then 'lost path
333.             Exit Sub
334.         Else
335.             cx = StepX(StepI): cy = StepY(StepI)
336.             dist = dist - 1
337.         End If
338.     Wend
339.     _Display
340.     _Delay .6
341. End Sub
342.  
343. Sub prepStepMap (tx As Long, ty As Long) ' ========================================== no more diagonal steps
344.     Dim As Long x, y, tick, changes, ystart, ystop, xstart, xstop
345.     Dim s$ 'debug
346.  
347.     ReDim As Long StepMap(1 To MapW, 1 To MapH)
348.     If tx > 0 And tx <= MapW And ty > 0 And ty <= MapH Then
349.         StepMap(tx, ty) = 1: tick = 1: changes = 1
350.         While changes
351.             tick = tick + 1: changes = 0
352.             ystart = max(ty - tick, 1): ystop = min(ty + tick, MapH)
353.             For y = ystart To ystop
354.                 xstart = max(tx - tick, 1): xstop = min(tx + tick, MapW)
355.                 For x = xstart To xstop
356.                     'check out the neighbors
357.                     If Room(x, y) >= 0 Then ' places OK to go
358.                         'cf = 0
359.                         ' ============================================================= new >>> path finder  that won't take diagonal steps
360.                         'need to check 4 cells around x, y for parent
361.                         If StepMap(x - 1, y) = tick - 1 And StepMap(x, y) = 0 Then
362.                             StepMap(x, y) = tick
363.                             ' 2 line debug  =====================================================
364.                             's$ = _Trim$(Str$(StepMap(x, y)))
365.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
366.                             changes = 1: GoTo skip
367.                         End If
368.                         If StepMap(x + 1, y) = tick - 1 And StepMap(x, y) = 0 Then
369.                             StepMap(x, y) = tick
370.                             ' debug
371.                             's$ = _Trim$(Str$(StepMap(x, y)))
372.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
373.                             changes = 1: GoTo skip
374.                         End If
375.                         If StepMap(x, y - 1) = tick - 1 And StepMap(x, y) = 0 Then
376.                             StepMap(x, y) = tick
377.                             ' debug
378.                             's$ = _Trim$(Str$(StepMap(x, y)))
379.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
380.                             changes = 1: GoTo skip
381.                         End If
382.                         If StepMap(x, y + 1) = tick - 1 And StepMap(x, y) = 0 Then
383.                             StepMap(x, y) = tick
384.                             ' debug
385.                             's$ = _Trim$(Str$(StepMap(x, y)))
386.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
387.                             changes = 1
388.                         End If
389.                         skip:
390.                     End If
391.                 Next
392.             Next
393.         Wend
394.     Else
395.         'Beep
396.         Color 0, 13
397.         _PrintString (200, 300), "Target:" + Str$(tx) + "," + Str$(ty) + " is bad, fatal error."
398.         _Display
399.         Sleep
400.         End
401.     End If
402. End Sub
403.  
404. Function min (n1, n2)
405.     If n1 > n2 Then min = n2 Else min = n1
406. End Function
407.  
408. Function max (n1, n2)
409.     If n1 < n2 Then max = n2 Else max = n1
410. End Function
411.  
412. Function irnd& (n1, n2) 'return an integer between 2 numbers
413.     Dim l%, h%
414.     If n1 > n2 Then l% = n2: h% = n1 Else l% = n1: h% = n2
415.     irnd& = Int(Rnd * (h% - l% + 1)) + l%
416. End Function
417.  
418.  

[MasterGy]

This is a very interesting experiment! I think the trip has been effective!

[bplus]

This is a very interesting experiment! I think the trip has been effective!

Thank you sir! I am getting much better feedback here than at Liberty Forum :)

You all are just smarter I guess ;-))

I really think I will get it improved today when I start measuring path lengths to open / mt (empty) cells RI has memorized. But what a difference since the start!

[bplus]

OK this is selecting the empty cell that has shortest path to it when the RI is surrounded by already passed through cells, as opposed to going to the closest empty cell as the crow flies (rectangularly).

It might be a shade better.

Code: QB64: [Select]

1. Option _Explicit
2. _Title "I Robot - Room Mapper 5 (IR-RM5)" ' b+ 22-02-11
3. ' 22-02-23 started writing code
4. ' The little guy, say a vaccum cleaner, is plopped down somewhere in it's new home.
5. ' The first order of business is to map out it's area of duty,
6. ' say sweep the whole floor without getting stuck or wasting allot of moves.
7. ' It is square and can sense, resistence on any of its edges.
8. ' It is allowed to go N,S,E,W - the four directions
9. ' If something is sensed on one side it is forbidden to
10. ' enter that square from that direction.
11. ' Rule of economy - don't reenter a square already occupied
12. ' unless that is the only way to go.
13. ' Do we have enough spelled out to map a room?
14.  
15. ' A room is a grid of squares, we don't know the dimensions
16. ' and there are objects in many of the middle squares or along
17. ' the walls. Later we may encounter objects that move around
18. ' like pets or results of fickle home decorators.
19.  
20. ' God provides a room with objetcs and randomly drops the robot
21. ' into it.
22.  
23. ' 22-02-23 first goal is to get an edges mapped. so make up a room
24. ' Upon some more thinking and just to get the ball rolling, I will
25. ' allow robot vaccum sweeper to use the room map and mark it with it's
26. ' own numbers, so now the walls are -1, empty areas 0, places visited
27. ' are positive numbers, everytime the vacuum reoccupies the square
28. ' the number is increased.
29. ' OK the room setup seems satisfactory onto RI = Robot Intelligence
30.  
31. ' OK first run it does eventually cover the whole room.
32. ' Need to know when it has done the whole room. There are some
33. ' places that have to be left 0
34.  
35. ' IR-RM2 next mod
36. ' 2022-02-24 what I need is path finder, then I can see which squares are
37. ' accessible to robot from middle of the room, so I can mark and then
38. ' I will be able to tell when Robot has visited all spaces it can.
39. ' ALSO I can use pathfinder to get at next closest enpty square.
40. ' OK the subs from PathFinder 3a are loaded and working with Option _Explicit.
41.  
42. ' Next job is to mark all places vacuum can access checks, so we can then
43. ' have a check to see if all areas covered by vac.
44.  
45. ' 2022-02-26 Got the bug causing once in a blue moon problem with room fills
46. ' ie leaving empty spaces not accessible to vacuum. Could the other once in a blue
47. ' moon problem be similar. RI is trying to path to target at 0,0.
48. ' Ho, ho yes! very likely the same problem!!!
49. ' 2022-02-27 fix some things color the furniture, debug the way the furniture
50. ' was supposed to be placed around the room ie not into the walls!
51.  
52. ' IR-RM3 next mod,
53. ' 2022-02-28  give RI a stack to save locations of empty cells it passes by.
54. ' I think that might improve performance because it will get unswept sections
55. ' while it's still nearby? That is the hypothesis, now for the experiment.
56. ' Stack is NOT WORKING this code is dead end!
57.  
58. ' IR_RM4 next mod
59. ' Every space the RI occupies, update the 4 cell neighbor status as empty or not
60. ' in an empty cell array, then when RI needs to know closest empty use that map.
61. ' OK that works but now find the shortest path lengths to an empty cell.
62.  
63. ' IR-RM5
64. ' 2022-03-01 Today we find the mt cell with shortest path to roby.
65. ' That got working right quick. I want to test another patern for priortizing
66. ' which empty cell order to use.
67.  
68.  
69. Randomize Timer
70. Const SW = 1021, SH = 721 ' cell @30 max 34x24
71. Const Cell = 30
72. Const MapW = 17, MapH = 17 ' min @30 cell is 17, 17
73. Screen _NewImage(SW, SH, 12)
74. _ScreenMove 150, 20
75.  
76. ReDim Shared As Long mt(1 To MapW, 1 To MapH)
77. Dim Shared As Long MagicRequired ' this is to signal that RI could not find the next empty cell without appeal to Gods
78.  
79. Dim Shared As Long BeeLine, Done ' Roby is in beeLine Mode heading to closet empty (unvac'd) cell using steps from Path Finder app
80. ReDim Shared As Long StepMap(1 To MapW, 1 To MapH) ' for making paths that you step through
81. Dim Shared As Long StepI, StepDist
82. ReDim Shared As Long StepX(1 To MapW * MapH), StepY(1 To MapW * MapH)
83.  
84. ReDim Shared As Long Room(1 To MapW, 1 To MapH) ' 0 = empty -1 = wall see MakeRoom
85. Dim Shared As Long rx, ry ' robot location
86. Dim As Long sweeps
87. Do
88.     Done = 0
89.     rx = Int(MapW / 2 + .5): ry = Int(MapH / 2 + .5) ' starts here in middle of room should be clear
90.     ReDim Shared As Long mt(1 To MapW, 1 To MapH)
91.     MakeRoom
92.     Do
93.         drawRoom 'ok the middle of room is staying clear of stuff
94.  
95.         ' debug check path works
96.         'path rx, ry, 5, 5 'does this still work  OH YEAH! Better than ever!
97.         '_Display
98.  
99.         RI ' ok roby make your move
100.         _Display
101.         _Limit 5
102.         If Done Then Cls: drawRoom: Exit Do
103.  
104.         ' debug just checking rooms made right
105.         'Sleep
106.         'Cls
107.         'Exit Do
108.     Loop
109.     'Print "Finished press any for next run   zzz..."
110.     'Sleep
111.     sweeps = sweeps + 1
112.     _Title "I Robot - Room Mapper 2 (IR-RM2) " + Str$(sweeps) + " successful rooms swept, magic needed" + Str$(MagicRequired) + " times."
113.     _Display
114.     _Delay 1
115. Loop
116.  
117. Sub RI ' the robot appraises it's current postition rx, ry in Room(x) and makes a move changing rx, ry and that ends the sub
118.     Dim As Long mini, x, y, saveX, saveY, mtDist, delayFlag
119.  
120.     ' I was here!  sweeps the spot (again?)
121.     Room(rx, ry) = Room(rx, ry) + 1 ' put roby's presense on map
122.     mt(rx, ry) = 0 'no longer mt
123.  
124.     ' remember what we found here when we need an empty cell loaction
125.     If Room(rx, ry - 1) = 0 Then mt(rx, ry - 1) = -1
126.     If Room(rx + 1, ry) = 0 Then mt(rx + 1, ry) = -1
127.     If Room(rx, ry + 1) = 0 Then mt(rx, ry + 1) = -1
128.     If Room(rx - 1, ry) = 0 Then mt(rx - 1, ry) = -1
129.  
130.  
131.     ' after marking current spot see if we have swept all possible
132.     If swept% Then Done = -1: Exit Sub
133.  
134.     If BeeLine = 0 Then ' normal sweeping pattern, hey try up/down then right/left see if leaves less spots
135.         If Room(rx, ry - 1) = 0 Then ry = ry - 1: Exit Sub
136.         If Room(rx + 1, ry) = 0 Then rx = rx + 1: Exit Sub
137.         If Room(rx, ry + 1) = 0 Then ry = ry + 1: Exit Sub
138.         If Room(rx - 1, ry) = 0 Then rx = rx - 1: Exit Sub
139.  
140.         ' still here ?  ========== Decide to make a BeeLine - find the closet empty and make a bee-line to it
141.         BeeLine = -1 'put us into BeeLine Mode
142.         'do we have an empty cell location in the stack
143.  
144.         prepStepMap rx, ry ' this will get us a map of how far away all accessible cells are
145.         ' now consult stepMap of x,y
146.  
147.         mini = 10000000: delayFlag = 0
148.         For y = 1 To MapH ' now run through step map and find the mini closest empty room
149.             For x = 1 To MapW
150.                 If mt(x, y) = -1 Then ' a known empty cell we passed
151.                     mtDist = StepMap(x, y)
152.                     If mtDist < mini And mtDist > 1 Then mini = mtDist: saveX = x: saveY = y
153.                 End If
154.             Next
155.         Next
156.  
157.         'from a number of runs with IR-RM4 this should not ever be needed but just in case
158.         If mini = 10000000 Then 'we did not find an empty cell we passed by, not a single one!?!?
159.             ' I hope we never have to here!!!  I am betting we never should unless a really odd perfect storm
160.             Beep ' signal we had to resort to magically finding and empty cell
161.             MagicRequired = MagicRequired + 1 'set flag, no the amount of times
162.             delayFlag = -1 ' I want to see where I had to use magic
163.  
164.             For y = 1 To MapH ' now run through step map and find the mini closest empty room
165.                 For x = 1 To MapW
166.                     If StepMap(x, y) > 1 Then ' has to be > 1 because 0 is robot and 1 the robot will detect!
167.                         If StepMap(x, y) < mini And Room(x, y) = 0 Then mini = StepMap(x, y): saveX = x: saveY = y
168.                     End If
169.                 Next
170.             Next
171.         End If
172.  
173.         'OK we have our target not find a clear short path to it from roby
174.         path rx, ry, saveX, saveY ' path sets stepI, stepX(i), stepY(I) that are shared
175.  
176.         If delayFlag Then Sleep ' let's get a good look at the empty cell we had to magically find
177.  
178.         StepI = 1 ' roby is on it's way to closet empty cell
179.  
180.         'debug
181.         'Print StepI, StepX(StepI), StepY(StepI)
182.         '_display
183.         'Beep
184.         'Sleep ' let me see that path we made
185.  
186.         rx = StepX(StepI): ry = StepY(StepI)
187.     Else
188.         ' beeline mode
189.         StepI = StepI + 1 ' roby is on it's way to closet empty cell
190.         rx = StepX(StepI): ry = StepY(StepI)
191.  
192.         'turn of beeLine mode when we have hit target
193.         If StepI = StepDist - 1 Then BeeLine = 0 ' we have arrived at our target turn off beeLine mode
194.     End If
195. End Sub
196.  
197. Sub drawRoom
198.     Dim As Long x, y
199.     Dim s$
200.     Cls
201.     drawGridSq
202.     For y = 1 To MapH
203.         For x = 1 To MapW
204.             If Room(x, y) = -1 Then
205.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), 8, BF
206.             ElseIf Room(x, y) = -2 Then
207.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), 0, BF
208.             ElseIf Room(x, y) < -2 Then
209.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), Abs(Room(x, y)) - 15, BF
210.             ElseIf Room(x, y) > 0 Then
211.                 s$ = _Trim$(Str$(Room(x, y)))
212.                 _PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
213.             ElseIf Room(x, y) = 0 Then ' i want to see if the room is listed in the stack between pull and stack
214.                 If mt(x, y) = -1 Then 'signal an mt cell that is known to RI
215.                     _PrintString ((x - 1) * 30 + (30 - 8) / 2, (y - 1) * 30 + 7), "*"
216.                 End If
217.             End If
218.         Next
219.     Next
220.     ' and robot
221.     Line ((rx - 1) * 30, (ry - 1) * 30)-Step(30, 30), 14, BF
222. End Sub
223.  
224. Sub MakeRoom
225.     ReDim As Long Room(1 To MapW, 1 To MapH) ' 0 = empty, -1 = wall, -2 = area vac can't access because walled out
226.     Dim As Long x, y, i, rw, rh, wall, ys, xs, clr
227.     ' Here are the walls
228.     For x = 1 To MapW
229.         Room(x, 1) = -1
230.         Room(x, MapH) = -1
231.     Next
232.     For y = 1 To MapH
233.         Room(1, y) = -1
234.         Room(MapW, y) = -1
235.     Next
236.  
237.     ' add random rectangles around the edges
238.     For i = 1 To Int(Sqr(1.5 * MapW * MapH))
239.         rw = Int(Rnd * 4) + 1: rh = Int(Rnd * 4) + 1: clr = -1 * ((Int(Rnd * 13) + 1) + 15)
240.         wall = Int(Rnd * 4)
241.         Select Case wall
242.             Case 0 ' top
243.                 If Rnd < .5 Then ys = 2 Else ys = 4
244.                 xs = irnd&(2, MapW - 1 - rw)
245.                 For y = ys To ys + rh - 1
246.                     For x = xs To xs + rw - 1
247.                         Room(x, y) = clr
248.                     Next
249.                 Next
250.             Case 1 'right
251.                 If Rnd < .5 Then xs = MapW - 1 - rw Else xs = (MapW - 3) - rw
252.                 ys = irnd(2, MapH - 1 - rh)
253.                 For y = ys To ys + rh - 1
254.                     For x = xs To xs + rw - 1
255.                         Room(x, y) = clr
256.                     Next
257.                 Next
258.             Case 2 ' bottom
259.                 If Rnd < .5 Then ys = MapH - rh - 1 Else ys = (MapH - 2) - rh - 1
260.                 xs = irnd(2, MapW - 1 - rw)
261.                 For y = ys To ys + rh - 1
262.                     For x = xs To xs + rw - 1
263.                         Room(x, y) = clr
264.                     Next
265.                 Next
266.             Case 3 'left
267.                 If Rnd < .5 Then xs = 2 Else xs = 5
268.                 ys = irnd(2, MapH - rh - 1)
269.                 For y = ys To ys + rh - 1
270.                     For x = xs To xs + rw - 1
271.                         Room(x, y) = clr
272.                     Next
273.                 Next
274.         End Select
275.     Next
276.  
277.     ' before make map make sure rx, ry is set or reset
278.     prepStepMap rx, ry ' see what cells not accessible to vac mark them -1
279.     For y = 1 To MapH
280.         For x = 1 To MapW
281.             If Room(x, y) = 0 Then
282.                 If StepMap(x, y) = 0 Then Room(x, y) = -2
283.             End If
284.         Next
285.     Next
286.     Room(rx, ry) = 0 ' not a -2 room!
287. End Sub
288.  
289. Sub drawGridSq
290.     Dim As Long x, y
291.     For x = 0 To Cell * MapW Step Cell
292.         Line (x, 0)-Step(0, Cell * MapH)
293.     Next
294.     For y = 0 To Cell * MapH Step Cell
295.         Line (0, y)-Step(Cell * MapW, 0)
296.     Next
297. End Sub
298.  
299. Function swept%
300.     Dim As Long x, y
301.     For y = 1 To MapH
302.         For x = 1 To MapW
303.             If Room(x, y) = 0 Then Exit Function 'not swept
304.         Next
305.     Next
306.     swept% = -1 ' all clean!
307. End Function
308.  
309. Sub path (sx As Long, sy As Long, tx As Long, ty As Long) ' start x, y to target x, y
310.     Dim As Long dist, cx, cy, cf, y, x
311.     prepStepMap tx, ty
312.     dist = StepMap(sx, sy) 'STEPMAP is DIM SHARED as INTEGER
313.     StepDist = dist
314.     If dist = 0 Or Room(tx, ty) = -1 Then
315.         StepI = 0
316.         ' Beep
317.         Color 0, 15
318.         _PrintString (200, 300), "Target:" + Str$(tx) + "," + Str$(ty) + " is bad, fatal error."
319.         _Display
320.         Sleep
321.         End
322.     End If
323.     'refresh
324.     ReDim As Long StepX(1 To MapW * MapH), StepY(1 To MapW * MapH)
325.     StepI = 0 'DIM SHARED error signal
326.     cx = sx: cy = sy
327.     While dist >= 2
328.         'LOCATE 2, 1: PRINT "cx, cy: "; cx, cy '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< debug
329.         cf = 0
330.         For y = cy - 1 To cy + 1
331.             For x = cx - 1 To cx + 1
332.                 'PRINT "x, y, STEPMAP(x, y) "; x, y, STEPMAP(x, y)
333.                 If StepMap(x, y) = dist - 1 Then
334.                     StepI = StepI + 1
335.                     StepX(StepI) = x: StepY(StepI) = y
336.                     Line ((StepX(StepI) - 1) * 30 + 1, (StepY(StepI) - 1) * 30 + 2)-Step(30 - 2, 30 - 1), 10, B
337.                     Line ((StepX(StepI) - 1) * 30 + 2, (StepY(StepI) - 1) * 30 + 2)-Step(30 - 2, 30 - 2), 10, B
338.                     Line ((StepX(StepI) - 1) * 30 + 3, (StepY(StepI) - 1) * 30 + 2)-Step(30 - 2, 30 - 3), 10, B
339.                     Line ((StepX(StepI) - 1) * 30 + 4, (StepY(StepI) - 1) * 30 + 2)-Step(30 - 2, 30 - 4), 10, B
340.                     cf = 1: Exit For
341.                 End If
342.             Next
343.             If cf = 1 Then Exit For
344.         Next
345.         If cf = 0 Then 'lost path
346.             Exit Sub
347.         Else
348.             cx = StepX(StepI): cy = StepY(StepI)
349.             dist = dist - 1
350.         End If
351.     Wend
352.     _Display
353.     _Delay .6
354. End Sub
355.  
356. Sub prepStepMap (tx As Long, ty As Long) ' ========================================== no more diagonal steps
357.     Dim As Long x, y, tick, changes, ystart, ystop, xstart, xstop
358.     Dim s$ 'debug
359.  
360.     ReDim As Long StepMap(1 To MapW, 1 To MapH)
361.     If tx > 0 And tx <= MapW And ty > 0 And ty <= MapH Then
362.         StepMap(tx, ty) = 1: tick = 1: changes = 1
363.         While changes
364.             tick = tick + 1: changes = 0
365.             ystart = max(ty - tick, 1): ystop = min(ty + tick, MapH)
366.             For y = ystart To ystop
367.                 xstart = max(tx - tick, 1): xstop = min(tx + tick, MapW)
368.                 For x = xstart To xstop
369.                     'check out the neighbors
370.                     If Room(x, y) >= 0 Then ' places OK to go
371.                         'cf = 0
372.                         ' ============================================================= new >>> path finder  that won't take diagonal steps
373.                         'need to check 4 cells around x, y for parent
374.                         If StepMap(x - 1, y) = tick - 1 And StepMap(x, y) = 0 Then
375.                             StepMap(x, y) = tick
376.                             ' 2 line debug  =====================================================
377.                             's$ = _Trim$(Str$(StepMap(x, y)))
378.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
379.                             changes = 1: GoTo skip
380.                         End If
381.                         If StepMap(x + 1, y) = tick - 1 And StepMap(x, y) = 0 Then
382.                             StepMap(x, y) = tick
383.                             ' debug
384.                             's$ = _Trim$(Str$(StepMap(x, y)))
385.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
386.                             changes = 1: GoTo skip
387.                         End If
388.                         If StepMap(x, y - 1) = tick - 1 And StepMap(x, y) = 0 Then
389.                             StepMap(x, y) = tick
390.                             ' debug
391.                             's$ = _Trim$(Str$(StepMap(x, y)))
392.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
393.                             changes = 1: GoTo skip
394.                         End If
395.                         If StepMap(x, y + 1) = tick - 1 And StepMap(x, y) = 0 Then
396.                             StepMap(x, y) = tick
397.                             ' debug
398.                             's$ = _Trim$(Str$(StepMap(x, y)))
399.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
400.                             changes = 1
401.                         End If
402.                         skip:
403.                     End If
404.                 Next
405.             Next
406.         Wend
407.     Else
408.         'Beep
409.         Color 0, 13
410.         _PrintString (200, 300), "Target:" + Str$(tx) + "," + Str$(ty) + " is bad, fatal error."
411.         _Display
412.         Sleep
413.         End
414.     End If
415. End Sub
416.  
417. Function min (n1, n2)
418.     If n1 > n2 Then min = n2 Else min = n1
419. End Function
420.  
421. Function max (n1, n2)
422.     If n1 < n2 Then max = n2 Else max = n1
423. End Function
424.  
425. Function irnd& (n1, n2) 'return an integer between 2 numbers
426.     Dim l%, h%
427.     If n1 > n2 Then l% = n2: h% = n1 Else l% = n1: h% = n2
428.     irnd& = Int(Rnd * (h% - l% + 1)) + l%
429. End Function
430.  
431.  

It still makes me cringe when it leaves behind an empty cell or 2 that it will later have to come back to, to cover the room. I don't know maybe like chess we will have to start looking 2 or 3 moves ahead for a smarter bot.

Next is a scoring system (ha maybe again like chess) for evaluating better and worse plans of action.

[Richard Frost]

Another way it could be more like chess would be to replace the yellow square with
a Queen, one  brandishing a broom.

It drops more spies (*) than a C-130.

Will the next version quantum tunnel to isolated rooms?

[bplus]

NOW play the game yourself!

More rework of Room map because it was leaving channel along right and bottom edge.
Remove the RI stuff and just view rooms with spacebar.

See one you want to try yourself press Enter after you have your printer ready.

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Press Enter to Print out Room Map, press space for next room. " ' b+ 22-03-02
3. ' 2022-03-02 Edit IR-RM6 so I can play around with this puzzle with pencil and paper.
4.  
5. Randomize Timer
6. Const SW = 1021, SH = 721 ' cell @30 max 34x24
7. Const Cell = 30
8. Const MapW = 17, MapH = 17 ' min @30 cell is 17, 17
9.  
10. Screen _NewImage(SW, SH, 32)
11. _ScreenMove 150, 20
12.  
13. Dim Shared As _Unsigned Long qb(15)
14. qb(0) = &HFF000000
15. qb(1) = &HFF000088
16. qb(2) = &HFF008800
17. qb(3) = &HFF008888
18. qb(4) = &HFF880000
19. qb(5) = &HFF880088
20. qb(6) = &HFF888800
21. qb(7) = &HFFCCCCCC
22. qb(8) = &HFF888888
23. qb(9) = &HFF0000FF
24. qb(10) = &HFF00FF00
25. qb(11) = &HFF00FFFF
26. qb(12) = &HFFFF0000
27. qb(13) = &HFFFF00FF
28. qb(14) = &HFFFFFF00
29. qb(15) = &HFFFFFFFF
30.  
31. ReDim Shared As Long StepMap(1 To MapW, 1 To MapH) ' for making paths that you step through
32. ReDim Shared As Long Room(1 To MapW, 1 To MapH) ' 0 = empty -1 = wall see MakeRoom
33. Dim Shared As Long rx, ry ' robot location
34. Dim K$
35. rx = Int(MapW / 2 + .5): ry = Int(MapH / 2 + .5)
36. Color qb(0), qb(15)
37. Cls
38. Do
39.     MakeRoom
40.     Do
41.         drawRoom 'ok the middle of room is staying clear of stuff
42.         _Display
43.         K$ = InKey$
44.         While Len(K$) = 0
45.             K$ = InKey$
46.             _Limit 30
47.         Wend
48.         If Asc(K$) = 13 Then PrintLandscapeView Else Exit Do
49.     Loop
50. Loop
51.  
52. Sub drawRoom
53.     Dim As Long x, y
54.     Dim s$
55.     Cls
56.     drawGridSq
57.     For y = 1 To MapH
58.         For x = 1 To MapW
59.             If Room(x, y) = -1 Then
60.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), qb(8), BF
61.             ElseIf Room(x, y) = -2 Then
62.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), qb(1), BF
63.             ElseIf Room(x, y) < -2 Then
64.                 Line ((x - 1) * 30, (y - 1) * 30)-Step(30, 30), qb(3), BF
65.             ElseIf Room(x, y) > 0 Then
66.                 s$ = _Trim$(Str$(Room(x, y)))
67.                 _PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
68.             End If
69.         Next
70.     Next
71.     _PrintString ((rx - 1) * 30 + 12, (ry - 1) * 30 + 8), "X"
72. End Sub
73.  
74. Sub MakeRoom
75.     ReDim As Long Room(1 To MapW, 1 To MapH) ' 0 = empty, -1 = wall, -2 = area vac can't access because walled out
76.     Dim As Long x, y, i, rw, rh, wall, ys, xs, clr
77.     ' Here are the walls
78.     For x = 1 To MapW
79.         Room(x, 1) = -1
80.         Room(x, MapH) = -1
81.     Next
82.     For y = 1 To MapH
83.         Room(1, y) = -1
84.         Room(MapW, y) = -1
85.     Next
86.  
87.     ' add random rectangles around the edges
88.     For i = 1 To Int(Sqr(1.5 * MapW * MapH))
89.         rw = Int(Rnd * 4) + 1: rh = Int(Rnd * 4) + 1: clr = -3
90.         wall = Int(Rnd * 4)
91.         Select Case wall
92.             Case 0 ' top
93.                 If Rnd < .5 Then ys = 2 Else ys = 4
94.                 xs = irnd&(2, MapW - rw)
95.                 For y = ys To ys + rh - 1
96.                     For x = xs To xs + rw - 1
97.                         Room(x, y) = clr
98.                     Next
99.                 Next
100.             Case 1 'right
101.                 If Rnd < .5 Then xs = MapW - rw Else xs = (MapW - 2) - rw
102.                 ys = irnd(2, MapH - rh)
103.                 For y = ys To ys + rh - 1
104.                     For x = xs To xs + rw - 1
105.                         Room(x, y) = clr
106.                     Next
107.                 Next
108.             Case 2 ' bottom
109.                 If Rnd < .5 Then ys = MapH - rh Else ys = (MapH - 2) - rh
110.                 xs = irnd(2, MapW - rw)
111.                 For y = ys To ys + rh - 1
112.                     For x = xs To xs + rw - 1
113.                         Room(x, y) = clr
114.                     Next
115.                 Next
116.             Case 3 'left
117.                 If Rnd < .5 Then xs = 2 Else xs = 4
118.                 ys = irnd(2, MapH - rh)
119.                 For y = ys To ys + rh - 1
120.                     For x = xs To xs + rw - 1
121.                         Room(x, y) = clr
122.                     Next
123.                 Next
124.         End Select
125.     Next
126.  
127.     ' before make map make sure rx, ry is set or reset
128.     prepStepMap rx, ry ' see what cells not accessible to vac mark them -1
129.     For y = 1 To MapH
130.         For x = 1 To MapW
131.             If Room(x, y) = 0 Then
132.                 If StepMap(x, y) = 0 Then Room(x, y) = -2
133.             End If
134.         Next
135.     Next
136.     Room(rx, ry) = 0 ' not a -2 room!
137. End Sub
138.  
139. Sub drawGridSq
140.     Dim As Long x, y
141.     For x = 0 To Cell * MapW Step Cell
142.         Line (x, 0)-Step(0, Cell * MapH)
143.     Next
144.     For y = 0 To Cell * MapH Step Cell
145.         Line (0, y)-Step(Cell * MapW, 0)
146.     Next
147. End Sub
148.  
149. Function irnd& (n1, n2) 'return an integer between 2 numbers
150.     Dim l%, h%
151.     If n1 > n2 Then l% = n2: h% = n1 Else l% = n1: h% = n2
152.     irnd& = Int(Rnd * (h% - l% + 1)) + l%
153. End Function
154.  
155. Sub prepStepMap (tx As Long, ty As Long) ' ========================================== no more diagonal steps
156.     Dim As Long x, y, tick, changes, ystart, ystop, xstart, xstop
157.     Dim s$ 'debug
158.  
159.     ReDim As Long StepMap(1 To MapW, 1 To MapH)
160.     If tx > 0 And tx <= MapW And ty > 0 And ty <= MapH Then
161.         StepMap(tx, ty) = 1: tick = 1: changes = 1
162.         While changes
163.             tick = tick + 1: changes = 0
164.             ystart = max(ty - tick, 1): ystop = min(ty + tick, MapH)
165.             For y = ystart To ystop
166.                 xstart = max(tx - tick, 1): xstop = min(tx + tick, MapW)
167.                 For x = xstart To xstop
168.                     'check out the neighbors
169.                     If Room(x, y) >= 0 Then ' places OK to go
170.                         'cf = 0
171.                         ' ============================================================= new >>> path finder  that won't take diagonal steps
172.                         'need to check 4 cells around x, y for parent
173.                         If StepMap(x - 1, y) = tick - 1 And StepMap(x, y) = 0 Then
174.                             StepMap(x, y) = tick
175.                             ' 2 line debug  =====================================================
176.                             's$ = _Trim$(Str$(StepMap(x, y)))
177.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
178.                             changes = 1: GoTo skip
179.                         End If
180.                         If StepMap(x + 1, y) = tick - 1 And StepMap(x, y) = 0 Then
181.                             StepMap(x, y) = tick
182.                             ' debug
183.                             's$ = _Trim$(Str$(StepMap(x, y)))
184.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
185.                             changes = 1: GoTo skip
186.                         End If
187.                         If StepMap(x, y - 1) = tick - 1 And StepMap(x, y) = 0 Then
188.                             StepMap(x, y) = tick
189.                             ' debug
190.                             's$ = _Trim$(Str$(StepMap(x, y)))
191.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
192.                             changes = 1: GoTo skip
193.                         End If
194.                         If StepMap(x, y + 1) = tick - 1 And StepMap(x, y) = 0 Then
195.                             StepMap(x, y) = tick
196.                             ' debug
197.                             's$ = _Trim$(Str$(StepMap(x, y)))
198.                             '_PrintString ((x - 1) * 30 + (30 - Len(s$) * 8) / 2, (y - 1) * 30 + 7), s$
199.                             changes = 1
200.                         End If
201.                         skip:
202.                     End If
203.                 Next
204.             Next
205.         Wend
206.     Else
207.         'Beep
208.         Color 0, 13
209.         _PrintString (200, 300), "Target:" + Str$(tx) + "," + Str$(ty) + " is bad, fatal error."
210.         _Display
211.         Sleep
212.         End
213.     End If
214. End Sub
215.  
216. Function min (n1, n2)
217.     If n1 > n2 Then min = n2 Else min = n1
218. End Function
219.  
220. Function max (n1, n2)
221.     If n1 < n2 Then max = n2 Else max = n1
222. End Function
223.  
224. Sub PrintLandscapeView ' straight from printing calendars  needs _newimage(x, y, 32)
225.     Dim landscape&
226.     'printer prep
227.     landscape& = _NewImage(SH, SW, 32) ' yes reverse x and y
228.     _MapTriangle (SW, 0)-(0, 0)-(0, SH), 0 To(0, 0)-(0, SW)-(SH, SW), landscape&
229.     _MapTriangle (SW, 0)-(SW, SH)-(0, SH), 0 To(0, 0)-(SH, 0)-(SH, SW), landscape&
230.     _PrintImage landscape& '<<<<<<<<<<<<<<<<<<<<<<<<<    debug first before wasting paper and ink
231.     _Delay 2
232.     _FreeImage landscape&
233. End Sub
234.  
235.  

 

It's now a pencil and paper puzzle! Goal try to draw one line through all squares backtracking as little as possible.

[MasterGy]

what should I do after selecting a room? I may not understand something

[bplus]

what should I do after selecting a room? I may not understand something

Well it works for my printer, press Enter and get a PrintOut of the room you are viewing. Keep hitting Spacebar (or anything NOT Enter)  for a new room on the screen. I don't know how well other people's printers will handle QB64's: _PrintImage IHandle&

This is just if you want to try a Pencil and Paper Puzzle, draw one continuous line through every square in grid trying not to go over same square more than once, some places you have to go over more than once.

[bplus]

I had to figure out how to get my scanner to work to show an example solution to a puzzle:
 

If you can do this room in less than 3 overlap cells then you beat me and the above solution I came up with.

Oops! a blunder at the top (see the missed cell, no line thru it, go thru that instead of repeat), can do that Puzzle in 2 overlaps

[bplus]

Space filling "curve".

I should mention going diagonally is not allowed as the sweeper wouldn't fit between one rectangular obstacle kitty cornered to another, not even close!

[MasterGy]

ah, I get it now, I think it was a very good idea to do this! I didn't print it out (I don't have a printer), but I think it works for me.