main.hy (5ef558e) - jigsaw_gen

main.hy

(require hyrule [-> unless] :readers [%])
(import hyrule [dec inc reduce])
(import bisect itertools pprint random)

(setv [W H K M] [6 6 5 10])
(setv DIRS [#(1 0) #(0 1) #(-1 0) #(0 -1)])

(defn edge-len [layer even?] (+ (* 2 layer) even?))

(defn partition-layer [layer even?]
    (setv polys [])
    (setv theta 0)
    (while (and (< (len polys) (// (* W H) K)) (< theta (* (edge-len layer even?) 4)))
        (setv dt (min (random.randint 2 K) (- (* (edge-len layer even?) 4) theta)))
        (polys.append #(theta (+ theta dt)))
        (+= theta dt))
    polys)

(defn scale-out [layer even? angle]
    (let [el (edge-len layer even?)]
        (+ (* (+ el 2) (// angle el)) (% angle el) 1)))

(defn part-graph [even? pll]
    (let [nodes (list (itertools.chain #* (map #%(let [l (get %1 0)]
        (map #% #(l (get %1 0) (get %1 1)) (get %1 1))) (enumerate pll))))]
        (dfor a nodes #(a) (sfor b nodes
            :if (or
                (and
                    (= (get a 0) (inc (get b 0)))
                    (> (scale-out (get b 0) even? (get b 2)) (get a 1))
                    (> (get a 2) (scale-out (get b 0) even? (get b 1))))
                (and
                    (= (get b 0) (inc (get a 0)))
                    (> (scale-out (get a 0) even? (get a 2)) (get b 1))
                    (> (get b 2) (scale-out (get a 0) even? (get a 1)))))
            #(b)))))

(defn contraction [g a b]
    (let [ab (+ a b) sab (| (get g a) (get g b))]
        (setv (get g ab) sab)
        (for [nb g] (let [nbs (get g nb)]
            (when (or (in a nbs) (in b nbs)) (.add nbs ab))
            (.discard nbs a)
            (.discard nbs b)))
        (.discard (get g ab) ab)
        (del (get g a) (get g b))))

(defn weight [pl] (sum (map #%(- (get %1 2) (get %1 1)) pl)))

(defn merge-lightest [pg tl th]
    (let [lightest (min pg
        :key #%(+ (* 2 (weight %1)) (min (map weight (get pg %1)) :default (** W 2))))]
        (when (and (< (weight lightest) tl) (get pg lightest))
            (let [ln (min (get pg lightest) :key weight)]
                (when (<= (+ (weight lightest) (weight ln)) th)
                    (contraction pg lightest ln)
                    True)))))

(defn add [p q] #((+ (get p 0) (get q 0)) (+ (get p 1) (get q 1))))

(defn corners [poly]
    #(#((min (map #%(get %1 0) poly)) (min (map #%(get %1 1) poly)))
        #((max (map #%(get %1 0) poly)) (max (map #%(get %1 1) poly)))))

(defn polar->rect [layer even? angle]
    (when (and (= layer 0) (not even?)) (return #(0 0)))
    (setv el (edge-len layer even?))
    (setv [q r] [(// angle el) (% angle el)])
    (match q
        0 #((- r layer) layer)
        1 #((+ layer even?) (- layer r))
        2 #((- (+ layer even?) r) (- (+ layer even?)))
        3 #((- layer) (- r (+ layer even?)))))

(defn coordify [layer even? poly]
    (cond
        (isinstance (get poly 0) tuple) (reduce #%(| %1 %2) (map #%(coordify layer even? %1) poly))
        (= (len poly) 3) (coordify (get poly 0) even? #((get poly 1) (get poly 2)))
        True (sfor t (range (get poly 0) (get poly 1)) (polar->rect layer even? t))))

(defn rotate [points rights]
    (sfor #(x y) points #(
        (+ (* (% (inc rights) 2) (** -1 (// rights 2)) x) (* (% rights 2) -1 (** -1 (// rights 2)) y))
        (+ (* (% rights 2) (** -1 (// rights 2)) x) (* (% (inc rights) 2) (** -1 (// rights 2)) y)))))

(defn normalised [poly]
    (unless poly (return poly))
    (setv mc (get (corners poly) 0))
    (setv mc #((- (get mc 0)) (- (get mc 1))))
    (set (map #%(add %1 mc) poly)))

(defn display [poly]
    (unless poly (return "(empty)"))
    (if (isinstance poly list)
        (let [mc #((dec W) (dec W))] ; TODO: calculate correctly
            (.join "\n" (lfor y (range (inc (get mc 1))) (.join ""
                (lfor x (range (inc (get mc 0)))
                    (get (next (itertools.dropwhile
                        #%(and (get %1 1) (not-in #((- x (// W 2) -1) (- y (// W 2))) (get %1 1)))
                        (itertools.chain
                            (zip ["#" "$" "%" "&" "+" "=" "?" "@"] poly)
                            [#("." #{})]))) 0))))))
        (let [mc (get (corners poly) 1)]
            (.join "\n" (lfor y (range (inc (get mc 1))) (.join "" (lfor x (range (inc (get mc 0)))
                (if (in #(x y) poly) "#" "."))))))))

(defn divider [] (print (* W "-")))

(setv mlp (lfor l (range (// W 2)) (partition-layer l True)))
(setv pg (part-graph True mlp))
(while (merge-lightest pg K M))
(for [p pg]
        (divider)
        (-> None (coordify True p) (rotate (random.randint 0 3)) (normalised) (display) (print)))
(input "show solution? ")
(-> (map #%(coordify None True %1) pg) (list) (display) (print))

; TODO: better algorithm

jigsaw_gen

Track less-effective main.hy