--- a/package.lisp Thu Dec 15 16:35:22 2016 -0500
+++ b/package.lisp Thu Dec 15 18:53:10 2016 -0500
@@ -98,20 +98,6 @@
:degrees
:radians))
-(defpackage :sand.wallpaper
- (:use
- :cl
- :losh
- :sketch
- :iterate
- :sand.quickutils
- :sand.utils)
- (:shadowing-import-from :iterate
- :in)
- (:shadowing-import-from :sketch
- :degrees
- :radians))
-
(defpackage :sand.markov
(:use
:cl
@@ -294,3 +280,24 @@
))
+(defpackage :sand.turing-omnibus.wallpaper
+ (:use
+ :cl
+ :losh
+ :sketch
+ :iterate
+ :sand.quickutils
+ :sand.utils)
+ (:shadowing-import-from :iterate
+ :in)
+ (:shadowing-import-from :sketch
+ :degrees
+ :radians))
+
+(defpackage :sand.turing-omnibus.monto-carlo
+ (:use
+ :cl
+ :losh
+ :iterate
+ :sand.quickutils
+ :sand.utils))
--- a/sand.asd Thu Dec 15 16:35:22 2016 -0500
+++ b/sand.asd Thu Dec 15 18:53:10 2016 -0500
@@ -23,13 +23,13 @@
:html-entities
:iterate
:losh
- :trivia
:parenscript
:plump
:rs-colors
:sanitize
:sketch
:split-sequence
+ :trivia
:yason
)
@@ -70,4 +70,7 @@
:serial t
:components ((:file "compiler")))
(:file "sketch")
- (:file "wallpaper")))))
+ (:module "turing-omnibus"
+ :serial t
+ :components ((:file "wallpaper")
+ (:file "monte-carlo")))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/turing-omnibus/monte-carlo.lisp Thu Dec 15 18:53:10 2016 -0500
@@ -0,0 +1,27 @@
+(in-package :sand.turing-omnibus.monto-carlo)
+
+;;;; From The New Turing Omnibus, Chapter 4
+
+(defun frequency (alpha time)
+ (* (/ alpha)
+ (exp (- (/ time alpha)))))
+
+(defun cumulative-frequency (alpha time)
+ (- 1 (exp (- (/ time alpha)))))
+
+(defun inverse-cumulative-frequency (alpha x)
+ (* alpha (log (- 1 x))))
+
+;; Something is fucky with the above inverse function given by the book... `α
+;; ln(1 - x)` will always give a negative result (for x in [0, 1)), so how can
+;; we use it as a number of seconds to wait?
+
+; (defun simulate (1000)
+; (let ((max-time )))
+; )
+
+; (gnuplot-function (curry #'inverse-cumulative-frequency 1.0)
+; :start 0.0
+; :end 1.00
+; :step 0.1)
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/turing-omnibus/wallpaper.lisp Thu Dec 15 18:53:10 2016 -0500
@@ -0,0 +1,110 @@
+(in-package :sand.turing-omnibus.wallpaper)
+
+;;;; From The New Turing Omnibus, Chapter 1
+
+;;;; Config
+(defparameter *width* 600)
+(defparameter *height* 600)
+
+
+;;;; Utils
+(defmacro with-setup (&body body)
+ `(progn
+ (background (gray 1.0))
+ ,@body))
+
+(defmacro in-context (&body body)
+ `(prog1
+ (push-matrix)
+ (progn ,@body)
+ (pop-matrix)))
+
+(defmacro scancode-case (scancode-form &rest pairs)
+ (with-gensyms (scancode)
+ `(let ((,scancode ,scancode-form))
+ (cond
+ ,@(mapcar (lambda (pair)
+ (destructuring-bind (key-scancode &rest body) pair
+ `((sdl2:scancode= ,scancode ,key-scancode)
+ ,@body)))
+ pairs)))))
+
+(defmacro just-once (dirty-place &body body)
+ `(when ,dirty-place
+ (setf ,dirty-place nil)
+ ,@body))
+
+
+;;;; Sketch
+(defun plot (x y color)
+ (with-pen (make-pen :fill color)
+ (in-context
+ (translate x y)
+ (rect 0 0 1 1))))
+
+(defsketch wallpaper
+ ((width *width*) (height *height*) (y-axis :up) (title "Wallpaper")
+ (copy-pixels t)
+ (mouse (list 0 0))
+ (mouse-down-left nil)
+ (mouse-down-right nil)
+ (dirty t)
+ ;; Data
+ (palette (iterate (repeat (random-range 2 10))
+ (collect (rgb (random 1.0) (random 1.0) (random 1.0))
+ :result-type 'vector)))
+ (corner-a (random 100))
+ (corner-b (random 100))
+ (side (random-range 10.0 20.0))
+ (tiles (random-range 40 110))
+ (number-of-colors (length palette)))
+ ;;
+ (just-once dirty
+ (with-setup
+ (in-context
+ (scale (/ *width* tiles))
+ (iterate
+ (for-nested ((i :from 0 :below tiles)
+ (j :from 0 :below tiles)))
+ (for x = (+ corner-a (* i (/ side tiles))))
+ (for y = (+ corner-b (* j (/ side tiles))))
+ (for c = (truncate (+ (* x x) (* y y))))
+ (plot i j (aref palette (mod c number-of-colors)))))
+ (with-pen (make-pen :fill (rgb 1.0 1.0 1.0))
+ (rect 0 0 110 20))
+ (text (format nil "Side: ~8F" side) 0 0)))
+ ;;
+
+ )
+
+
+;;;; Keyboard
+(defun keydown (instance scancode)
+ (declare (ignorable instance))
+ (scancode-case scancode
+ (:scancode-space (sketch::prepare instance))
+ (:scancode-up (mulf (slot-value instance 'side) 1.01))
+ (:scancode-down (mulf (slot-value instance 'side) 0.99))
+ (:scancode-l (decf (slot-value instance 'corner-a)))
+ (:scancode-h (incf (slot-value instance 'corner-a)))
+ (:scancode-k (decf (slot-value instance 'corner-b)))
+ (:scancode-j (incf (slot-value instance 'corner-b)))
+ )
+ (setf (slot-value instance 'dirty) t))
+
+(defun keyup (instance scancode)
+ (declare (ignorable instance))
+ (scancode-case scancode
+ (:scancode-space nil)))
+
+
+(defmethod kit.sdl2:keyboard-event ((instance wallpaper) state timestamp repeatp keysym)
+ (declare (ignore timestamp repeatp))
+ (cond
+ ((eql state :keyup) (keyup instance (sdl2:scancode-value keysym)))
+ ((eql state :keydown) (keydown instance (sdl2:scancode-value keysym)))
+ (t nil)))
+
+
+;;;; Run
+; (defparameter *wallpaper* (make-instance 'wallpaper))
--- a/src/wallpaper.lisp Thu Dec 15 16:35:22 2016 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,110 +0,0 @@
-(in-package :sand.wallpaper)
-
-;;;; From The New Turing Omnibus, Chapter 1
-
-;;;; Config
-(defparameter *width* 600)
-(defparameter *height* 600)
-
-
-;;;; Utils
-(defmacro with-setup (&body body)
- `(progn
- (background (gray 1.0))
- ,@body))
-
-(defmacro in-context (&body body)
- `(prog1
- (push-matrix)
- (progn ,@body)
- (pop-matrix)))
-
-(defmacro scancode-case (scancode-form &rest pairs)
- (with-gensyms (scancode)
- `(let ((,scancode ,scancode-form))
- (cond
- ,@(mapcar (lambda (pair)
- (destructuring-bind (key-scancode &rest body) pair
- `((sdl2:scancode= ,scancode ,key-scancode)
- ,@body)))
- pairs)))))
-
-(defmacro just-once (dirty-place &body body)
- `(when ,dirty-place
- (setf ,dirty-place nil)
- ,@body))
-
-
-;;;; Sketch
-(defun plot (x y color)
- (with-pen (make-pen :fill color)
- (in-context
- (translate x y)
- (rect 0 0 1 1))))
-
-(defsketch wallpaper
- ((width *width*) (height *height*) (y-axis :up) (title "Wallpaper")
- (copy-pixels t)
- (mouse (list 0 0))
- (mouse-down-left nil)
- (mouse-down-right nil)
- (dirty t)
- ;; Data
- (palette (iterate (repeat (random-range 2 10))
- (collect (rgb (random 1.0) (random 1.0) (random 1.0))
- :result-type 'vector)))
- (corner-a (random 100))
- (corner-b (random 100))
- (side (random-range 10.0 20.0))
- (tiles (random-range 40 110))
- (number-of-colors (length palette)))
- ;;
- (just-once dirty
- (with-setup
- (in-context
- (scale (/ *width* tiles))
- (iterate
- (for-nested ((i :from 0 :below tiles)
- (j :from 0 :below tiles)))
- (for x = (+ corner-a (* i (/ side tiles))))
- (for y = (+ corner-b (* j (/ side tiles))))
- (for c = (truncate (+ (* x x) (* y y))))
- (plot i j (aref palette (mod c number-of-colors)))))
- (with-pen (make-pen :fill (rgb 1.0 1.0 1.0))
- (rect 0 0 110 20))
- (text (format nil "Side: ~8F" side) 0 0)))
- ;;
-
- )
-
-
-;;;; Keyboard
-(defun keydown (instance scancode)
- (declare (ignorable instance))
- (scancode-case scancode
- (:scancode-space (sketch::prepare instance))
- (:scancode-up (mulf (slot-value instance 'side) 1.01))
- (:scancode-down (mulf (slot-value instance 'side) 0.99))
- (:scancode-l (decf (slot-value instance 'corner-a)))
- (:scancode-h (incf (slot-value instance 'corner-a)))
- (:scancode-k (decf (slot-value instance 'corner-b)))
- (:scancode-j (incf (slot-value instance 'corner-b)))
- )
- (setf (slot-value instance 'dirty) t))
-
-(defun keyup (instance scancode)
- (declare (ignorable instance))
- (scancode-case scancode
- (:scancode-space nil)))
-
-
-(defmethod kit.sdl2:keyboard-event ((instance wallpaper) state timestamp repeatp keysym)
- (declare (ignore timestamp repeatp))
- (cond
- ((eql state :keyup) (keyup instance (sdl2:scancode-value keysym)))
- ((eql state :keydown) (keydown instance (sdl2:scancode-value keysym)))
- (t nil)))
-
-
-;;;; Run
-; (defparameter *wallpaper* (make-instance 'wallpaper))
--- a/vendor/make-quickutils.lisp Thu Dec 15 16:35:22 2016 -0500
+++ b/vendor/make-quickutils.lisp Thu Dec 15 18:53:10 2016 -0500
@@ -13,8 +13,10 @@
:hash-table-keys
:hash-table-plist
:hash-table-values
+ :iota
:n-grams
:once-only
+ :range
:rcurry
:read-file-into-string
:required-argument
--- a/vendor/quickutils.lisp Thu Dec 15 16:35:22 2016 -0500
+++ b/vendor/quickutils.lisp Thu Dec 15 18:53:10 2016 -0500
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :ENSURE-GETHASH :ENSURE-LIST :HASH-TABLE-ALIST :HASH-TABLE-KEYS :HASH-TABLE-PLIST :HASH-TABLE-VALUES :N-GRAMS :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :REQUIRED-ARGUMENT :RIFFLE :SUBDIVIDE :SYMB :TREE-COLLECT :WITH-GENSYMS) :ensure-package T :package "SAND.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :ENSURE-GETHASH :ENSURE-LIST :HASH-TABLE-ALIST :HASH-TABLE-KEYS :HASH-TABLE-PLIST :HASH-TABLE-VALUES :IOTA :N-GRAMS :ONCE-ONLY :RANGE :RCURRY :READ-FILE-INTO-STRING :REQUIRED-ARGUMENT :RIFFLE :SUBDIVIDE :SYMB :TREE-COLLECT :WITH-GENSYMS) :ensure-package T :package "SAND.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "SAND.QUICKUTILS")
@@ -19,8 +19,9 @@
:HASH-TABLE-ALIST :MAPHASH-KEYS
:HASH-TABLE-KEYS :HASH-TABLE-PLIST
:MAPHASH-VALUES :HASH-TABLE-VALUES
- :TAKE :N-GRAMS :ONCE-ONLY :RCURRY
- :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE
+ :IOTA :TAKE :N-GRAMS :ONCE-ONLY :RANGE
+ :RCURRY :WITH-OPEN-FILE*
+ :WITH-INPUT-FROM-FILE
:READ-FILE-INTO-STRING
:REQUIRED-ARGUMENT :RIFFLE :SUBDIVIDE
:MKSTR :SYMB :TREE-COLLECT
@@ -208,6 +209,24 @@
values))
+ (declaim (inline iota))
+ (defun iota (n &key (start 0) (step 1))
+ "Return a list of `n` numbers, starting from `start` (with numeric contagion
+from `step` applied), each consequtive number being the sum of the previous one
+and `step`. `start` defaults to `0` and `step` to `1`.
+
+Examples:
+
+ (iota 4) => (0 1 2 3)
+ (iota 3 :start 1 :step 1.0) => (1.0 2.0 3.0)
+ (iota 3 :start -1 :step -1/2) => (-1 -3/2 -2)"
+ (declare (type (integer 0) n) (number start step))
+ (loop repeat n
+ ;; KLUDGE: get numeric contagion right for the first element too
+ for i = (+ (- (+ start step) step)) then (+ i step)
+ collect i))
+
+
(defun take (n sequence)
"Take the first `n` elements from `sequence`."
(subseq sequence 0 n))
@@ -268,6 +287,14 @@
,@forms)))))
+ (defun range (start end &key (step 1) (key 'identity))
+ "Return the list of numbers `n` such that `start <= n < end` and
+`n = start + k*step` for suitable integers `k`. If a function `key` is
+provided, then apply it to each number."
+ (assert (<= start end))
+ (loop :for i :from start :below end :by step :collecting (funcall key i)))
+
+
(defun rcurry (function &rest arguments)
"Returns a function that applies the arguments it is called
with and `arguments` to `function`."
@@ -449,7 +476,8 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(export '(compose curry define-constant ensure-gethash ensure-list
hash-table-alist hash-table-keys hash-table-plist hash-table-values
- n-grams once-only rcurry read-file-into-string required-argument
- riffle subdivide symb tree-collect with-gensyms with-unique-names)))
+ iota n-grams once-only range rcurry read-file-into-string
+ required-argument riffle subdivide symb tree-collect with-gensyms
+ with-unique-names)))
;;;; END OF quickutils.lisp ;;;;