Skip to content

Instantly share code, notes, and snippets.

@Arnauld

Arnauld/Player.clj

Created June 3, 2021 15:04
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Embed
What would you like to do?
Learn more about clone URLs
Download ZIP
Platinum Rift
Raw
Player.clj
(ns Player
(:gen-class)
(:import (java.io StringReader)
(clojure.lang LineNumberingPushbackReader PersistentQueue))
(:use clojure.set))
;---------------------------------------------------------------
; _ _ _ _ _ _
; _ _| |_(_) (_) |_(_) ___ ___
; _____| | | | __| | | | __| |/ _ \/ __|
; |_____| |_| | |_| | | | |_| | __/\__ \
; \__,_|\__|_|_|_|\__|_|\___||___/
;---------------------------------------------------------------
(defn as-stream [s]
(-> (StringReader. s) LineNumberingPushbackReader.))
(defn in?
"true if seq contains elm"
[seq elm]
(some #(= elm %) seq))
(defn my-value [pods myId]
(get pods myId))
(defn other-values [pods myId]
(loop [d pods i 0 ps []]
(if (seq d)
(if (= i myId)
(recur (rest d) (inc i) ps)
(recur (rest d) (inc i) (conj ps (first d))))
ps)))
(defn accept-all [& _] true) ; multi-args 'accept-all'
(defn randomly-pick-one [coll]
(nth coll (int (rand-int (count coll)))))
(defn debug [& args] (binding [*out* *err*]
(println args)))
(defn distribute [nb]
(cond (= nb 10) [3 2 2 1 1 1]
(= nb 9) [3 2 2 1 1]
(= nb 8) [3 2 2 1]
(= nb 7) [3 2 1 1]
(= nb 6) [3 2 1]
(= nb 5) [3 1 1]
(= nb 4) [3 1]
(= nb 3) [2 2]
(= nb 2) [1 1]
(= nb 1) [1]
(= nb 0) []
:else (into [3] (distribute (- nb 3)))))
;---------------------------------------------------------------
; __ _ _
; / _\ |_ __ _| |_ ___ ___
; \ \| __/ _` | __/ _ \/ __|
; _\ \ || (_| | || __/\__ \
; \__/\__\__,_|\__\___||___/
;---------------------------------------------------------------
(def ^:dynamic *myId* -1)
(def ^:dynamic *game* nil)
(def ^:dynamic *round-nb* nil)
(def ^:dynamic *round-states* nil)
(defn my-id [game]
(get-in game [:headers :myId]))
(defmacro with-game [game & body]
`(binding [*game* ~game
*myId* (my-id ~game)]
~@body))
(defmacro in-round [game round-nb round-states & body]
`(binding [*game* ~game
*round-nb* ~round-nb
*round-states* ~round-states
*myId* (my-id ~game)]
~@body))
(defn zones []
(get *game* :zones))
(defn zone-of [zoneId]
(get-in *game* [:zones zoneId]))
(defn links-of [zoneId]
(:links (zone-of zoneId)))
(defn nb-links-of [zoneId]
(count (links-of zoneId)))
(defn region-id-of-zone [zoneId]
(:regionId (zone-of zoneId)))
(defn region-of [regionId]
(get-in *game* [:regions regionId]))
(defn region-of-zone [zoneId]
(region-of (region-id-of-zone zoneId)))
(defn zone-ids-in-region-of [regionId]
(:zoneIds (region-of regionId)))
(defn zone-ids-in-region-of-zone [zoneId]
(:zoneIds (region-of-zone zoneId)))
(defn number-of-spawn-available []
(int (/ (:platinumAvailable *round-states*) 20)))
(defn zone-state-of [zoneId]
(get-in *round-states* [:zoneStates zoneId]))
(defn platinum-source-of [zoneId]
(get-in *game* [:zones zoneId :platinumSource]))
(defn my-pods [zoneId]
(:myPods (zone-state-of zoneId)))
(defn max-others-pods [zoneId]
(:maxOtherPods (zone-state-of zoneId)))
(defn is-enemy-present [zoneId]
(< 0 (max-others-pods zoneId)))
(defn max-others-pods-around [zoneId]
(apply max (map max-others-pods (links-of zoneId))))
(defn sum-of-around [zoneId op]
(reduce (fn [acc zId]
(+ acc (op zId))) 0 (links-of zoneId)))
(defn sum-of-in-region [zoneId op]
(reduce (fn [acc zId]
(+ acc (op zId))) 0 (zone-ids-in-region-of-zone zoneId)))
(defn owner-of [zoneId]
(:ownerId (zone-state-of zoneId)))
(defn is-owned-by-me [zoneId]
(= (owner-of zoneId) *myId*))
(defn is-not-owned-by-me [zoneId]
(not (is-owned-by-me zoneId)))
(defn is-owned-by-other [zoneId]
(let [ownerId (owner-of zoneId)]
(not (or (= ownerId *myId*)
(= ownerId -1)))))
(defn is-owned-by-nobody [zoneId]
(= (owner-of zoneId) -1))
(defn number-of-zone-around [zoneId predicate]
(reduce (fn [acc zId]
(if (predicate zId)
(inc acc)
acc)) 0 (links-of zoneId)))
(defn zone-around [zoneId predicate]
(reduce (fn [acc zId]
(if (predicate zId)
(conj acc zId)
acc)) [] (links-of zoneId)))
(defn is-region-owned [zoneId]
(every? is-owned-by-me (zone-ids-in-region-of-zone zoneId)))
;---------------------------------------------------------------
; _____
; / _ / ___ _ __ ___
; \// / / _ \| '_ \ / _ \
; / //\ (_) | | | | __/
; /____/\___/|_| |_|\___|
;---------------------------------------------------------------
(defn new-zone [zoneId platinumSource]
{:zoneId zoneId
:platinumSource platinumSource
:links []})
;---------------------------------------------------------------
; _
; (_) ___
; _____| |/ _ \
; |_____| | (_) |
; |_|\___/
;---------------------------------------------------------------
(defn load-headers [stream]
{:playerCount (read stream) ; playerCount: the amount of players (2 to 4)
:myId (read stream) ; myId: my player ID (0, 1, 2 or 3)
:zoneCount (read stream) ; zoneCount: the amount of zones on the map
:linkCount (read stream)}) ; linkCount: the amount of links between all zones
(defn load-zones [stream zoneCount]
(loop [i zoneCount zs {}]
(if (> i 0)
(let [zoneId (read stream) ; zoneId: this zone's ID (between 0 and zoneCount-1)
platinumSource (read stream) ; numberOfPlatinumSources: the amount of Platinum this zone can provide per game turn
zone (new-zone zoneId platinumSource)]
(recur (dec i) (assoc zs zoneId zone)))
zs)))
(defn load-links [stream zones linkCount]
(loop [i linkCount zs0 zones]
(if (> i 0)
(let [zone1 (read stream)
zone2 (read stream)
zs1 (update-in zs0 [zone1 :links] conj zone2)
zsn (update-in zs1 [zone2 :links] conj zone1)]
(recur (dec i) zsn))
zs0)))
(defn load-zone-status [stream myId]
(let [zoneId (read stream) ; zoneId: this zone's ID
ownerId (read stream) ; ownerId: the player who owns this zone (-1 otherwise)
pods [(read stream) ; podsP0: player 0's PODs on this zone
(read stream) ; podsP1: player 1's PODs on this zone
(read stream) ; podsP2: player 2's PODs on this zone (always 0 for a two player game)
(read stream)] ; podsP3: player 3's PODs on this zone (always 0 for a two or three player game)
otherPods (other-values pods myId)]
{:zoneId zoneId
:ownerId ownerId
:myPods (my-value pods myId)
:otherPods otherPods
:maxOtherPods (apply max otherPods)}))
(defn load-status
([stream]
(load-status *game* stream))
([game stream]
(let [zoneCount (get-in game [:headers :zoneCount])
myId (get-in game [:headers :myId])
platinum (read stream) ; platinum: my available Platinum
zoneStates (loop [i zoneCount zs {}]
(if (< 0 i)
(do
(let [zoneStatus (load-zone-status stream myId)]
(recur (dec i) (assoc zs (:zoneId zoneStatus) zoneStatus))))
zs))]
{:platinumAvailable platinum
:zoneStates zoneStates})))
;---------------------------------------------------------------
; __ _
; /__\ ___ __ _(_) ___ _ __
; / \/// _ \/ _` | |/ _ \| '_ \
; / _ \ __/ (_| | | (_) | | | |
; \/ \_/\___|\__, |_|\___/|_| |_|
; |___/
;---------------------------------------------------------------
(defn new-region [regionId zoneIds]
{:regionId regionId
:zoneIds zoneIds})
; (defn traverse-graph-dfs [g s]
; http://hueypetersen.com/posts/2013/06/25/graph-traversal-with-clojure/
;
(defn all-reachable-zones [s g]
(loop [vertices [] explored #{s} frontier [s]]
(if (empty? frontier)
vertices
(let [v (peek frontier)
neighbors (get-in g [v :links])]
(recur
(conj vertices v)
(into explored neighbors)
(into (pop frontier) (remove explored neighbors)))))))
;(defn seq-graph-bfs [s g]
; http://hueypetersen.com/posts/2013/06/25/graph-traversal-with-clojure/
;
(defn all-reachable-zones-alt1 [s g]
((fn rec-bfs [explored frontier]
(lazy-seq
(if (empty? frontier)
nil
(let [v (peek frontier)
neighbors (get-in g [v :links])]
(cons v (rec-bfs
(into explored neighbors)
(into (pop frontier) (remove explored neighbors))))))))
#{s} (conj (PersistentQueue/EMPTY) s)))
(defn build-regions [zones]
(let [allZIds (set (keys zones))]
(loop [remainingIds allZIds regions [] regionId 1]
(if (not (empty? remainingIds))
(let [reachableIds (all-reachable-zones (first remainingIds) zones)
updatedRegions (conj regions (new-region regionId reachableIds))]
(recur (clojure.set/difference remainingIds reachableIds) updatedRegions (inc regionId)))
regions))))
(defn consolidate-region [region zones]
(let [regionId (:regionId region)
region-zones (map (fn [zId]
(assoc (get-in zones [zId]) :regionId regionId)) (:zoneIds region))
platinumSrcAdder (fn [acc z] (+ (:platinumSource z) acc))
totalPlatinumSource (reduce platinumSrcAdder 0 region-zones)]
(-> region
(assoc :totalPlatinumSource totalPlatinumSource)
(assoc :zones region-zones))))
(defn consolidate-regions [regions zones]
(map (fn [r] (consolidate-region r zones)) regions))
;---------------------------------------------------------------
; _ _
; _ __ __ _| |_| |__
; | '_ \ / _` | __| '_ \
; | |_) | (_| | |_| | | |
; | .__/ \__,_|\__|_| |_|
; |_|
;---------------------------------------------------------------
(defn direct-reachable-zones
([zoneId]
(direct-reachable-zones #{zoneId} #{zoneId} (fn [_] true)))
([vertices explored filter-fn]
(let [links (reduce (fn [acc zId]
(into acc (filter filter-fn (links-of zId))))
#{} vertices)]
(remove explored links))))
(defn no-stop [ring] false)
(defn reachable-zones-nth
([zoneId depthMax filter-fn]
(reachable-zones-nth zoneId depthMax filter-fn no-stop))
([zoneId depthMax filter-fn stop-fn]
(loop [depth depthMax
rings [[zoneId]]
explored #{zoneId}]
(let [stop? (or (= 0 depth)
(stop-fn (last rings)))]
(debug "reachable-zones-nth:stop?" stop?)
(if stop?
rings
;--else
(let [nextRing (direct-reachable-zones (last rings) explored filter-fn)]
(if (empty? nextRing)
rings
(recur (dec depth)
(conj rings nextRing)
(into explored nextRing)))))))))
(defn extract-path [toId all-rings]
(loop [rings (drop-while (fn [r] (not (in? r toId))) (reverse all-rings))
path [toId]]
(if (empty? rings)
path
(let [lastNode (last path)
lastRing (first rings)
filter-fn (fn [zId] (in? (links-of zId) lastNode))
allPotentials (filter filter-fn lastRing)]
(if (empty? allPotentials)
(recur (rest rings) path)
(recur (rest rings) (conj path (first allPotentials))))))))
;---------------------------------------------------------------
; ___ _ _
; / __\___ _ __ | |_ _____ _| |_
; / / / _ \| '_ \| __/ _ \ \/ / __|
; / /__| (_) | | | | || __/> <| |_
; \____/\___/|_| |_|\__\___/_/\_\\__|
;---------------------------------------------------------------
(defn new-context [] (atom {}))
(def ^:dynamic *context* nil)
(def ^:dynamic *availableSpawns* nil)
(def ^:dynamic *availableSpawnsDistribution* nil)
(defmacro in-context [context availableSpawns & body]
`(binding [*context* ~context
*availableSpawns* (atom ~availableSpawns)
*availableSpawnsDistribution* (atom (distribute ~availableSpawns))]
~@body))
(defn nb-pods-consumed-at [zoneId]
(let [spawn (get-in @*context* [zoneId :consumed])]
(if (nil? spawn) 0 spawn)))
(defn nb-pods-assigned-at [zoneId]
(count (get-in @*context* [zoneId :assigned])))
(defn nb-pods-spawned-at [zoneId]
(let [spawn (get-in @*context* [zoneId :spawn])]
(if (nil? spawn) 0 spawn)))
(defn nb-pods-available-at [zoneId]
(let [initial (my-pods zoneId)
consumed (nb-pods-consumed-at zoneId)]
(- initial consumed)))
(defn nb-spawns-available []
@*availableSpawns*)
(defn spawn-pod-at
([zoneId]
(debug "spawning at" zoneId "/" @*availableSpawns*)
(if (< 0 @*availableSpawns*)
(do
(swap! *availableSpawns* dec)
(swap! *context* update-in [zoneId :spawned] (fnil inc 0)))))
([zoneId nbPods]
(loop [n nbPods]
(when (< 0 n)
(spawn-pod-at zoneId)
(recur (dec n))))))
(defn affect-pods-to
([fromZoneId toZoneId]
(if (nil? toZoneId) (throw (IllegalArgumentException. "'nil' zone")))
(reset! *context*
(-> @*context*
(update-in [fromZoneId :consumed] (fnil inc 0))
(update-in [toZoneId :assigned] (fnil conj []) fromZoneId))))
([fromZoneId toZoneId nbPods]
(loop [n nbPods]
(when (< 0 n)
(affect-pods-to fromZoneId toZoneId)
(recur (dec n))))))
;---------------------------------------------------------------
; ___ _
; /___\_ __ __| | ___ _ __
; // // '__/ _` |/ _ \ '__|
; / \_//| | | (_| | __/| |
; \___/ |_| \__,_|\___|_|
;---------------------------------------------------------------
(defn randomly-affect-pods-according-to-rings [zoneId rings destinations maxAvailable]
(if (empty? destinations)
nil
(loop [remainings maxAvailable]
(if (< 0 remainings)
(let [zId (randomly-pick-one destinations)
path (extract-path zId rings)
nextMove (first (rest (reverse path)))]
(if (nil? nextMove)
(do
(debug "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
(debug "destinations...:" destinations)
(debug "rings..........:" rings)
(debug "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"))
(affect-pods-to zoneId nextMove)))
(recur (dec remainings))))))
(defn affect-pods-according-to-rings [zoneId rings destinations maxAvailable]
(let [dst (remove #(= zoneId %1) destinations)]
(if (empty? dst)
nil
(loop [remainings maxAvailable wheres (cycle dst)]
(if (< 0 remainings)
(let [zId (first wheres)
path (extract-path zId rings)
nextMove (first (rest (reverse path)))]
(affect-pods-to zoneId nextMove))
(recur (dec remainings) (rest wheres)))))))
;
; --- SPAWN
;
(defn spawn-priority [order]
(let [zoneId (:zoneId order)
platinumSource (:nbPlatinum order)
platinumSourceAround (:nbPlatinumAround order)
isOwnedByMe (:isOwnedByMe order)]
(if (= 1 *round-nb*)
(-> 0
(+ (* 2.5 platinumSource))
(+ (* 0.8 platinumSourceAround)))
(if isOwnedByMe
(-> 0
(+ (* 0.5 (sum-of-around zoneId (fn [zId] (- (max-others-pods zId) (my-pods zId)))))))
(-> 5
(+ (* 2.5 platinumSource))
(+ (* 0.8 platinumSourceAround))
(+ (* 2.0 (sum-of-in-region zoneId (fn [zId] (cond (is-owned-by-other zId) 2
(is-owned-by-me zId) -2
:else 1))))))
)
)))
(defn next-spawn-nb []
(if (= 1 *round-nb*)
(let [nb (first @*availableSpawnsDistribution*)]
(swap! *availableSpawnsDistribution* rest)
nb)
1))
(defn spawn-execute [order]
(let [zoneId (:zoneId order)]
(if (< 0 (nb-spawns-available))
(spawn-pod-at zoneId (next-spawn-nb)))))
;
; --- SUPPORT
;
(defn support-priority [order] 10) ; no priority among support
(defn randomly-affect-pods-to-nearest-zone-not-owned [zoneId]
(let [podsAvailable (nb-pods-available-at zoneId)]
(if (< 0 podsAvailable)
(let [notOwnedFn (fn [ring]
(let [f (some is-not-owned-by-me ring)]
(debug "notOwnedFn?>>>" f "<<<" ring)
f))
ringsNotOwned (reachable-zones-nth zoneId 14 accept-all notOwnedFn)
destinations (filter is-not-owned-by-me (last ringsNotOwned))
destinations (sort-by (fn [zId]
(-> 0
(+ (* 2.4 (max-others-pods zId)))
(+ (* 1.7 (platinum-source-of zId)))))
#(compare %2 %1) destinations)]
(debug "randomly-affect-pods-to-nearest-zone-not-owned:: zoneId:" zoneId "(availables: " podsAvailable ")" destinations)
(affect-pods-according-to-rings zoneId
ringsNotOwned
destinations
podsAvailable))
(debug "randomly-affect-pods-to-nearest-zone-not-owned:: zoneId:" zoneId "no pods available" (get @*context* zoneId)))))
(defn randomly-affect-pods-to-zone-of-interests [zoneId]
(let [podsAvailable (nb-pods-available-at zoneId)]
(if (< 0 podsAvailable)
(let [selection-size (min 6 podsAvailable)
rings (reachable-zones-nth zoneId 8 accept-all)
link-weight-of (fn [zId] [zId (:link-weight (zone-of zId))])
nodes-with-weights (map link-weight-of (flatten rings))
passr (take selection-size (sort-by last #(compare %2 %1) nodes-with-weights))]
(randomly-affect-pods-according-to-rings zoneId
rings
(map first passr)
podsAvailable)))))
(defn randomly-affect-pods-from-zone-around [zoneId nb]
(let [zoneWithAvailablePods (zone-around zoneId (fn [z] (< 0 (nb-pods-available-at z))))]
(if (not (empty? zoneWithAvailablePods))
(loop [remaining nb]
(if (< 0 remaining)
(let [selectedId (randomly-pick-one zoneWithAvailablePods)
available (nb-pods-available-at selectedId)]
(if (< 0 available)
(do
(affect-pods-to selectedId zoneId)
(recur (dec remaining)))
(recur remaining))
))
))))
(defn support-execute [order]
(let [zoneId (:zoneId order)]
(randomly-affect-pods-to-nearest-zone-not-owned zoneId)
(randomly-affect-pods-to-zone-of-interests zoneId)))
;
; -- FLEE
;
(defn flee-priority [order] 10) ; no priority among flees
(defn flee-execute [order]
(let [zoneId (:zoneId order)
availables (nb-pods-available-at zoneId)
escapeZones (zone-around zoneId (fn [zId] (or (is-owned-by-me zId)
(is-owned-by-other zId)
(< 0 (my-pods zId)))))]
(loop [remaining availables]
(if (< 0 remaining)
(do
(affect-pods-to zoneId (randomly-pick-one escapeZones))
(recur (dec remaining)))))
))
;
; -- FIGHT
;
(defn fight-priority [order]
(let [zoneId (:zoneId order)
platinumSource (:nbPlatinum order)
platinumSourceAround (:nbPlatinumAround order)
isOwnedByMe (:isOwnedByMe order)]
(-> 0
(+ (* 2.5 platinumSource))
(+ (* 0.8 platinumSourceAround))
(+ (* 0.5 (sum-of-around zoneId (fn [zId] (- (my-pods zId) (max-others-pods zId))))))
(+ (* 5.0 (if isOwnedByMe 0 1)))
(+ (* 2.0 (sum-of-in-region zoneId (fn [zId] (cond (is-owned-by-other zId) 2
(is-owned-by-me zId) -2
:else 1)))))
)))
(defn fight-execute [order]
(let [zoneId (:zoneId order)
myPods (nb-pods-available-at zoneId)
myPodsAround (sum-of-around zoneId nb-pods-available-at)
spawnAvailable (nb-spawns-available)
maxOthers (:maxOtherPods order)
required (inc maxOthers)
podsAroundToAffect (min myPodsAround required)]
(if (< maxOthers (+ myPods myPodsAround spawnAvailable))
(do
(randomly-affect-pods-from-zone-around zoneId podsAroundToAffect)
(spawn-pod-at zoneId (- required podsAroundToAffect)))
)))
;
; -- CONQUER: no pods on zone
;
(defn conquer-priority [order]
(let [zoneId (:zoneId order)
platinumSource (:nbPlatinum order)
platinumSourceAround (:nbPlatinumAround order)
isOwnedByMe (:isOwnedByMe order)]
(-> 0
(+ (* 2.5 platinumSource))
(+ (* 0.8 platinumSourceAround))
(+ (* 5.0 (if isOwnedByMe 0 1)))
(+ (* 2.0 (sum-of-in-region zoneId (fn [zId] (cond (is-owned-by-other zId) 2
(is-owned-by-me zId) -2
:else 1)))))
)))
(defn conquer-execute [order]
(let [zoneId (:zoneId order)
maxOthers (:maxOtherPods order)
availableAround (sum-of-around zoneId nb-pods-available-at)]
(if (< maxOthers availableAround)
(randomly-affect-pods-from-zone-around zoneId (inc maxOthers)))))
;
; --- TAKE ORDERS
;
(defn take-orders-for-zone [zoneId]
(if (is-region-owned zoneId)
[]
(let [spawnAvailable (number-of-spawn-available)
myPods (my-pods zoneId)
myPodsAround (sum-of-around zoneId my-pods)
maxOthers (max-others-pods zoneId)
maxOthersAround (max-others-pods-around zoneId)
isOwnedByMe (is-owned-by-me zoneId)
isOwnedByOther (is-owned-by-other zoneId)
;
; -- pre-compute informations
infos {:zoneId zoneId
:nbPlatinum (platinum-source-of zoneId)
:nbPlatinumAround (sum-of-around zoneId platinum-source-of)
:myPods myPods
:myPodsAround myPodsAround
:maxOtherPods maxOthers
:maxOthersAround maxOthersAround
:isOwnedByMe isOwnedByMe
:isOwnedByOther isOwnedByOther}
; -- accumulate orders...
; TODO find a smarter way to populate the list...
xs []
;-- spawn order
xs (if (and (< 0 spawnAvailable)
(not isOwnedByOther))
(conj xs (assoc infos :what :spawn))
xs)
;--
xs (cond
;-- in-fight? / flee?
(< 0 myPods) (if (and isOwnedByMe (< 0 maxOthers))
(into xs [(assoc infos :what :fight)
(assoc infos :what :flee)])
xs)
;-- conquer?
(= 0 myPods) (if (and (< 0 myPodsAround) (not isOwnedByMe))
(conj xs (assoc infos :what :conquer))
xs)
:else xs)
;-- support
xs (if (< 0 myPods)
(conj xs (assoc infos :what :support))
xs)]
xs)))
(defn print-orders [orders]
(debug "Nb orders..." (count orders))
(doall (map (fn [k] (debug ":" k)) orders)))
(defn affect-priority [orders priority-fn]
(map (fn [order] (assoc order :priority (priority-fn order))) orders))
(defn take-orders []
(let [zones (zones)]
(reduce (fn [acc [zId z]]
(into acc (take-orders-for-zone zId))) [] zones)))
(defn priorize-and-execute [orders]
(let [availableSpawns (number-of-spawn-available)
highPriorityFirst #(compare %2 %1) ; sort in reverse order
grouped (group-by :what orders)
;
flees (affect-priority (:flee grouped) flee-priority)
flees (sort-by :priority highPriorityFirst flees)
;
fights (affect-priority (:fight grouped) fight-priority)
fights (sort-by :priority highPriorityFirst fights)
;
conquers (affect-priority (:conquer grouped) conquer-priority)
conquers (sort-by :priority highPriorityFirst conquers)
;
supports (affect-priority (:support grouped) support-priority)
supports (sort-by :priority highPriorityFirst supports)
;
spawns (affect-priority (:spawn grouped) spawn-priority)
spawns (sort-by :priority highPriorityFirst spawns)]
(in-context (new-context) availableSpawns
(doall (map fight-execute fights))
(doall (map conquer-execute conquers))
(doall (map support-execute supports))
(doall (map flee-execute flees))
(doall (map spawn-execute spawns))
(debug @*context*)
@*context*)))
(defn let-me-think []
(let [orders (take-orders)]
(priorize-and-execute orders)))
;---------------------------------------------------------------
; _
; __ _ __ _ _ __ ___ ___ | | ___ ___ _ __
; _____ / _` |/ _` | '_ ` _ \ / _ \ | |/ _ \ / _ \| '_ \
; |_____| (_| | (_| | | | | | | __/ | | (_) | (_) | |_) |
; \__, |\__,_|_| |_| |_|\___| |_|\___/ \___/| .__/
; |___/ |_|
;---------------------------------------------------------------
(defn- pack-per-occurence [list]
(reduce (fn [g n]
(update-in g [n]
(fn [p] (if (nil? p)
1
(inc p)))))
{} list))
(defn display-move [zacc [zoneId update]]
(let [assigned (get update :assigned [])
packed (pack-per-occurence assigned)
reduced (reduce (fn [acc [zId nb]]
(print nb zId zoneId " ")
(+ nb acc)) 0 packed)]
(+ zacc reduced)))
(defn display-moves [updates]
(if (= 0 (reduce display-move 0 updates))
(println "WAIT")
(println)))
(defn display-spawn [zacc [zoneId update]]
(let [nb (get update :spawned 0)]
(if (< 0 nb)
(print nb zoneId " "))
(+ zacc nb)))
(defn display-spawns [updates]
(if (= 0 (reduce display-spawn 0 updates))
(println "WAIT")
(println)))
(defn affect-zones-weight [zones]
(let [pass0 (reduce (fn [acc [zId zone]]
(let [llw (nb-links-of zId)
lnw (sum-of-around zId nb-links-of)
plw (platinum-source-of zId)
pnw (sum-of-around zId platinum-source-of)]
(assoc acc zId
(-> zone
(assoc :link-weight (+ llw lnw))
(assoc :platinum-weight (+ plw pnw)))))) {} zones)]
pass0))
(defn initial-load-and-build [stream]
(let [headers (load-headers stream)
zoneCount (:zoneCount headers)
zones (load-zones stream zoneCount)
zones (load-links stream zones (:linkCount headers))
regions (build-regions zones)
regions (consolidate-regions regions zones)
zones (reduce (fn [acc r]
(reduce (fn [subAcc z]
(assoc subAcc (:zoneId z) z)) acc (:zones r))) {} regions)
game0 {:headers headers
:zones zones
:regions (reduce (fn [acc r] (assoc acc (:regionId r) r)) {} regions)}]
(binding [*game* game0]
(let [zones-with-weights (affect-zones-weight zones)]
(assoc game0 :zones zones-with-weights)))))
(defn -main [& args]
(let [game (initial-load-and-build *in*)]
(loop [round 1]
(let [states (load-status game *in*)]
(in-round game round states
(let [updates (let-me-think)]
(debug "Round #" round)
(display-moves updates)
(display-spawns updates)))
(recur (inc round)))
)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment