Advertisement
verz

Cerchio BAS

Aug 29th, 2019
2,706
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
XBasic 5.09 KB | None | 0 0
  1. rem *** implementa Dijkstra
  2. 1000 print chr$(147);
  3. 1010 s=ti
  4.  
  5. rem *** Caricamento Matrice in c(x,y)
  6. 1020 dim c(23,23)
  7. 1030 for i=1 to 23
  8. 1040 for j=1 to 23
  9. 1050 read c(j,i)
  10. 1060 next
  11. 1070 next
  12.  
  13. rem *** direzioni
  14. 1080 a$(1)="n ": a$(2)="ne": a$(3)="e ": a$(4)="se"
  15. 1090 a$(5)="s ": a$(6)="so": a$(7)="o ": a$(8)="no"
  16.  
  17. rem *** l(): array dei nodi raggiungibili da (12,12)
  18. rem *** v(): array dei nodi visitati
  19. rem *** z ultimo nodo dell'array
  20. rem *** w nodo corrente dell'array
  21. rem *** f numero di nodi finali trovati
  22. 1100 dim l(385,4), v(23,23)
  23. 1110 l(1,1)=12: l(1,2)=12: l(1,4)=0: l(1,3)=0: v(12,12)=1
  24. 1120 x=12: y=12: z=1: w=1: f=1
  25. rem *** l(1)= coord X
  26. rem *** l(2)= coord Y
  27. rem *** l(3)= direzione dal nodo precedente
  28. rem *** l(4)= indice del nodo precedente
  29.  
  30. rem *** d: valore di distanza del nodo corrente
  31. rem *** xp,xm,yp,ym: coordinate raggiungibili dal nodo corrente
  32. 1130 d=c(x,y): if d=10 goto 1710
  33. 1140 xp=x+d: xm=x-d: yp=y+d: ym=y-d
  34.  
  35. rem *** NORD
  36. rem *** se la coordinata verticale è fuori misura passa a SE
  37. rem *** se il nodo destinatario è già visitato o è fuori cerchio passa a NE
  38. rem *** se il nodo precedente adiacente è finale allora passa a NE
  39. rem *** se il nodo è finale va a stampare il percorso
  40. 1150     if ym < 1 goto 1290
  41. 1170 if v(x,ym)=1  goto 1220
  42. 1180 if c(x,ym)=0  goto 1220
  43. 1190 if c(x,ym+1)=10 goto 1220
  44. 1200 z=z+1: l(z,1)=x : l(z,2)=ym: l(z,4)=w: l(z,3)=1: v(x,ym)=1
  45. 1210 if c(x,ym)=10 then gosub 1980
  46.  
  47. rem *** NORDEST
  48. 1220     if         xp >23 goto 1430
  49. 1240 if v(xp,ym)=1  goto 1290
  50. 1250 if c(xp,ym)=0  goto 1290
  51. 1260 if c(xp-1,ym+1)=10 goto 1290
  52. 1270 z=z+1: l(z,1)=xp: l(z,2)=ym: l(z,4)=w: l(z,3)=2: v(xp,ym)=1
  53. 1280 if c(xp,ym)=10 then gosub 1980
  54.  
  55. rem *** EST
  56. 1290     if         xp >23 goto 1430
  57. 1310 if v(xp,y)=1 goto 1360
  58. 1320 if c(xp,y)=0  goto 1360
  59. 1330 if c(xp-1,y)=10 goto 1360
  60. 1340 z=z+1: l(z,1)=xp: l(z,2)=y : l(z,4)=w: l(z,3)=3: v(xp,y)=1
  61. 1350 if c(xp,y)=10 then gosub 1980
  62.  
  63. rem *** SUDEST
  64. 1360     if yp >23  goto 1570
  65. 1380 if v(xp,yp)=1 goto 1430
  66. 1390 if c(xp,yp)=0 goto 1430
  67. 1400 if c(xp-1,yp-1)=10 goto 1430
  68. 1410 z=z+1: l(z,1)=xp: l(z,2)=yp: l(z,4)=w: l(z,3)=4: v(xp,yp)=1
  69. 1420 if c(xp,yp)=10 then gosub 1980
  70.  
  71. rem *** SUD
  72. 1430     if yp >23 goto 1570
  73. 1450 if v(x,yp)=1 goto 1500
  74. 1460 if c(x,yp)=0 goto 1500
  75. 1470 if c(x,yp-1)=10 goto 1500
  76. 1480 z=z+1: l(z,1)=x : l(z,2)=yp: l(z,4)=w: l(z,3)=5: v(x,yp)=1
  77. 1490 if c(x,yp)=10 then gosub 1980
  78.  
  79. rem *** SUDOVEST
  80. 1500     if         xm < 1 goto 1710
  81. 1520 if v(xm,yp)=1 goto 1570
  82. 1530 if c(xm,yp)=0 goto 1570
  83. 1540 if c(xm+1,yp-1)=10 goto 1570
  84. 1550 z=z+1: l(z,1)=xm: l(z,2)=yp: l(z,4)=w: l(z,3)=6: v(xm,yp)=1
  85. 1560 if c(xm,yp)=10 then gosub 1980
  86.  
  87. rem *** OVEST
  88. 1570     if         xm < 1 goto 1710
  89. 1590 if v(xm,y)=1 goto 1640
  90. 1600 if c(xm,y)=0 goto 1640
  91. 1610 if c(xm+1,y)=10 goto 1640
  92. 1620 z=z+1: l(z,1)=xm: l(z,2)=y : l(z,4)=w: l(z,3)=7: v(xm,y)=1
  93. 1630 if c(xm,y)=10 then gosub 1980
  94.  
  95. rem *** NORDOVEST
  96. 1640     if ym < 1  goto 1710
  97. 1660 if v(xm,ym)=1 goto 1710
  98. 1670 if c(xm,ym)=0 goto 1710
  99. 1680 if c(xm+1,ym+1)=10 goto 1710
  100. 1690 z=z+1: l(z,1)=xm: l(z,2)=ym: l(z,4)=w: l(z,3)=8: v(xm,ym)=1
  101. 1700 if c(xm,ym)=10 then gosub 1980
  102.  
  103. rem *** va al prossimo nodo, se non siamo oltre la fine...
  104. 1710 w=w+1: x=l(w,1): y=l(w,2): if w<=z goto 1130
  105.  
  106. rem *** chiusura
  107. 1720 print "tempo di calcolo: " (ti-s)/60 "sec";
  108. 1730 get b$: if b$="" then 1730
  109. 1740 end
  110.  
  111. 1750 data 0,0,0,0,0,0,0,0,0,0,10,10,10,0,0,0,0,0,0,0,0,0,0
  112. 1760 data 0,0,0,0,0,0,0,10,10,10,4,7,7,10,10,10,0,0,0,0,0,0,0
  113. 1770 data 0,0,0,0,0,10,10,5,4,4,8,3,3,4,6,3,10,10,0,0,0,0,0
  114. 1780 data 0,0,0,0,10,1,4,5,1,1,1,4,5,1,7,1,3,5,10,0,0,0,0
  115. 1790 data 0,0,0,10,4,9,4,9,6,7,5,5,5,8,7,6,6,8,5,10,0,0,0
  116. 1800 data 0,0,10,3,7,2,9,8,3,5,6,7,3,9,1,8,7,5,8,5,10,0,0
  117. 1810 data 0,0,10,1,4,7,8,4,2,9,2,7,1,1,8,2,2,7,6,3,10,0,0
  118. 1820 data 0,10,7,2,1,8,5,5,3,1,1,3,1,3,3,4,2,8,6,1,3,10,0
  119. 1830 data 0,10,4,2,6,7,2,5,2,4,2,2,5,4,3,2,8,1,7,7,3,10,0
  120. 1840 data 0,10,4,1,6,5,1,1,1,9,1,4,3,4,4,3,1,9,8,2,7,10,0
  121. 1850 data 10,4,3,5,2,3,2,2,3,2,4,2,5,3,5,1,1,3,5,5,3,7,10
  122. 1860 data 10,2,7,1,5,1,1,3,1,5,3,3,2,4,2,3,7,7,5,4,2,7,10
  123. 1870 data 10,2,5,2,2,6,1,2,4,4,6,3,4,1,2,1,2,6,5,1,8,8,10
  124. 1880 data 0,10,4,3,7,5,1,9,3,4,4,5,2,9,4,1,9,5,7,4,8,10,0
  125. 1890 data 0,10,4,1,6,7,8,3,4,3,4,1,3,1,2,3,2,3,6,2,4,10,0
  126. 1900 data 0,10,7,3,2,6,1,5,3,9,2,3,2,1,5,7,5,8,9,5,4,10,0
  127. 1910 data 0,0,10,1,6,7,3,4,8,1,1,1,2,1,2,2,8,9,4,1,10,0,0
  128. 1920 data 0,0,10,2,5,4,7,8,7,5,6,1,3,5,7,8,7,2,9,3,10,0,0
  129. 1930 data 0,0,0,10,6,5,6,4,6,7,2,5,2,2,6,3,4,7,4,10,0,0,0
  130. 1940 data 0,0,0,0,10,2,3,1,2,3,3,3,2,1,3,2,1,1,10,0,0,0,0
  131. 1950 data 0,0,0,0,0,10,10,7,4,4,5,7,3,4,4,7,10,10,0,0,0,0,0
  132. 1960 data 0,0,0,0,0,0,0,10,10,10,3,3,4,10,10,10,0,0,0,0,0,0,0
  133. 1970 data 0,0,0,0,0,0,0,0,0,0,10,10,10,0,0,0,0,0,0,0,0,0,0
  134.  
  135. rem *** stampa il percorso trovato (all'indietro)
  136. 1980 print "soluzione "; f: print" ^  *fine*   ";
  137. 1990 k=z: f=f+1
  138. 2000 p=l(k,1): q=l(k,2)
  139. 2010 if c(p,q)<10 then print "per"c(p,q)"passi da";
  140. 2020 print " ("mid$(str$(p),2);",";mid$(str$(q),2)")"
  141. 2030 print" "+chr$(125)+"  ";a$(l(k,3));" ";
  142. 2040 k=l(k,4): if k>1 goto 2000
  143. 2050 print "per"c(12,12)"passi da (12,12)":print
  144. 2060 return
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement