src/urn.lisp @ 326c2d62fceb

Get this shit compiling with the new cl-losh
author Steve Losh <steve@stevelosh.com>
date Thu, 26 Jan 2017 22:54:28 +0000
parents 1b413ff8aa5f
children bc8ed2a9b4c0
(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 <>)
;   )