Skip to content

Instantly share code, notes, and snippets.

@kennytilton
Created May 14, 2021 15:00
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save kennytilton/7571a6d0d5b1e862b00333b961df8e50 to your computer and use it in GitHub Desktop.
Save kennytilton/7571a6d0d5b1e862b00333b961df8e50 to your computer and use it in GitHub Desktop.
(ns trakm.core
(:gen-class)
(:require [clojure.string :as str]))
(defn -main
"I don't do a whole lot ... yet."
[& args]
(println "Hello, World!"))
;;; ------------------------------------------------------------------------
;;; -------------------------- Code Review ---------------------------------
;;; ------------------------------------------------------------------------
;;; Q: Trying to accomplish?
;;; A: Determine the winner, if any, of a game of tic-tac-toe.
;;;
;;; Q: How it works? Reduce all columns, rows, and the two diagonals to
;;; sets, then decide if we are left with just X or just O, implying
;;; no mix of Xs and Os in that candidate.
;;;
;;; Q: Feedback and rewrite, see below
;;;
;;; First, the original version, annotated with suggestions for an
;;; initial revision. I find clearing up minor issues makes larger
;;; issues stand out and makes those issues easier to resolve.
(let [check (fn [& sets]
;; each set is a candidate winning row, col, or diag, so
;; a better name might be candidates. And instead of having the
;; caller convert them to sets, we can do it inside the CHECK function,
;; bringing that vital implmentation detail inside the function.
(first (filter #(not (nil? %))
;; for the above we can suggest (remove nil?....
(map (fn [ss]
;; suggest commenting this code to explain
;; how, with the SET compression, this next detects wins.
(let [r (first (filter #(or (= % #{:x})
(= % #{:o}))
;; this ^^^ feels too heavy
;; and obscures the check for a win.
ss))]
(if r (first r) nil)))
;; Several ideas above:
;; - WHEN-LET can express the LET...IF more neatly;
;; - (first nil) => nil, so we can just say (first r)
;; instead of (if r (first r) nil); with this...
;; - ...we can forget WHEN-LET and
;; just (first (first (filter...)) or (ffirst (filter ...))
;; - there are more issues to consider, but let's
;; implement these changes and see where we stand.
;;
sets))))]
(defn ttt [board]
;;; ttt could have a nicer name :)
(check
;; Comments below might reduce the comprehension friction for some
;; by pointing out that a win means all the same, and reduced
;; to a set just be the winning marker X or O
(map set board)
(map set (apply map list board))
(list (set (map #(nth (nth board %) %)
(range 3))))
(list (set (map #(nth (nth board %) (- 2 %))
(range 3))))))
;; Here I would recommend additional test cases to confirm
;; behavior on an incomplete board...
(assert (= :x (ttt [[:x :o :x] [:x :o :o] [:x :x :o]])))
(assert (= :o (ttt [[:o :x :x] [:x :o :x] [:x :o :o]])))
(assert (nil? (ttt [[:x :o :x] [:x :o :x] [:o :x :o]]))))
;;; Next is a revision at once implementing changes suggested above and
;;; suggesting enhancements for the final version
(letfn
;; ^^^ may as well show off LETFN, tho tbh I am not a big fan
[(check [& candidate-lists]
;; OK, we still test for x/o in hard-coded fashion. We will address
;; those issues after addressing a larger problem: CHECK might be
;; attempting too much, working against a list of lists of candidates
;; and deep within having unlabelled code that checks one candidate for a win.
;;
;; It also evaluates every candidate eagerly before filtering out the
;; losers and then picking the first. This would be a good place for SOME.
;;
;; Here I would suggest the dev *begin* by isolating a function that checks
;; one candidate for a win, and rebuild the solution around that.
;;
;; ie, Divide and conquer.
;;
;; They should then leverage SOME to stop at a solution amongst
;; lazily generated candidates, and find a non-copying way to
;; determine if all three cells in a candidate are the same and non-empty.
;; The SET operations are of negligible cost, but a habit of
;; efficiency means all our code is efficient. SET also obscures the
;; desired functionality, viz,, determining if all markers in a
;; tic-tac-toe candidate are the same.
;;
;; With just the first round of suggested changes, we have...
;;
(first (remove nil?
(map (fn [candidate-list]
(ffirst (filter #(or (= % #{:x})
(= % #{:o}))
(map set candidate-list))))
candidate-lists))))
(check-for-win [board]
(check
board ;; rows
(apply map list board) ;; columns
(list (map #(nth (nth board %) %) ;; tl to br diag
(range 3)))
(list (map #(nth (nth board %) (- 2 %)) ;; tr to bl diag
(range 3)))))]
(assert (= :x (check-for-win [[:x :o nil] [:x nil :o] [:x nil nil]])))
(assert (= :x (check-for-win [[nil nil nil] [:o nil :o] [:x :x :x]])))
(assert (= :x (check-for-win [[:x :o :x] [:x :o :o] [:x :x :o]])))
(assert (= :o (check-for-win [[:o :x :x] [:x :o :x] [:x :o :o]])))
(assert (nil? (check-for-win [[:x :o :x] [:x :o :x] [:o :x :o]]))))
;; Implementing the suggestions above, we first develop a standalone
;; tool for candidate evaluation:
(letfn
[(winning-marker [candidate]
; Checks candidate col/row/diag for win (all markers =) and, if so,
; returns the winning marker.
; Handles three empty cells gracefully, returning nil.
(reduce (fn [x y]
(when (= x y) x))
candidate))]
(assert (= :x (winning-marker [:x :x :x])))
(assert (nil? (winning-marker [:x :o :x])))
(assert (= :o (winning-marker [:o :o :o])))
(assert (= :a (winning-marker [:a :a :a]))) ;; may as well
(assert (nil? (winning-marker [nil :x :x])))
(assert (nil? (winning-marker [:x nil :x])))
(assert (nil? (winning-marker [:x :x nil])))
(assert (nil? (winning-marker [:x nil nil])))
(assert (nil? (winning-marker [nil :x nil])))
(assert (nil? (winning-marker [nil nil :x])))
(assert (nil? (winning-marker (repeat 3 nil)))))
;; Now we build around that utility, and divide/conquer some more with
;; a utility to generate all the candidates of a board
(letfn
[(winning-marker [candidate]
; Checks candidate col/row/diag for win and
; if so returns the winning marker, else nil
(reduce (fn [x y]
(when (= x y) x))
candidate))
(board-candidates [board]
; generates all rows,cols,and diags of a board
(conj
(concat
board ;; rows, in effect
(apply map list board)) ;; columns
(map #(nth (nth board %) %) ;; tl to br diag
(range 3))
(map #(nth (nth board %) (- 2 %)) ;; tr to bl diag
(range 3))))]
(defn tic-tac-toe-winner [board]
(some winning-marker
(board-candidates board)))
(assert (= :x (tic-tac-toe-winner [[nil nil nil] [:o nil :o] [:x :x :x]])))
(assert (= :x (tic-tac-toe-winner [[:x :o nil] [:x nil :o] [:x nil nil]])))
(assert (= :x (tic-tac-toe-winner [[:x :o :x] [:x :o :o] [:x :x :o]])))
(assert (= :o (tic-tac-toe-winner [[:o :x :x] [:x :o :x] [:x :o :o]])))
(assert (nil? (tic-tac-toe-winner [[:x :o :x] [:x :o :x] [:o :x :o]]))))
;; An enhancement might be detecting invalid marks or marks made out of order
;; - more o's than x's
;; - two more x's than o's
;; - two wins in one board
Fastest approach so far
=======================
Why this works is a bit opaque. It was derived from intermediate revisions
which were more scrutable.
(defn unique-tri-count-terser [tri-info]
(let [{:keys [a b c]} tri-info
[as bs cs] (map inc [a b c])]
(+ (reduce (fn [cum a-rem]
(+ cum (* bs (+ a-rem cs))
(* (dec cs) a-rem)))
0 (range as))
(reduce (fn [cum b-rem]
(+ cum
(* (dec as) b-rem)
(* cs b-rem)))
0 (range bs))
(reduce (fn [cum c-rem]
(+ cum (* as c-rem)
(* (dec bs) c-rem)))
0 (range cs)))))
Prior faster approach
=====================
In the "Correct Approach" solution shown after this, we have
a reliable way of coming up with a correct answer, and that
was used to validate ongoing work aimed at efficiency. It had the failing
of generating (reliably) all conceivable triples, which was also its virtue.
This first faster approach (function unique-tris) was itself developed in
several iterations in which we continued to build triangles, but avoided creating
invalid or duplicate triangles. It works by effectively navigating all
possible paths to gen a triangle, limiting search to counter-clockwise
branching so as to avoid finding the same path twice.
This was validated against the so-called "correct" approach, then
modified just to count as each triangle was visited. This then
was modified further to avoid "visiting" each triangle, rather
the number of visits was computed and summed.
It has the advantage of actually producing the set of internal triangles.
(defn vtx-segs [vtx iseg-ct]
(conj
(for [n (range iseg-ct)]
(keyword (str (name vtx) n)))
vtx))
(defn unique-tris [tri-info]
(let [[as bs cs] (for [[k v] tri-info]
(vtx-segs k v))]
(let [tris (atom nil)]
(loop [[a & more-a] as]
(when a
(doseq [b bs]
(doseq [a1 more-a]
(swap! tris conj #{a b a1}))
(doseq [c cs]
(swap! tris conj #{a b c})))
(doseq [c (rest cs)]
(doseq [a1 more-a]
(swap! tris conj #{a c a1})))
(recur more-a)))
(loop [[b & more-b] bs]
(when b
(doseq [a (rest as)]
(doseq [b1 more-b]
(swap! tris conj #{b a b1})))
(doseq [c cs]
(doseq [b1 more-b]
(swap! tris conj #{b c b1})))
(recur more-b)))
(loop [[c & more-c] cs]
(when c
(doseq [a as]
(doseq [c1 more-c]
(swap! tris conj #{c a c1})))
(doseq [b (rest bs)]
(doseq [c1 more-c]
(swap! tris conj #{c b c1})))
(recur more-c)))
(remove #{#{:a :b :c}} @tris))))
(do
(defn unique-tri-count-fast [tri-info]
(let [{:keys [a b c]} tri-info
[as bs cs] (map inc [a b c])
tris (atom 0)]
(loop [a-rem as]
(when (pos? a-rem)
(swap! tris + (+ (* bs (+ (dec a-rem) cs))
(* (dec cs) (dec a-rem))))
(recur (dec a-rem))))
(loop [b-rem bs]
(when (pos? b-rem)
(swap! tris + (+
(* (dec as) (dec b-rem))
(* cs (dec b-rem))))
(recur (dec b-rem))))
(loop [c-rem cs]
(when (pos? c-rem)
(swap! tris + (+ (* as (dec c-rem))
(* (dec bs) (dec c-rem))))
(recur (dec c-rem))))
(dec @tris)))
(prn :fast (time (unique-tri-count-fast {:a 1 :b 3 :c 4}))))
(comment
(let [
tris {:a 10 :b 30 :c 40}
sis (time (vec (side-info-tris tris)))
unq (time (vec (unique-tris tris)))
fast (time (unique-tri-count-fast tris))
]
(prn :sict (count sis))
(prn :unq (count unq))
(prn :fast fast))
)
Output:
"Elapsed time: 926.561319 msecs"
"Elapsed time: 40.095408 msecs"
"Elapsed time: 0.048163 msecs"
:sict 75220
:unq 75220
:fast 75220
A Correct Approach
==================
After exploring different approaches, one of which is preserved below
as "Brute Force Triangles", it occurred to me that every set of three lines,
as we are constructing them, forms a unique triangle, as long as they do not
meet at the same vertex. So we just need the set of unique triples, deduped and
filtered to exclude triples that share a vertex, excluding
also the original equilateral triangle E which seems to be precluded by
the language "that can be made inside of an equilateral triangle".
This approach is inefficient for getting the mere count of unique triangles, but
is deemed more likely to be correct, hence the name.
For this exposition, we construct, for each vertex v, segments #{v vn} for n from 0 to one less
than the count of internal lines specified as coming from that vertex.
We also generate #{a b}, #{b c}, #{c a} for the sides of E. We then take all
possible combinations, throw out E, and remove any triangle where all three
sides share a vertex. The check for a count of three vertices catches cases where a triangle
includes the same side more than once, which the set operation dedupes to fewer than three sides.
(defn invalid-tri? [tri]
(or
(= tri #{#{:b :a} #{:c :a} #{:c :b}})
(not= 3 (count tri))
;; Any three lines intersect, but if they share a point
;; they do not form a triangle.
;; Given the construction of the lines, no two lines
;; can be colinear, so no need to check that. Also given
;; the stipulation that no three
;; internal lines intersect internally, we just need to
;; rule out combinations where all three lines emanate
;; from the same vertex:
(seq (apply set/intersection tri))
))
(defn side-info-tris [side-info]
(let [segs (conj
(apply concat
;; build internal lines from each vertex to n opposite
;; vertices, representing each line as #{vtx vtxn}, eg #{:a :a0}
(for [[vtx i-seg-ct] side-info
:when (pos? i-seg-ct)]
(map (fn [vtx n]
#{vtx (keyword (str (name vtx) n))})
(repeat vtx)
(range i-seg-ct))))
#{:b :a} #{:c :b} #{:c :a})]
(remove invalid-tri?
(distinct
(for [x segs
y segs
z segs]
(set [x y z]))))))
(assert (= 133 (count (side-info-tris {:a 1 :b 3 :c 4}))))
(ns trakm.internal-triangles
(:require [clojure.set :as set]))
; Approach: brute force follow every path through a triangle, given
; information on which vertices appear on which lines and vice versa.
;
; Pseudocode:
; for each vertex V
; for each line L meeting at that vertex
; for each point P on line L, excluding V
; for each line LP on which P appears, excluding L
; for each P2 on line LP excluding P
; for each line LP2 on which P2 appears excluding LP
; if V appears on LP2
; collect V-P-P2
;
; We need maps:
; a point to lines on which it appears
; from a line to the points appearing on it
;; Left as an exercise: generating these maps from each vertex
;; on the containing equilateral triangle or its sides to
;; the set of points on those sides ot internal lines from a
;; vertex to its opposite face.
(def lines {#{:a :b} [:a :c0 :b]
#{:b :c} [:b :a0 :c]
#{:c :a} [:c :b0 :a]
#{:a :a0} [:a :a0b0 :a0c1 :a0c0 :a0]
#{:b :b0} [:b :a0b0 :b0c0 :b0c1 :b0]
#{:c :c0} [:c :a0c0 :b0c0 :c0]
#{:c :c1} [:c :a0c1 :b0c1 :c1]})
(def triangle (atom #{}))
(let [pt-lines (memoize
(fn [pt]
(keep (fn [[k v]]
(when (some #{pt} v)
k))
lines)))]
(reset! triangle #{})
;;
;; Bute force navigation of all possible paths, using clojure DISTINCT to
;; eliminate duplicates.
;;
(doseq [pt (apply set/union (vals lines))]
(prn :pt pt)
(doseq [L (pt-lines pt)]
(prn :_L L)
(doseq [P (remove #{pt} (get lines L))]
(prn :__P P)
(doseq [LP (remove #{L} (pt-lines P))]
(prn :___LP LP)
(doseq [P2 (remove #{P} (get lines LP))]
(prn :____P2 P2)
(doseq [LP2 (remove #{L LP} (pt-lines P2))]
(prn :_____LP2 LP2)
(when (some #{pt} (get lines LP2))
(prn :bam [pt P P2])
(swap! triangle conj #{pt P P2}))))))))
{:tris @triangle :tri-ct (count @triangle))
(ns trakm.word-find
(:require [clojure.string :as str]))
(def allowed-directions
;; generate allowed "directions" expressed as
;; pairs of row/column steps from some current row/col position.
(remove
(fn [row-col]
(or
;; optional. uncomment next to rule out diagonals:
;; (not (some zero? row-col))
;; rule out direction that never moves (do not omit!)
(every? zero? row-col)))
(for [row-step [-1 0 1]
col-step [-1 0 1]]
[row-step col=step])))
(def letter (to-array-2d
["AOTDLROW"
"LCBMUMLU"
"DRUJDBLJ"
"PAZHZZEF"
"BCZELFHW"
"RKULVPPG"
"ALBLPOPQ"
"BEMOPPJY"]))
(def letter-row-max (dec (alength letter)))
(def letter-col-max (dec (alength (aget letter 0))))
;; first version of allows diagonals, but not wrapping at the bounds
(letfn [(next-coord [current delta limit]
(let [next (+ current delta)]
(when (<= 0 next limit)
next)))
(try-dir [[row-inc col-inc] from-position word]
(letfn [(finishes? [needed [r c]]
(or
(empty? needed)
(when-let [next-r (next-coord r row-inc letter-row-max)]
(when-let [next-c (next-coord c col-inc letter-col-max)]
(when (= (first needed) (aget letter next-r next-c))
(recur (rest needed) [next-r next-c]))))))]
(finishes? (rest word) from-position)))]
(and
(try-dir [0 -1] [0 7] "WORLD")
(try-dir [1 0] [3 3] "HELLO")
(not (try-dir [1 0] [1 2] "BUXX"))
(try-dir [-1 -1] [7 6] "JOVE")
(not (try-dir [0 1] [0 5] "ROWA"))))
;; Left as an exercise allow wrapping at grid bounds
;; Left as an exercise allow "internal reflection" at grid bounds
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment