more_beeps.clj

(ns scratch.core
  (:require [clojure.spec :as s]
            [clojure.test.check.generators :as gen]
            [clojure.core.logic :as cl]
            [clojure.core.logic.fd :as fd]))
          
;; an attempt to generate the intervals between beeps in EquaTalk:
;; http://mason.gmu.edu/~rhanson/equatalk.html

(s/def ::beep-interval
  (s/int-in 30 90))

(defn add-to-sixty-by-sixty? [numbers]
  (= (* 60 60) (apply + numbers)))

(defn has-length-60? [s]
  (= 60 (count s)))

;; add a constraint for “surprisinginess”?
(s/def ::beeps
  (s/and (s/coll-of ::beep-interval [])
         has-length-60?
         add-to-sixty-by-sixty?))

;(gen/generate (s/gen ::beeps))
; Couldn't satisfy such-that predicate after 100 tries.

;; TODO: make custom generators to compare with easy clj solution below:

(defn generate-list-of-60-numbers-between-30-and-90 []
  (repeatedly 60 (fn []
                   (+ 30 (rand-int 60)))))

(defn generate-beep-intervals []
  (->> (repeatedly generate-list-of-60-numbers-between-30-and-90)
       (filter (fn [numbers]
                 (= 3600 (apply + numbers))))
       first))

(time (generate-beep-intervals))
;; "Elapsed time: 0.626485 msecs"
(s/valid? ::beeps (generate-beep-intervals))
;; => true


;; core.logic solution
;; TODO: make list more “surprising”, make it conform to some sort of distribution

;; everyo and sumo via https://spin.atomicobject.com/2015/12/14/logic-programming-clojure-finite-domain-constraints/
(defn everyo [l f]
  (cl/fresh [head tail]
    (cl/conde
      [(cl/== l ())]
      [(cl/conso head tail l)
       (f head)
       (everyo tail f)])))

(defn sumo [seq-of-numbers sum len]
  (cl/fresh [head tail sum-of-remaining len-of-remaining]
    (cl/conde
      [(cl/== seq-of-numbers ()) (cl/== sum 0) (cl/== len 0)]
      [(cl/conso head tail seq-of-numbers)
       (fd/+ head sum-of-remaining sum)
       (fd/+ 1 len-of-remaining len)
       (sumo tail sum-of-remaining len-of-remaining)])))

(defn find-lists-totalling-and-of-length [sum len num-results]
  (let [domain (fd/interval 30 90)]
    (cl/run num-results
            [q]
            (everyo q #(fd/in % domain))
            (sumo q sum len))))


(count (first (find-lists-totalling-and-of-length 3600 60 1)))
;; => 60

(apply + (first (find-lists-totalling-and-of-length 3600 60 1)))
;; => 3600



;; TODO: figure out why it seems to get really slow around around 62
;(doseq [i (range 1 100)]
;  (println i)
;  (time (println (take i (find-lists-totalling-and-of-length 3600 60 i)))))



;; most boring list ever:
;; =>
;(30
;  90
;  90
;  90
;  30
;  90
;  90
;  30
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  30
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  90
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30
;  30)