@MSGID:
<55f30e3c-a6fe-428c-a95f-02bacf08c1een@googlegroups.com> f4e090e7
@REPLYADDR Marcel Hendrix <mhx@iae.nl>
@REPLYTO 2:5075/128 Marcel Hendrix
@CHRS: CP866 2
@RFC: 1 0
@RFC-Message-ID:
<55f30e3c-a6fe-428c-a95f-02bacf08c1een@googlegroups.com>
@TZUTC: -0700
@PID: G2/1.0
@TID: FIDOGATE-5.12-ge4e8b94
(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : Ant colony optimization of Travelling Salesman Problem
 * CATEGORY    : Utility
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : May 26, 2005, Marcel Hendrix 
 *)


NEEDS -miscutil
NEEDS -fsl util

REVISION -ants "--- Ant colony Optim.   Version 1.00 ---"

PRIVATES

DOC
(*
 Ant Colony Optimization (ACO) studies artificial systems that take
 inspiration from the  behavior of real ant colonies. ACO is used to solve
 discrete optimization problems.

 In the real world, ants initially wander randomly, and when having found
 food, return to their colony while laying down pheromone trails. If other ants
 find such a path, they are likely to follow the trail, returning and thus 
 reinforcing it if they eventually find food. Thus, when one ant finds a good
 path from the colony to a food source, other ants are more likely to follow
 that same path, and positive feedback eventually leaves all the ants  
 following it. The idea of ACO is to mimic this behavior with "simulated ants"
 walking around a graph that represents the problem to solve.

 The algorithm
  -------------
The artificial ant is in this case an agent which moves from city to city on a
 TSP graph. The agent`s travelling strategy is based on a probabilistic
 function that takes two things into account. Firstly, it counts the edges it
 has travelled, accumulating their length and secondly, it senses the trail
 (pheromone) left behind by other ant agents. Each agent modifies the
 environment in two different ways :

  1. Local trail updating: As the ant moves between cities it updates the
      amount of pheromone on each traversed edge
  2. Global trail updating: When all ants have completed a tour the ant that
       found the shortest route updates the edges in its path The purpose of
       local updating is mainly to avoid very strong pheromone edges to be
       chosen by every ant, hence increasing exploration and hopefully
       avoiding locally optimal solutions. The global updating function gives
       the shortest path higher reinforcement, i.e., the amount of pheromone
       on the edges of the path is increased. There are three main ideas that
      this ant colony algorithm has adopted from real ant colonies:

      a. The ants have a probabilistic preference for paths with high
          pheromone value
      b. Shorter paths tend to have a higher rate of growth in pheromone
          value
      c. It uses an indirect communication system through pheromone in
          edges
 
  In addition the agents are provided with a few capabilities not
present in real ants, but likely to help solving the problem at hand. For
example, each
ant is able to determine how far away cities are, and they all have a memory
of which cities already visited.

  The probability that a city is chosen is a function of how close
the city is and how much pheromone already exists on that trail. Once
a tour has been completed (i.e. each city has been visited exactly
once by the ant) the edges are calculated and then each ant deposits
pheromone on the complete tour. The pheromone concentration on the edge
between city I and J is multiplied by p(RHO), the evaporation constant.
This value can be set between 0 and 1.
The pheromone evaporates more rapidly for lower values.

  The amount of pheromone an ant k deposits on an edge is defined
by the length of the tour created by this ant. Intuitively short tours
will result in higher levels of pheromone deposited on the edges.
*)
ENDDOC

-- Control parameters

0.3e FVALUE DECAY FACTOR
  1e FVALUE TWEAK( does almost nothing! )
 #30  VALUE #ANTS( 30 /  70 )
 #70  VALUE #ITERS( 70 / 300 )
   0  VALUE #CITIES

INTEGER DMATRIX node{{PRIVATE
DOUBLE  DMATRIX distance{{

: distance ( F: -- r ) ( a b -- ) 
LOCALS| b a |
node{{ a 0 }} @ 
node{{ b 0 }} @ - S>F FSQR
node{{ a 1 }} @ 
node{{ b 1 }} @ - S>F FSQR F+ FSQRT ;

: BUILD-DISTANCE ( -- )
#CITIES 0 ?DO   #CITIESI ?DO  J I distance  
FDUP distance{{ J I }} DF!  
          distance{{ I J }} DF!  
  LOOP 
  LOOP ;

0 [IF]  S" original.frt" INCLUDED
[ELSE]  S" kroA100.frt"  INCLUDED
\\ S" function.frt" INCLUDED
[THEN]

--------------------------------------------------------------------------------
-------------------

#CITIES #CITIES DOUBLE MATRIX pheromone{{PRIVATE
DOUBLE DARRAY objectiveValue{PRIVATE
DOUBLE DARRAY p/d{PRIVATE

0e FVALUE BestObjectiveValue PRIVATE
0e FVALUE START PHEROMONE PRIVATE
0e FVALUE MINIMUM PHEROMONEPRIVATE

--------------------------------------------------------------------------------
----------

INTEGER DMATRIX tour{{ -- visited cities in order
INTEGER DMATRIX notYetVisited{{PRIVATE -- not yet visited cities <> -1

: getDistance ( from to -- ) ( F: -- d ) distance{{ -ROT }} DF@ ; PRIVATE

: StartAntColony ( -- )
1e64 TO BestObjectiveValue  
0e #CITIES 1- 0 ?DO  I I 1+ getDistance F+ LOOP 
#CITIES 1- 0 getDistance F+ 1/F TO START PHEROMONE

START PHEROMONE 1e-4 F* TO MINIMUM PHEROMONE
START PHEROMONE pheromone{{ fillmat 

objectiveValue{  #ANTS          }malloc malloc-fail?
   p/d{  #CITIES        }malloc malloc-fail? OR
          tour{{ #ANTS #CITIES }}malloc malloc-fail? OR 
  notYetVisited{{ #ANTS #CITIES }}malloc malloc-fail? OR ABORT"
StartAntColony :: out of core" ; PRIVATE

: setObjectiveValue ( ant -- )
>S
objectiveValue{ S } DUP DF@ 
F0= IF0e  #CITIES 1- 0 ?DO  tour{{ S I }} 2@  getDistance  F+  LOOP
\\ connect last to first city
tour{{ S  #CITIES 1- }} @  tour{{ S>  0 }} @  getDistance  F+ ( addr) DF!
  ELSE  -S DROP
 ENDIF ; PRIVATE 

-- prepare ant
: newRound ( ant -- ) 
LOCAL ant
0e objectiveValue{ ant } DF!
#CITIES 0 ?DO  -1          tour{{ ant I }} !  LOOP
#CITIES 0 ?DO   I notYetvisited{{ ant I }} !  LOOP ; PRIVATE

 : addPheromone ( from to -- ) ( F: phero -- ) pheromone{{ -ROT
3DUP FDUP }} DF+! SWAP }} DF+! ; PRIVATE
: getPheromone ( from to -- ) ( F: -- phero ) pheromone{{ -ROT }} DF@ ; PRIVATE

-- add pheromone to all edges
: (layPheromone) ( F: p -- ) ( ant -- ) 
 LOCAL ant
FLOCAL p  
#CITIES 1- 0 ?DO  tour{{ ant I }} 2@ p addPheromone  LOOP    
tour{{ ant #CITIES 1- }} @  tour{{ ant 0 }} @  p addPheromone ;PRIVATE

 : layPheromone ( ant -- ) DECAY FACTOR objectiveValue{ OVER } DF@
F/ (layPheromone) ; PRIVATE

: AllAntsMark  ( -- )   
#ANTS  0 ?DO( MINIMUM PHEROMONE objectiveValue{ I } DF@ F/ ) 
START PHEROMONE 
I (layPheromone)  
LOOP ; PRIVATE

: findWay ( ant -- ) 
#CITIES CHOOSE 0 LOCALS| pos sel ant |\\ random starting point
0e 0e FLOCALS| 1/sum vrandom |
sel         tour{{ ant  0  }} !
-1 notYetVisited{{ ant sel }} !\\ strike from list
#CITIES 
1 ?DO\\ for all unvisited cities
0e ( sum )\\ Sum priorities of all unvisited cities
#CITIES 0 ?DOnotYetVisited{{ ant I }} @ TO pos
pos 0>= IF tour{{ ant J 1- }} @  pos 
   2DUP getPheromone TWEAK F* getDistance F/ 
   FDUP p/d{ pos } DF!  F+ ( +sum)
     ENDIF
         LOOP   1/F TO 1/sum
FRANDOM TO vrandom\\ Monte-Carlo choice
0e  ( act )\\ probabilistic choice
#CITIES 0 ?DOnotYetVisited{{ ant I }} @ TO pos
pos 0>= IF p/d{ pos } DF@ 1/sum F* F+ ( +act)
   vrandom FOVER F< IF  pos TO sel LEAVE  ENDIF
     ENDIF
         LOOP FDROP
sel         tour{{ ant  I  }} !\\ remember chosen city 
-1 notYetVisited{{ ant sel }} !\\ don`t visit it again
 LOOP 
 ant setObjectiveValue ; PRIVATE

: doDecay ( -- ) 
DECAY FACTOR F0= ?EXIT
pheromone{{ ADIMS * 
0 ?DO  DUP DF@ [ 1e DECAY FACTOR F- ] FLITERAL F* 
MINIMUM PHEROMONE FMAX DF!+
 LOOP DROP ; PRIVATE

: getBestAnt ( -- index ) 
0 LOCAL best
    #ANTS  0 ?DOobjectiveValue{ I } DF@ 
FDUP BestObjectiveValue F< IF  TO BestObjectiveValue  I TO best 
             ELSE  FDROP 
           ENDIF
 LOOPbest ; PRIVATE

: solveTsp ( -- ) 
0 LOCAL iteration
    BEGIN iteration #ITERS <
WHILE1 +TO iteration
#ANTS 0 ?DO I newRound\\ initialize ant
    I findWay\\ let ant loose
       LOOP
allAntsMark
doDecay
getBestAnt layPheromone
REPEAT ; 

: .PARAMETERS ( -- )
CR ." DECAY FACTOR " DECAY FACTOR   F.N1
CR ." TWEAK        " TWEAK          F.N1
 CR ." #ANTS        " #ANTS      DEC.
 CR ." #ITERS       " #ITERS     DEC. ;

: .BEST-TOUR ( ant -- )
#digits >S print-width >S 3 TO #digits #25 TO print-width
CR ." Best tour: " tour{{ SWAP DUP 0 #CITIES 1- }}print[]
S> TO print-width S> TO #digits ; PRIVATE

: ANTS ( -- )
.PARAMETERS
4 0 DOCR TIMER-RESET 
StartAntColony solveTsp 
." Best value: " BestObjectiveValue F.N1 ." , " .ELAPSED
  LOOP 
getBestAnt .BEST-TOUR ;

: ITER-TEST ( max min -- )
DUP TO #ITERS .PARAMETERS
      ?DO
I TO #ITERS StartAntColony solveTsp 
CR ." iters = " I 5 .R ."  best value: " BestObjectiveValue F.N1
#10 +LOOP ;

:ABOUT." Try: ANTS" ;

.ABOUT -ants CR
DEPRIVE

                              (* End of Source *)
--- G2/1.0
 * Origin: usenet.network (2:5075/128)
SEEN-BY: 5001/100 5005/49 5015/255 5019/40 5020/715
848 1042 4441 12000
SEEN-BY: 5030/49 1081 5058/104 5075/128
@PATH: 5075/128 5020/1042 4441