Stabilise fleet movementsHEADmaster

Send reinforcements to the closest frontline planet, not the weakest.

Try to account for incoming fleets, so we don't leave planets unprotected.

1 files changed, 74 insertions, 46 deletions

diff --git a/pax.scm b/pax.scm
index 103acb4..52564c8 100755
--- a/pax.scm
+++ b/pax.scm
@@ -445,70 +445,98 @@ This function is automatically called by Chickadee."
     (($ <connection> left right)
      (connection right left))))
 
+(define planet-distance
+  (match-lambda*
+    ((($ <planet> src) ($ <planet> dst))
+     (vec2-magnitude (vec2- dst src)))))
+
+(define (planet-neighbours plt)
+  (filter-map (match-lambda
+                (($ <connection> p1 p2)
+                 (cond ((equal? p1 plt) p2)
+                       ((equal? p2 plt) p1)
+                       (else #f))))
+              (galaxy-connections %galaxy)))
+
+(define (planet-path-distance origin destination)
+  (match (fold (match-lambda*
+                 ((($ <planet> pos) #f)
+                  (cons 0 pos))
+                 ((($ <planet> pos) (acc . prev))
+                  (cons (+ acc (vec2-magnitude (vec2- pos prev))) pos)))
+               ;; TODO: `a*' loops forever if it doesn't find a path.
+               #f (a* (make-path-finder) origin destination planet-neighbours
+                      planet-distance planet-distance))
+    (#f +inf.0)   ; no path found
+    ((dist . _) dist)))
+
 (define (ai-move)
   "Move AI fleets around the @code{%galaxy}, as required."
   (match %galaxy
-    (($ <galaxy> planets connections)
+    (($ <galaxy> planets connections _ fleets)
+     (define (incoming-enemies plt)
+       "Positive result means overall, enemy fleets are incoming; negative means reinforcements."
+       (fold (match-lambda*
+               ((($ <fleet> _ _ dst owner strength) acc)
+                (cond ((not (equal? dst plt)) acc)
+                      ((equal? owner (planet-owner plt))
+                       (- acc strength))
+                      (else
+                       (+ acc strength)))))
+             0 fleets))
      (define front-lines
        (filter (match-lambda
                  (($ <connection> ($ <planet> _ owner1) ($ <planet> _ owner2))
                   (not (equal? owner1 owner2))))
                connections))
      (define front-line-planets
-       (append-map (match-lambda
-                     (($ <connection> p1 p2) (list p1 p2)))
-                   front-lines))
-     ;; Only planets with at least 3 strength, and with 1 strength more than
-     ;; their target, try to attack.
+       (append (map fleet-destination fleets)
+               (append-map (match-lambda
+                             (($ <connection> p1 p2) (list p1 p2)))
+                           front-lines)))
+
+     ;; Only planets with at least 3 strength, and with 2 strength more than
+     ;; their target, try to attack. Incoming fleets are taken into account.
      (for-each
       (match-lambda
         ((and conn
               ($ <connection>
-                 ($ <planet> _ owner1 strength1)
-                 ($ <planet> _ owner2 strength2)))
-         (cond
-          ;; TODO: wait if a fleet is incoming.
-          ((and owner1 (> strength1 3) (> (- strength1 strength2) 1))
-           (launch-fleet conn strength1))
-          ((and owner2  (> strength2 3) (> (- strength2 strength1) 1))
-           (launch-fleet (reverse-connection conn) strength2)))))
-      front-lines)
+                 (and pl1 ($ <planet> _ owner1 strength1))
+                 (and pl2 ($ <planet> _ owner2 strength2))))
+         (let ((incoming1 (incoming-enemies pl1)))
+           (when (and owner1
+                      ;; Wait if a fleet is incoming.
+                      (> strength1 (+ incoming1 3))
+                      (> strength1 (+ strength2 2)))
+             (launch-fleet conn (min strength1 (- strength1 incoming1)))))))
+      (append-map (lambda (conn)
+                    (list conn (reverse-connection conn)))
+                  front-lines))
+
      ;; Launch fleets from planets in friendly environments towards the front.
-     (define weakest-frontline-planets
-       (map (lambda (owner)
-              (cons owner (reduce
-                           (match-lambda*
-                             (((and p1 ($ <planet> _ (? (cut equal? owner <>)) strength1))
-                               (and p2 ($ <planet> _ (? (cut equal? owner <>)) strength2)))
-                              (if (< strength1 strength2) p1 p2))
-                             (((and p1 ($ <planet> _ (? (cut equal? owner <>)))) _) p1)
-                             ((_ (and p2 ($ <planet> _ (? (cut equal? owner <>))))) p2)
-                             ((_ _) #f))
-                           #f front-line-planets)))
-            (iota (vector-length player-colours))))
      (define pf (make-path-finder))
-     (define planet-distance
-       (match-lambda*
-         ((($ <planet> src) ($ <planet> dst))
-          (vec2-magnitude (vec2- dst src)))))
-     (define (neighbours plt)
-       (filter-map (match-lambda
-                     (($ <connection> p1 p2)
-                      (cond ((equal? p1 plt) p2)
-                            ((equal? p2 plt) p1)
-                            (else #f))))
-                   connections))
      (for-each
       (match-lambda
         (($ <planet> _ #f) #f)
         ((and plt ($ <planet> _ owner (? (cut > <> 3) strength)))
-         (let ((destination (assoc-ref weakest-frontline-planets owner)))
-           (when destination
-             (match (a* pf plt destination neighbours
-                        planet-distance planet-distance)
-               ((origin next-hop . _)
-                (launch-fleet (connection origin next-hop) strength))
-               (_ #f)))))
+         (match
+             (reduce
+              (match-lambda*
+                (((and pair1 (_ . dist1)) (and pair2 (_ . dist2)))
+                 (if (< dist1 dist2) pair1 pair2)))
+              (cons #f #f)
+              (filter-map
+               (lambda (dst)
+                 (and (equal? (planet-owner dst) owner)
+                      (cons dst (planet-path-distance plt dst))))
+               front-line-planets))
+           ((#f . #f) #f)
+           ((nearest-front-line-planet . _)
+            ;; TODO: `a*' loops forever if it doesn't find a path.
+            (match (a* pf plt nearest-front-line-planet planet-neighbours
+                       planet-distance planet-distance)
+              ((origin next-hop . _)
+               (launch-fleet (connection origin next-hop) strength))))))
         (_ #f))
       (lset-difference equal? planets front-line-planets)))))
 
@@ -518,7 +546,7 @@ This function is automatically called by Chickadee."
       (every 2 (for-each
                 (match-lambda
                   ((and pl ($ <planet> _ #f strength))
-                   (set-planet-strength! pl (+ 0.5 strength)))
+                   (set-planet-strength! pl (min 10.0 (+ 0.5 strength))))
                   ((and pl ($ <planet> _ _ strength))
                    (set-planet-strength! pl (+ 1.0 strength))))
                 (galaxy-planets %galaxy)))