Artifical Intelegentce 1 : TSP

[bluatigro]

deze listning probeert het
Traveling Salesmen Problem
op te lossen of een goede benadering te bedenken
TSP :
je wilt reizen langs n reeks steden
wat is de kortste weg langs alle steden
als je elke 1 keer bezoekt

Code: Selecteer alles

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global citymax , routemax , YN$
citymax = 100
routemax = 100
dim x( citymax ) , y( citymax ) , hh( citymax )
dim r( routemax + 1 , citymax ) , d( routemax )
dim rij( routemax )
for i = 0 to routemax
  rij( i ) = i
next i
nomainwin
timer 1000 , [tmr]
for i = 1 to citymax - 1
  x( i ) = 20 + rnd( 0 ) * ( WindowWidth - 40 )
  y( i ) = 20 + rnd( 0 ) * ( WindowHeight - 40 )
next i
confirm "TSP fast ?" ; YN$
open "TSP" for graphics as #m
  #m , "trapclose [quit]"
wait
[tmr]
  for i = 0 to routemax
    d( i ) = afstand( i )
  next i
  for h = 1 to routemax
    for l = 0 to h
      if d( rij( h ) ) < d( rij( l ) ) then
        i = rij( h )
        rij( h ) = rij( l )
        rij( l ) = i
      end if
    next l
  next h
  for i = 10 to routemax
    a = rnd( 0 ) * ( citymax - 1 ) + 1
    b = rnd( 0 ) * ( citymax - 1 ) + 1
    if a > b then
      h = a : a = b : b = h
    end if
    if YN$ = "yes" then
      for t = a to b
        hh( t - a ) = r( rij( i ) , t )
      next t
      for t = a to b
        r( rij( i ) , t ) = hh( b - t )
      next t
    else
      h = r( rij( i ) , a )
      r( rij( i ) , b ) = r( rij( i ) , a )
      r( rij( i ) , a ) = h
    end if
  next i
  #m , "cls"
  #m , "down"
  #m , "goto 0 0"
  for i = 0 to citymax
    a = x( r( rij( 0 ) , i ) )
    b = y( r( rij( 0 ) , i ) )
    #m , "color black"
    #m , "goto " ; a ; " " ; b
    #m , "backcolor red"
    #m , "circlefilled 10"
  next i
  #m , "up"
  #m , "flush"
wait
function afstand( no )
  som = 0
  for i = 1 to citymax
    dx = x( r( no , i ) ) - x( r( no , i - 1 ) )
    dy = y( r( no , i ) ) - y( r( no , i - 1 ) )
    som = som + sqr( dx ^ 2 + dy ^ 2 + 1e-10 )
  next i
  afstand = som
end function
[quit]
  #m , "close"
end


probleem : de [tmr] sub tekend niet alle steden

[Gordon]

