--- a/package.lisp Fri Oct 14 22:51:16 2016 +0000
+++ b/package.lisp Sat Nov 12 12:51:30 2016 +0000
@@ -1,242 +1,243 @@
; (rename-package :charms :hunchentoot '(:ht))
-(defpackage #:sand.utils
+(defpackage :sand.utils
(:use
- #:cl
- #:losh
- #:iterate
- #:cl-arrows
- #:sand.quickutils)
+ :cl
+ :losh
+ :iterate
+ :cl-arrows
+ :sand.quickutils)
(:export
- #:average4)
- (:shadowing-import-from #:cl-arrows
- #:->))
+ :average4)
+ (:shadowing-import-from :cl-arrows
+ :->))
-(defpackage #:sand.primes
+(defpackage :sand.primes
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :sand.quickutils
+ :sand.utils)
(:export
- #:primep))
+ :primep))
-(defpackage #:sand.random-numbers
+(defpackage :sand.random-numbers
(:use
- #:cl
- #:losh
- #:iterate
- #:cl-arrows
- #:sand.quickutils
- #:sand.utils)
- (:shadowing-import-from #:cl-arrows
- #:->))
+ :cl
+ :losh
+ :iterate
+ :cl-arrows
+ :sand.quickutils
+ :sand.utils)
+ (:shadowing-import-from :cl-arrows
+ :->))
-(defpackage #:sand.parenscript
+(defpackage :sand.parenscript
(:use
- #:cl
- #:losh
- #:sand.quickutils
- #:cl-arrows
- #:cl-fad
- #:parenscript)
- (:shadowing-import-from #:cl-arrows
- #:->)
- (:shadowing-import-from #:losh
- #:%))
+ :cl
+ :losh
+ :sand.quickutils
+ :cl-arrows
+ :cl-fad
+ :parenscript)
+ (:shadowing-import-from :cl-arrows
+ :->)
+ (:shadowing-import-from :losh
+ :%))
-(defpackage #:sand.ascii
+(defpackage :sand.ascii
(:use
- #:cl
- #:losh
- #:iterate
- #:cl-arrows
- #:sand.quickutils
- #:sand.utils))
+ :cl
+ :losh
+ :iterate
+ :cl-arrows
+ :sand.quickutils
+ :sand.utils))
-(defpackage #:sand.terrain.diamond-square
+(defpackage :sand.terrain.diamond-square
(:use
- #:cl
- #:losh
- #:iterate
- #:cl-arrows
- #:sand.quickutils
- #:sand.utils))
+ :cl
+ :losh
+ :iterate
+ :cl-arrows
+ :sand.quickutils
+ :sand.utils))
-(defpackage #:sand.sketch
+(defpackage :sand.sketch
(:use
- #:cl
- #:losh
- #:sketch
- #:iterate
- #:sand.quickutils
- #:sand.utils)
- (:shadowing-import-from #:iterate
- #:in)
- (:shadowing-import-from #:sketch
- #:degrees
- #:radians))
+ :cl
+ :losh
+ :sketch
+ :iterate
+ :sand.quickutils
+ :sand.utils)
+ (:shadowing-import-from :iterate
+ :in)
+ (:shadowing-import-from :sketch
+ :degrees
+ :radians))
-(defpackage #:sand.markov
+(defpackage :sand.markov
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:split-sequence
- #:sand.quickutils
- #:sand.utils))
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :split-sequence
+ :sand.quickutils
+ :sand.utils))
-(defpackage #:sand.dijkstra-maps
+(defpackage :sand.dijkstra-maps
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :sand.quickutils
+ :sand.utils)
(:export
- #:dijkstra-map
- #:make-dijkstra-map
- #:dm-maximum-value
- #:dm-map
- #:dm-ref))
+ :dijkstra-map
+ :make-dijkstra-map
+ :dm-maximum-value
+ :dm-map
+ :dm-ref))
-(defpackage #:sand.graphs
+(defpackage :sand.graphs
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :sand.quickutils
+ :sand.utils)
(:export
))
-(defpackage #:sand.graphviz
+(defpackage :sand.graphviz
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :sand.quickutils
+ :sand.utils)
(:export
- #:graphviz-digraph))
+ :graphviz-digraph))
-(defpackage #:sand.binary-decision-diagrams
+(defpackage :sand.binary-decision-diagrams
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:sand.graphviz
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :sand.graphviz
+ :sand.quickutils
+ :sand.utils)
(:export
))
-(defpackage #:sand.zero-suppressed-decision-diagrams
+(defpackage :sand.zero-suppressed-decision-diagrams
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:sand.graphviz
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :sand.graphviz
+ :sand.quickutils
+ :sand.utils)
(:export
)
- (:nicknames #:sand.zdd))
+ (:nicknames :sand.zdd))
-(defpackage #:sand.huffman-trees
+(defpackage :sand.huffman-trees
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:sand.graphviz
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :sand.graphviz
+ :sand.quickutils
+ :sand.utils)
(:export
))
-(defpackage #:sand.rubiks
+(defpackage :sand.streams
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:sand.quickutils
- #:sand.utils)
- (:export
- ))
-
-(defpackage #:sand.streams
- (:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:sand.primes
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :sand.primes
+ :sand.quickutils
+ :sand.utils)
(:export
))
#+sbcl
-(defpackage #:sand.ffi
+(defpackage :sand.ffi
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:cffi
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :cffi
+ :sand.quickutils
+ :sand.utils)
(:export
))
-(defpackage #:sand.color-difference
+(defpackage :sand.color-difference
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:rs-colors
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :rs-colors
+ :sand.quickutils
+ :sand.utils)
(:export
))
#+sbcl
-(defpackage #:sand.profiling
+(defpackage :sand.profiling
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :sand.quickutils
+ :sand.utils)
(:export
- #:start-profiling
- #:stop-profiling
- #:profile))
+ :start-profiling
+ :stop-profiling
+ :profile))
-(defpackage #:sand.number-letters
+(defpackage :sand.number-letters
(:use
- #:cl
- #:cl-arrows
- #:losh
- #:iterate
- #:function-cache
- #:sand.quickutils
- #:sand.utils)
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :function-cache
+ :sand.quickutils
+ :sand.utils)
(:export
))
+(defpackage :sand.urn
+ (:use
+ :cl
+ :cl-arrows
+ :losh
+ :iterate
+ :sand.quickutils
+ :sand.utils)
+ (:export
+ ))
+
+
--- a/sand.asd Fri Oct 14 22:51:16 2016 +0000
+++ b/sand.asd Sat Nov 12 12:51:30 2016 +0000
@@ -41,6 +41,7 @@
(:file "primes")
(:file "graphs")
(:file "graphviz")
+ (:file "urn")
(:file "random-numbers")
(:file "ascii")
(:file "markov")
@@ -53,7 +54,6 @@
(:file "streams")
(:file "color-difference")
(:file "number-letters")
- (:file "rubiks")
(:module "terrain"
:serial t
:components ((:file "diamond-square")))
--- a/src/rubiks.lisp Fri Oct 14 22:51:16 2016 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,118 +0,0 @@
-(in-package #:sand.rubiks)
-
-; (declaim (optimize (speed 1) (safety 3) (debug 3)))
-
-(deftype cube () '(simple-array t (6 9)))
-
-(defun make-solved-cube ()
- (make-array '(6 9)
- :adjustable nil
- ; :element-type 'symbol
- :initial-contents
- '((w w w w w w w w w) ; top
- (g g g g g g g g g) ; left
- (r r r r r r r r r) ; front
- (b b b b b b b b b) ; right
- (o o o o o o o o o) ; back
- (y y y y y y y y y)))) ; down
-
-
-(defun face-index (face)
- (case face
- (:top 0)
- (:left 1)
- (:front 2)
- (:right 3)
- (:back 4)
- (:down 5)))
-
-
-(defmacro defaccessor (name face)
- `(defmacro ,name (cube n)
- `(aref ,cube ,(face-index ,face) ,n)))
-
-
-(defaccessor top :top)
-(defaccessor down :down)
-(defaccessor left :left)
-(defaccessor right :right)
-(defaccessor front :front)
-(defaccessor back :back)
-
-(defmacro define-move (name &rest groups)
- (flet ((access (spec)
- `(,(first spec) cube ,(second spec))))
- `(progn
- (declaim (ftype (function (cube) null) ,name))
- (defun ,name (cube)
- ,@(mapcar (lambda (group)
- `(rotatef ,@(mapcar #'access group)))
- groups)
- nil))))
-
-; 0 1 2
-; 3 4 5
-; 6 7 8
-; 0 1 2 0 1 2 0 1 2 0 1 2
-; 3 4 5 3 4 5 3 4 5 3 4 5
-; 6 7 8 6 7 8 6 7 8 6 7 8
-; 0 1 2
-; 3 4 5
-; 6 7 8
-
-(define-move move-front
- ((front 0) (front 6) (front 8) (front 2))
- ((front 1) (front 3) (front 7) (front 5))
- ((top 6) (left 8) (down 2) (right 0))
- ((top 7) (left 5) (down 1) (right 3))
- ((top 8) (left 2) (down 0) (right 6)))
-
-(define-move move-top
- ((top 0) (top 6) (top 8) (top 2))
- ((top 1) (top 3) (top 7) (top 5))
- ((front 0) (right 0) (back 0) (left 0))
- ((front 1) (right 1) (back 1) (left 1))
- ((front 2) (right 2) (back 2) (left 2)))
-
-(define-move move-left
- ((left 0) (left 6) (left 8) (left 2))
- ((left 1) (left 3) (left 7) (left 5))
- ((front 0) (top 0) (back 2) (down 0))
- ((front 3) (top 3) (back 5) (down 3))
- ((front 6) (top 6) (back 8) (down 6)))
-
-(define-move move-right
- ((right 0) (right 6) (right 8) (right 2))
- ((right 1) (right 3) (right 7) (right 5))
- ((front 2) (down 2) (back 8) (top 2))
- ((front 5) (down 5) (back 5) (top 5))
- ((front 8) (down 8) (back 2) (top 8)))
-
-
-
-(defun print-cube (cube)
- (flet ((pad ()
- (format t " "))
- (row (face row)
- (format t "~A ~A ~A "
- (aref cube (face-index face) (+ 0 (* row 3)))
- (aref cube (face-index face) (+ 1 (* row 3)))
- (aref cube (face-index face) (+ 2 (* row 3))))))
- (pad) (row :top 0) (terpri)
- (pad) (row :top 1) (terpri)
- (pad) (row :top 2) (terpri)
- (row :left 0) (row :front 0) (row :right 0) (row :back 0) (terpri)
- (row :left 1) (row :front 1) (row :right 1) (row :back 1) (terpri)
- (row :left 2) (row :front 2) (row :right 2) (row :back 2) (terpri)
- (pad) (row :down 0) (terpri)
- (pad) (row :down 1) (terpri)
- (pad) (row :down 2) (terpri))
- (values))
-
-
-(defparameter *c* (make-solved-cube))
-; (move-front *c*)
-; (move-top *c*)
-; (move-left *c*)
-; (move-right *c*)
-; (print-cube *c*)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/urn.lisp Sat Nov 12 12:51:30 2016 +0000
@@ -0,0 +1,52 @@
+(in-package :sand.urn)
+
+(defun make-vec-from (contents)
+ (make-array (length contents)
+ :initial-contents contents
+ :fill-pointer (length contents)
+ :adjustable t))
+
+(defun make-empty-vec (size)
+ (make-array size
+ :fill-pointer 0
+ :adjustable t))
+
+
+(defun sample (population size)
+ (let ((result (make-empty-vec size)))
+ (dotimes (_ size)
+ (vector-push-extend (random-elt population) result))
+ result))
+
+(defun unsample (sample target-size)
+ (recursively ((sample sample))
+ (if (= (length sample) target-size)
+ sample
+ (progn (vector-push-extend (random-elt sample) sample)
+ (recur sample)))))
+
+
+
+(defparameter *population*
+ (make-vec-from
+ (append (make-list 1000 :initial-element 'a)
+ (make-list 3000 :initial-element 'b)
+ (make-list 500 :initial-element 'c))))
+
+
+; (print-hash-table (frequencies *population*))
+; (print-hash-table (proportions *population* :float t))
+
+; (-<> *population*
+; (sample <> 100)
+; (unsample <> 1000)
+; (proportions <> :float t)
+; (print-hash-table <>)
+; )
+
+; (-<> *population*
+; (sample <> 100)
+; (proportions <> :float nil)
+; (print-hash-table <>)
+; )
+