trip.l (2256B)
1 # 25may11abu 2 # (c) Software Lab. Alexander Burger 3 4 (load "@lib/simul.l") 5 6 # Set up distance properties 7 # See "misc/travel.l" and "doc/travel" 8 (mapc 9 '((L) 10 (put (car L) (cadr L) (caddr L)) 11 (put (cadr L) (car L) (caddr L)) ) 12 (quote 13 (Rheine Muenster 39) 14 (Rheine Osnabrueck 42) 15 (Muenster Osnabrueck 51) 16 (Warendorf Muenster 28) 17 (Warendorf Osnabrueck 43) 18 (Warendorf Rheda 24) 19 (Warendorf Guetersloh 27) 20 (Osnabrueck Bielefeld 48) 21 (Rheda Guetersloh 10) 22 (Bielefeld Guetersloh 16) 23 (Bielefeld Paderborn 39) 24 (Paderborn Guetersloh 31) 25 (Paderborn Rheda 32) 26 (Paderborn Soest 41) 27 (Soest Rheda 38) 28 (Soest Beckum 26) 29 (Beckum Rheda 24) 30 (Beckum Warendorf 27) 31 (Ahlen Warendorf 27) 32 (Ahlen Muenster 46) 33 (Ahlen Beckum 11) 34 (Ahlen Soest 27) ) ) 35 36 # Find a route from 'A' to 'B' 37 (de route (A B Lst) 38 (if (get A B) 39 (list A B) 40 (and 41 (pick 42 '((X) 43 (and 44 (not (memq X Lst)) 45 (route X B (cons A Lst)) ) ) 46 (shuffle (mapcar cdr (getl A))) ) 47 (cons A @) ) ) ) 48 49 # Minimize trip from 'A' to 'B' 50 (de trip (Pop Gen A B) 51 (gen 52 (make (do Pop (link (route A B)))) # Population 53 '((Pop) (lt0 (dec 'Gen))) # Condition 54 '((X Y) # Recombination 55 (make 56 (while (prog (link (pop 'X)) X) 57 (when (member (car X) (cdr Y)) 58 (setq Y @) 59 (xchg 'X 'Y) ) ) ) ) 60 '((L) # Mutation 61 (let (N (length L) H (>> 1 N) N1 (rand 1 H) N2 (rand (inc H) N)) 62 (if (route (get L N1) (get L N2)) 63 (append 64 (head (dec N1) L) 65 @ 66 (nth L (inc N2)) ) 67 L ) ) ) 68 '((L) # Selection 69 (let A (pop 'L) 70 (- 71 (sum 72 '((X) (get A (setq A X))) 73 L ) ) ) ) ) ) 74 75 # Optimum hit percentage, e.g. (tst 12 8) 76 (de tst (Pop Gen) 77 (let OK 0 78 (do 100 79 (when 80 (= 81 (trip Pop Gen 'Rheine 'Paderborn) 82 '(Rheine Muenster Warendorf Rheda Paderborn) ) 83 (inc 'OK) ) ) 84 OK ) )