Twee opmerkingen vooraf:
- kun je alle statements waarin de functie rnd( wordt gebruikt aanpassen in
int(rnd(x) enz.? Ik weet niet wat een for next loop met waarden van
0.0756 tot 2.008765 precies doet.
- kun je ook close #m aanpassen?

a en b zijn altijd 0

Gordon

[bluatigro]

OK

Code: Selecteer alles

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global citymax , routemax , YN$
citymax = 100
routemax = 100
dim x( citymax ) , y( citymax ) , hh( citymax )
dim r( routemax + 1 , citymax ) , d( routemax )
dim rij( routemax )
for i = 0 to routemax
  rij( i ) = i
next i
nomainwin
for i = 1 to citymax - 1
  x( i ) = 20 + rnd( 0 ) * ( WindowWidth - 40 )
  y( i ) = 20 + rnd( 0 ) * ( WindowHeight - 40 )
next i
confirm "TSP fast ?" ; YN$
timer 1000 , [tmr]
open "TSP" for graphics as #m
  #m , "trapclose [quit]"
wait
[tmr]
  for i = 0 to routemax
    d( i ) = afstand( i )
  next i
  for h = 1 to routemax
    for l = 0 to h - 1
      if d( rij( h ) ) < d( rij( l ) ) then
        i = rij( h )
        rij( h ) = rij( l )
        rij( l ) = i
      end if
    next l
  next h
  for i = 1 to routemax
    a = int( rnd( 0 ) * ( citymax - 2 ) + 1 )
    b = int( rnd( 0 ) * ( citymax - 2 ) + 1 )
    if a > b then
      h = a : a = b : b = h
    end if
    if YN$ = "yes" then
      for t = a to b
        hh( t - a ) = r( rij( i ) , t )
      next t
      for t = a to b
        r( rij( i ) , t ) = hh( b - t )
      next t
    else
      h = r( rij( i ) , a )
      r( rij( i ) , a ) = r( rij( i ) , b )
      r( rij( i ) , b ) = h
    end if
  next i
  #m , "cls"
  #m , "down"
  #m , "goto 0 0"
  for i = 1 to citymax - 1
    a = x( r( rij( 0 ) , i ) )
    b = y( r( rij( 0 ) , i ) )
    #m , "color black"
    #m , "goto " ; a ; " " ; b
    #m , "backcolor red"
    #m , "circlefilled 10"
  next i
  #m , "goto 0 0"
  #m , "up"
  #m , "flush"
wait
function afstand( no )
  som = 0
  for i = 1 to citymax
    dx = x( r( no , i ) ) - x( r( no , i - 1 ) )
    dy = y( r( no , i ) ) - y( r( no , i - 1 ) )
    som = som + sqr( dx ^ 2 + dy ^ 2 + 1e-10 )
  next i
  afstand = som
end function
[quit]
  close #m
end


+ wat andere errors eruit
maar ik zie maar 1 stad

[Gordon]

Ik heb ook:

x( i ) = 20 + int(rnd( 0 ) * ( WindowWidth - 40 ))
y( i ) = 20 + int(rnd( 0 ) * ( WindowHeight - 40 ))

a = int( rnd( 0 ) * ( citymax - 2 ) )+ 1 'a > 0
b = int( rnd( 0 ) * ( citymax - 2 ) )+ 1 'b > 0

som = som + sqr( dx ^ 2 + dy ^ 2 ) '+ 1e-10 )

Maar a en b blijven 0, waardoor de steden allemaal op plek 0,0 staan
Dat heeft iets te maken met r(rij(),x)

Gordon

[bluatigro]

rij( 0 ) zou 0 moeten zijn
rij( 1 ) = 1 en rij( n ) = n etc...
dit voor t sorteren natuurlijk
in qb4.5 werken deze algoritmes wel

[Gordon]

Hallo Blautigro,

Ik kan je listing niet goed volgen.
Ergens sorteer je d(rij) op een voor mij eigenaardige manier.
In LB zou je gewoon de functie SORT() kunnen gebruiken om
d(rij) te sorteren.

Daarna werkt jouw listing voor mij nog steeds niet,
omdat r(x,y) altijd 0 blijft.

Mogen we je QB4.5 listing zien?

Gordon

[bluatigro]

Code: Selecteer alles

DECLARE SUB nextroute (speed!)
DECLARE SUB start ()
DECLARE SUB drawroute ()
DECLARE FUNCTION distance! (no!)
CONST citymax = 100
CONST routemax = 100
DIM SHARED hh(citymax)
DIM SHARED r(routemax, citymax), x(citymax), y(citymax), nr(routemax)
CONST false = 0, true = NOT false
start
RANDOMIZE TIMER
SCREEN 9
p1 = 0
p2 = 1
game:
   IF a MOD 10 = 0 THEN
      SCREEN 9, 0, p1, p2
      CLS p1
      PRINT "                        generatie = "; a
      drawroute
      SWAP p1, p2
   END IF
   a = a + 1
   nextroute true
IF INKEY$ = "" AND a < 1000 THEN GOTO game
FUNCTION distance (no)
   som = 0
   FOR i = 1 TO citymax
      dx = x(r(no, i)) - x(r(no, i - 1))
      dy = y(r(no, i)) - y(r(no, i - 1))
      som = som + SQR(dx ^ 2 + dy ^ 2)
   NEXT i
   distance = som
END FUNCTION
SUB drawroute
        FOR i = 0 TO citymax
                CIRCLE (x(i), y(i)), 5, 6
                PAINT (x(i), y(i)), 6
        NEXT i
        FOR i = 1 TO citymax
               LINE (x(r(0, i)), y(r(0, i)))-(x(r(0, i - 1)), y(r(0, i - 1))), 14
        NEXT i
        CIRCLE (x(0), y(0)), 5, 15
END SUB

'speed = false : swap 2 citys
'speed = true : invert route between 2 citys
SUB nextroute (speed)
   DIM d(routemax)
   FOR i = 0 TO routemax
      d(i) = distance(i)
   NEXT i
   FOR i = 1 TO routemax
      FOR t = 0 TO i - 1
         IF d(nr(i)) < d(nr(t)) THEN
            SWAP nr(i), nr(t)
         END IF
      NEXT t
   NEXT i
   FOR i = 1 TO routemax
      FOR t = 0 TO citymax
         r(nr(i), t) = r(nr(0), t)
      NEXT t
   NEXT i
   FOR i = 1 TO routemax
      IF speed THEN
         qa = INT(RND * citymax + 1)
         qb = INT(RND * citymax + 1)
         IF qa > qb THEN SWAP qa, qb
         FOR t = qa TO qb
            hh(t - qa) = r(i, t)
         NEXT t
         FOR t = qa TO qb
            r(i, t) = hh(qb - t)
         NEXT t
      ELSE
         SWAP r(i, RND * (citymax - 2) + 1), r(i, RND * (citymax - 2) + 1)
      END IF
   NEXT i
END SUB
SUB start
        FOR i = 1 TO citymax - 1
                x(i) = RND * 600 + 10
                y(i) = RND * 300 + 10
        NEXT i
        FOR i = 0 TO routemax
                nr(i) = i
                FOR t = 0 TO citymax
                        r(i, t) = t
                NEXT t
                r(i, citymax) = 0
        NEXT i
END SUB


ik denk dat ik het laatste deel van start vergenten ben
zie ik nu pas

[Gordon]

OK, ik ga ermee aan de slag.

Gordon

[bluatigro]

ik had gelijk t werkt nu wel

Code: Selecteer alles

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global citymax , routemax , YN$ , frame
citymax = 40
routemax = 100
dim x( citymax ) , y( citymax ) , hh( citymax )
dim r( routemax + 1 , citymax ) , d( routemax )
dim rij( routemax )
for i = 0 to routemax
  rij( i ) = i
  for j = 0 to citymax
    r( i , j ) = j
  next j
next i
nomainwin
for i = 1 to citymax - 1
  x( i ) = 20 + rnd( 0 ) * ( WindowWidth - 40 )
  y( i ) = 20 + rnd( 0 ) * ( WindowHeight - 100 )
next i
confirm "TSP fast ?" ; YN$
timer 500 , [tmr]
open "TSP" for graphics as #m
  #m , "trapclose [quit]"
  #m , "when characterInput [key]"
wait
[tmr]
  for i = 0 to routemax
    d( i ) = afstand( i )
  next i
  for h = 1 to routemax
    for l = 0 to h - 1
      if d( rij( h ) ) < d( rij( l ) ) then
        i = rij( h )
        rij( h ) = rij( l )
        rij( l ) = i
      end if
    next l
  next h
  for i = 1 to routemax
    a = int( rnd( 0 ) * ( citymax - 2 ) + 1 )
    b = int( rnd( 0 ) * ( citymax - 2 ) + 1 )
    if a > b then
      h = a : a = b : b = h
    end if
    if YN$ = "yes" then
      for t = a to b
        hh( t - a ) = r( rij( i ) , t )
      next t
      for t = a to b
        r( rij( i ) , t ) = hh( b - t )
      next t
    else
      h = r( rij( i ) , a )
      r( rij( i ) , a ) = r( rij( i ) , b )
      r( rij( i ) , b ) = h
    end if
  next i
  for i = 0 to citymax
    r( 0 , i ) = r( rij( 0 ) , i )
  next i
  #m , "cls"
  #m , "down"
  #m , "size 5"
  #m , "goto 0 0"
  for i = 1 to citymax - 1
    a = x( r( rij( 0 ) , i ) )
    b = y( r( rij( 0 ) , i ) )
    #m , "color black"
    #m , "goto " ; a ; " " ; b
    #m , "backcolor red"
    #m , "circlefilled 10"
  next i
  #m , "goto 0 0"
  #m , "up"
  #m , "flush"
wait
function afstand( no )
  som = 0
  for i = 1 to citymax
    dx = x( r( no , i ) ) - x( r( no , i - 1 ) )
    dy = y( r( no , i ) ) - y( r( no , i - 1 ) )
    som = som + sqr( dx ^ 2 + dy ^ 2 + 1e-10 )
  next i
  afstand = som
end function
[key]
  if inkey$ = chr$( 27 ) then goto [quit]
wait
[quit]
  close #m
end


ik heb ook wat andere dingen veranderd
alleen werkt mijn ESC knop niet

[Gordon]

Knap!
Het commando luidt Inkey$
Let op... hoofdletter I
Deze "functienaam" (syntax error) staat onderaan de listing aangegeven.

De ESC toets behoort tot de speciale toetsen.
De Inkey$ is hierbij 2 karakters groot. Voor ESC
geldt dat de rechter karakter asc 27 is. Dus zoiets als:

Code: Selecteer alles

        key$=Inkey$
    if len(key$)>1 then
        a=asc(left$(key$,1))
        b=asc(right$(key$,1))
        else
        b=asc(key$)
    end if

    if a = 4 then k$="shift"
    if a = 8 then k$="ctrl"
    if a =16 then k$="alt"
    if a =12 then k$="shift + ctrl"
    if a =20 then k$="shift + alt"
    if a =24 then k$="ctrl + alt"
    if a =28 then k$="shift + ctrl + alt"
    if b =13 then k$="enter"
    if b =27 then k$="escape"


Gordon

[bluatigro]

update :
crosover toegevoegt
r zijn meer crosover algoritmes
maar dit is de enige die ik weet te programeren

Code: Selecteer alles

WindowWidth = 700''DisplayWidth
WindowHeight = 500''DisplayHeight
global citymax , routemax , frame
global fastYN$ , crosoverYN$
citymax = 40
routemax = 100
dim x( citymax ) , y( citymax ) , hh( citymax )
dim r( routemax + 1 , citymax ) , d( routemax )
dim rij( routemax )
for i = 0 to routemax
  rij( i ) = i
  for j = 0 to citymax
    r( i , j ) = j
  next j
next i
nomainwin
for i = 1 to citymax - 1
  x( i ) = 20 + rnd( 0 ) * ( WindowWidth - 40 )
  y( i ) = 20 + rnd( 0 ) * ( WindowHeight - 100 )
next i
confirm "TSP fast ?" ; fastYN$
confirm "TSP crossover ?" ; crosoverYN$
timer 1000 , [tmr]
open "TSP" for graphics as #m
  #m , "trapclose [quit]"
  #m , "when characterInput [key]"
wait
[tmr]
  for q = 0 to 9
    for i = 0 to routemax
      d( i ) = afstand( i )
    next i
    for h = 1 to routemax
      for l = 0 to h - 1
        if d( rij( h ) ) < d( rij( l ) ) then
          i = rij( h )
          rij( h ) = rij( l )
          rij( l ) = i
        end if
      next l
    next h
    for i = 0 to citymax
      r( 0 , i ) = r( rij( 0 ) , i )
    next i
''crosover
    if crosoverYN$ = "yes" then
      for i = 20 to routemax
        a = int( rnd( 0 ) * 20 )
        b = int( rnd( 0 ) * 20 )
        for q = 1 to citymax - 1
          r( i , q ) = r( a , r( b , q ) )
        next q
      next i
    end if
''mutatons
    for i = 20 to routemax
      a = int( rnd( 0 ) * ( citymax - 2 ) + 1 )
      b = int( rnd( 0 ) * ( citymax - 2 ) + 1 )
      if a > b then
        h = a : a = b : b = h
      end if
      if fastYN$ = "yes" then
        for t = a to b
          hh( t - a ) = r( i , t )
        next t
        for t = a to b
          r( i , t ) = hh( b - t )
        next t
      else
        h = r( i , a )
        r( i , a ) = r( i , b )
        r( i , b ) = h
      end if
    next i
  next q
  #m , "cls"
  #m , "down"
  #m , "size 5"
  #m , "goto 0 0"
  for i = 1 to citymax - 1
    a = x( r( 0 , i ) )
    b = y( r( 0 , i ) )
    #m , "color black"
    #m , "goto " ; a ; " " ; b
    #m , "backcolor red"
    #m , "circlefilled 10"
  next i
  #m , "goto 0 0"
  #m , "up"
  #m , "flush"
wait
function afstand( no )
  som = 0
  for i = 1 to citymax
    dx = x( r( no , i ) ) - x( r( no , i - 1 ) )
    dy = y( r( no , i ) ) - y( r( no , i - 1 ) )
    som = som + sqr( dx ^ 2 + dy ^ 2 + 1e-10 )
  next i
  afstand = som
end function
[key]
  if inkey$ = chr$( 27 ) then goto [quit]
wait
[quit]
  close #m
end