Track less-effective main.hy
dkl9 commited on 2025-355 21:08:48
Showing 1 changed files, with 118 additions and 0 deletions.
- main.hy 0000000..76f6644
| ... | ... |
@@ -0,0 +1,118 @@ |
| 1 |
+(require hyrule [-> unless] :readers [%]) |
|
| 2 |
+(import hyrule [dec inc reduce]) |
|
| 3 |
+(import bisect itertools pprint random) |
|
| 4 |
+ |
|
| 5 |
+(setv [W H K M] [6 6 5 10]) |
|
| 6 |
+(setv DIRS [#(1 0) #(0 1) #(-1 0) #(0 -1)]) |
|
| 7 |
+ |
|
| 8 |
+(defn edge-len [layer even?] (+ (* 2 layer) even?)) |
|
| 9 |
+ |
|
| 10 |
+(defn partition-layer [layer even?] |
|
| 11 |
+ (setv polys []) |
|
| 12 |
+ (setv theta 0) |
|
| 13 |
+ (while (and (< (len polys) (// (* W H) K)) (< theta (* (edge-len layer even?) 4))) |
|
| 14 |
+ (setv dt (min (random.randint 2 K) (- (* (edge-len layer even?) 4) theta))) |
|
| 15 |
+ (polys.append #(theta (+ theta dt))) |
|
| 16 |
+ (+= theta dt)) |
|
| 17 |
+ polys) |
|
| 18 |
+ |
|
| 19 |
+(defn scale-out [layer even? angle] |
|
| 20 |
+ (let [el (edge-len layer even?)] |
|
| 21 |
+ (+ (* (+ el 2) (// angle el)) (% angle el) 1))) |
|
| 22 |
+ |
|
| 23 |
+(defn part-graph [even? pll] |
|
| 24 |
+ (let [nodes (list (itertools.chain #* (map #%(let [l (get %1 0)] |
|
| 25 |
+ (map #% #(l (get %1 0) (get %1 1)) (get %1 1))) (enumerate pll))))] |
|
| 26 |
+ (dfor a nodes #(a) (sfor b nodes |
|
| 27 |
+ :if (or |
|
| 28 |
+ (and |
|
| 29 |
+ (= (get a 0) (inc (get b 0))) |
|
| 30 |
+ (> (scale-out (get b 0) even? (get b 2)) (get a 1)) |
|
| 31 |
+ (> (get a 2) (scale-out (get b 0) even? (get b 1)))) |
|
| 32 |
+ (and |
|
| 33 |
+ (= (get b 0) (inc (get a 0))) |
|
| 34 |
+ (> (scale-out (get a 0) even? (get a 2)) (get b 1)) |
|
| 35 |
+ (> (get b 2) (scale-out (get a 0) even? (get a 1))))) |
|
| 36 |
+ #(b))))) |
|
| 37 |
+ |
|
| 38 |
+(defn contraction [g a b] |
|
| 39 |
+ (let [ab (+ a b) sab (| (get g a) (get g b))] |
|
| 40 |
+ (setv (get g ab) sab) |
|
| 41 |
+ (for [nb g] (let [nbs (get g nb)] |
|
| 42 |
+ (when (or (in a nbs) (in b nbs)) (.add nbs ab)) |
|
| 43 |
+ (.discard nbs a) |
|
| 44 |
+ (.discard nbs b))) |
|
| 45 |
+ (.discard (get g ab) ab) |
|
| 46 |
+ (del (get g a) (get g b)))) |
|
| 47 |
+ |
|
| 48 |
+(defn weight [pl] (sum (map #%(- (get %1 2) (get %1 1)) pl))) |
|
| 49 |
+ |
|
| 50 |
+(defn merge-lightest [pg tl th] |
|
| 51 |
+ (let [lightest (min pg |
|
| 52 |
+ :key #%(+ (* 2 (weight %1)) (min (map weight (get pg %1)) :default (** W 2))))] |
|
| 53 |
+ (when (and (< (weight lightest) tl) (get pg lightest)) |
|
| 54 |
+ (let [ln (min (get pg lightest) :key weight)] |
|
| 55 |
+ (when (<= (+ (weight lightest) (weight ln)) th) |
|
| 56 |
+ (contraction pg lightest ln) |
|
| 57 |
+ True))))) |
|
| 58 |
+ |
|
| 59 |
+(defn add [p q] #((+ (get p 0) (get q 0)) (+ (get p 1) (get q 1)))) |
|
| 60 |
+ |
|
| 61 |
+(defn corners [poly] |
|
| 62 |
+ #(#((min (map #%(get %1 0) poly)) (min (map #%(get %1 1) poly))) |
|
| 63 |
+ #((max (map #%(get %1 0) poly)) (max (map #%(get %1 1) poly))))) |
|
| 64 |
+ |
|
| 65 |
+(defn polar->rect [layer even? angle] |
|
| 66 |
+ (when (and (= layer 0) (not even?)) (return #(0 0))) |
|
| 67 |
+ (setv el (edge-len layer even?)) |
|
| 68 |
+ (setv [q r] [(// angle el) (% angle el)]) |
|
| 69 |
+ (match q |
|
| 70 |
+ 0 #((- r layer) layer) |
|
| 71 |
+ 1 #((+ layer even?) (- layer r)) |
|
| 72 |
+ 2 #((- (+ layer even?) r) (- (+ layer even?))) |
|
| 73 |
+ 3 #((- layer) (- r (+ layer even?))))) |
|
| 74 |
+ |
|
| 75 |
+(defn coordify [layer even? poly] |
|
| 76 |
+ (cond |
|
| 77 |
+ (isinstance (get poly 0) tuple) (reduce #%(| %1 %2) (map #%(coordify layer even? %1) poly)) |
|
| 78 |
+ (= (len poly) 3) (coordify (get poly 0) even? #((get poly 1) (get poly 2))) |
|
| 79 |
+ True (sfor t (range (get poly 0) (get poly 1)) (polar->rect layer even? t)))) |
|
| 80 |
+ |
|
| 81 |
+(defn rotate [points rights] |
|
| 82 |
+ (sfor #(x y) points #( |
|
| 83 |
+ (+ (* (% (inc rights) 2) (** -1 (// rights 2)) x) (* (% rights 2) -1 (** -1 (// rights 2)) y)) |
|
| 84 |
+ (+ (* (% rights 2) (** -1 (// rights 2)) x) (* (% (inc rights) 2) (** -1 (// rights 2)) y))))) |
|
| 85 |
+ |
|
| 86 |
+(defn normalised [poly] |
|
| 87 |
+ (unless poly (return poly)) |
|
| 88 |
+ (setv mc (get (corners poly) 0)) |
|
| 89 |
+ (setv mc #((- (get mc 0)) (- (get mc 1)))) |
|
| 90 |
+ (set (map #%(add %1 mc) poly))) |
|
| 91 |
+ |
|
| 92 |
+(defn display [poly] |
|
| 93 |
+ (unless poly (return "(empty)")) |
|
| 94 |
+ (if (isinstance poly list) |
|
| 95 |
+ (let [mc #((dec W) (dec W))] ; TODO: calculate correctly |
|
| 96 |
+ (.join "\n" (lfor y (range (inc (get mc 1))) (.join "" |
|
| 97 |
+ (lfor x (range (inc (get mc 0))) |
|
| 98 |
+ (get (next (itertools.dropwhile |
|
| 99 |
+ #%(and (get %1 1) (not-in #((- x (// W 2) -1) (- y (// W 2))) (get %1 1))) |
|
| 100 |
+ (itertools.chain |
|
| 101 |
+ (zip ["#" "$" "%" "&" "+" "=" "?" "@"] poly) |
|
| 102 |
+ [#("." #{})]))) 0))))))
|
|
| 103 |
+ (let [mc (get (corners poly) 1)] |
|
| 104 |
+ (.join "\n" (lfor y (range (inc (get mc 1))) (.join "" (lfor x (range (inc (get mc 0))) |
|
| 105 |
+ (if (in #(x y) poly) "#" ".")))))))) |
|
| 106 |
+ |
|
| 107 |
+(defn divider [] (print (* W "-"))) |
|
| 108 |
+ |
|
| 109 |
+(setv mlp (lfor l (range (// W 2)) (partition-layer l True))) |
|
| 110 |
+(setv pg (part-graph True mlp)) |
|
| 111 |
+(while (merge-lightest pg K M)) |
|
| 112 |
+(for [p pg] |
|
| 113 |
+ (divider) |
|
| 114 |
+ (-> None (coordify True p) (rotate (random.randint 0 3)) (normalised) (display) (print))) |
|
| 115 |
+(input "show solution? ") |
|
| 116 |
+(-> (map #%(coordify None True %1) pg) (list) (display) (print)) |
|
| 117 |
+ |
|
| 118 |
+; TODO: better algorithm |
|
| 0 | 119 |