changelog shortlog graph tags branches files raw help

Mercurial > demo / changeset: mini-redis and vegadat

changeset 37: c6d0a37a046a
parent 36: 0f678bfd8699
child 38: 8259376eee11
author: ellis <ellis@rwest.io>
date: Sun, 24 Dec 2023 19:24:39 -0500
files: examples/db/cl-simple-example.lisp examples/db/mini-redis.lisp examples/db/tao.lisp examples/vegadat.lisp
description: mini-redis and vegadat
     1.1--- a/examples/db/cl-simple-example.lisp	Tue Dec 19 16:52:10 2023 -0500
     1.2+++ b/examples/db/cl-simple-example.lisp	Sun Dec 24 19:24:39 2023 -0500
     1.3@@ -1,4 +1,4 @@
     1.4-;;; cl-simple-example.lisp --- Common Lisp port of rocksdb/example/c_simple_example.c
     1.5+;;; cl-simple-example.lisp --- Common Lisp port of rocksdb/examples/c_simple_example.c
     1.6 
     1.7 ;; ref: https://github.com/facebook/rocksdb/blob/main/examples/c_simple_example.c
     1.8 
     1.9@@ -32,18 +32,14 @@
    1.10 |#
    1.11 
    1.12 ;;; Code:
    1.13-(defpackage :examples/rdb/cl-simple-example
    1.14-  (:nicknames :cl-simple-example)
    1.15+(defpackage :examples/cl-simple-example
    1.16   (:use :cl :std :cli :rdb :sb-alien :rocksdb)
    1.17   (:export :main))
    1.18 
    1.19-(rocksdb:load-rocksdb :save t)
    1.20-
    1.21-(in-package :cl-simple-example)
    1.22+(in-package :exmaples/cl-simple-example)
    1.23+(declaim (optimize (speed 3)))
    1.24 
    1.25-(in-readtable :std)
    1.26-
    1.27-(defvar *num-cpus* (alien-funcall (extern-alien "sysconf" (function long integer)) sb-unix:sc-nprocessors-onln)
    1.28+(defvar *num-cpus* (alien-funcall (extern-alien "sysconf" (function int int)) sb-unix:sc-nprocessors-onln)
    1.29   "CPU count.")
    1.30 
    1.31 (defparameter *db-path* "/tmp/rocksdb-cl-simple-example")
    1.32@@ -52,8 +48,7 @@
    1.33 
    1.34 (defmain ()
    1.35   ;; open Backup Engine that we will use for backing up our database
    1.36-  (let ((options 
    1.37-          (make-rocksdb-options 
    1.38+  (let ((options (make-rocksdb-options 
    1.39                   (lambda (opt)
    1.40                     (rocksdb-options-increase-parallelism opt *num-cpus*) ;; set # of online cores
    1.41                     (rocksdb-options-optimize-level-style-compaction opt 0)
     2.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2+++ b/examples/db/mini-redis.lisp	Sun Dec 24 19:24:39 2023 -0500
     2.3@@ -0,0 +1,126 @@
     2.4+;;; examples/db/mini-redis.lisp --- Mini-Redis client/server
     2.5+
     2.6+;; based on https://github.com/no-defun-allowed/concurrent-hash-tables/blob/master/Examples/phony-redis.lisp
     2.7+
     2.8+;;; Code:
     2.9+(require 'sb-concurrency)
    2.10+(defpackage :examples/mini-redis
    2.11+  (:use :cl :std :net :obj :cli :sb-concurrency :sb-thread)
    2.12+  (:export))
    2.13+
    2.14+(in-package :examples/mini-redis)
    2.15+
    2.16+(defun make-server ()
    2.17+  (make-castable :test #'equal))
    2.18+
    2.19+(defstruct conn tx rx)
    2.20+
    2.21+(defun connect-to-server (server)
    2.22+  (let ((tx (make-mailbox))
    2.23+        (rx (make-mailbox)))
    2.24+    (make-thread 
    2.25+     (lambda ()
    2.26+       (let ((msg (receive-message tx)))
    2.27+         (loop do
    2.28+           (case (car msg)
    2.29+             (:quit (return))
    2.30+             (:get 
    2.31+              (multiple-value-bind (val p)
    2.32+                  (obj/hash:cgethash (cdr msg) server)
    2.33+                (if p
    2.34+                    (send-message rx `(:found ,val))
    2.35+                    (send-message rx `(:not-found)))))
    2.36+             (:put
    2.37+              (setf (cgethash (cadr msg) server)
    2.38+                    (copy-seq (caddr msg)))
    2.39+              (send-message rx '(:ok)))
    2.40+             (t (return))))))
    2.41+     :name "mini-redis-conn")
    2.42+    (make-conn :tx tx :rx rx)))
    2.43+
    2.44+(defun find-val (conn name)
    2.45+  (send-message
    2.46+   (conn-tx conn)
    2.47+   `(:get ,name))
    2.48+  (let ((rx (receive-message (conn-rx conn))))
    2.49+    (case (car rx)
    2.50+      (:found
    2.51+       (values (cdr rx) t))
    2.52+      (:not-found
    2.53+       (values nil nil)))))
    2.54+
    2.55+(defun (setf find-val) (val conn name)
    2.56+  (send-message
    2.57+   (conn-tx conn)
    2.58+   `(:put ,name ,val))
    2.59+  (receive-message
    2.60+   (conn-rx conn)))
    2.61+
    2.62+(defun close-conn (conn)
    2.63+  (send-message
    2.64+   (conn-tx conn)
    2.65+   `(:quit)))
    2.66+
    2.67+(defun worker (n server
    2.68+               ready start
    2.69+               writer-proportion names)
    2.70+  (declare (optimize (speed 3))
    2.71+           (single-float writer-proportion))
    2.72+  (let ((name (elt names n))
    2.73+        (bitmap (make-array 100
    2.74+                            :element-type '(unsigned-byte 8)
    2.75+                            :initial-element 0))
    2.76+        (conn (connect-to-server server)))
    2.77+    (dotimes (i 100)
    2.78+      (setf (aref bitmap i)
    2.79+            (if (< (random 1.0) writer-proportion)
    2.80+                1
    2.81+                0)))
    2.82+    (signal-semaphore ready)
    2.83+    (wait-on-semaphore start)
    2.84+    (let ((position 0))
    2.85+      (dotimes (o (the fixnum *ops*))
    2.86+        (if (zerop (aref bitmap position))
    2.87+            (find-val conn name)
    2.88+            (setf (find-val conn name)
    2.89+                  #(1)))
    2.90+        (setf position (mod (1+ position) 100))))
    2.91+    (close-conn conn)))
    2.92+
    2.93+(defparameter *worker-count* 8)
    2.94+(defparameter *writer-proportion* 0.5)
    2.95+(defvar *keys*
    2.96+  (loop for n below 130 by 2
    2.97+        collect (format nil "~r" n)))
    2.98+(defvar *other-keys*
    2.99+  (loop for n from 1 below 128 by 2
   2.100+        collect (format nil "~r" n)))
   2.101+(defvar *ops* 10000000)
   2.102+
   2.103+(defun run (&optional (worker-count *worker-count*)
   2.104+              (writer-proportion *writer-proportion*)
   2.105+              (keys *keys*))
   2.106+  (let* ((ready (make-semaphore :name "ready-threads"))
   2.107+         (start (make-semaphore :name "start-threads"))
   2.108+         (server (make-server))
   2.109+         (workers (loop for n below worker-count
   2.110+                        collect (let ((n n))
   2.111+                                  (make-thread
   2.112+                                   (lambda ()
   2.113+                                     (worker n server
   2.114+                                             ready start
   2.115+                                             writer-proportion
   2.116+                                             keys)))))))
   2.117+    (dotimes (n worker-count)
   2.118+      (wait-on-semaphore ready))
   2.119+    (let ((start-time (get-internal-real-time)))
   2.120+      (signal-semaphore start worker-count)
   2.121+      (mapc #'join-thread workers)
   2.122+      (let* ((time (float (/ (- (get-internal-real-time) start-time)
   2.123+                             internal-time-units-per-second)))
   2.124+             (throughput (/ (* *ops* worker-count) time)))
   2.125+        (format t "~&~20@a: ~$ seconds (~d transactions/second)"
   2.126+                "mini-redis" time (round throughput))))))
   2.127+
   2.128+(defmain ()
   2.129+  (run 4 1.0 *keys*))
     3.1--- a/examples/db/tao.lisp	Tue Dec 19 16:52:10 2023 -0500
     3.2+++ b/examples/db/tao.lisp	Sun Dec 24 19:24:39 2023 -0500
     3.3@@ -1,13 +1,14 @@
     3.4-;;; tao.lisp --- Common Lisp implementation of the TAO data model
     3.5+;;; examples/db/tao.lisp --- Common Lisp implementation of the TAO data model
     3.6 
     3.7 ;; https://research.facebook.com/publications/tao-facebooks-distributed-data-store-for-the-social-graph/
     3.8 
     3.9+;; a minimal Lisp implementation of TAO.
    3.10+
    3.11 ;;; Code:
    3.12-(defpackage :examples/rdb/tao
    3.13-  (:nicknames :tao)
    3.14+(defpackage :examples/tao
    3.15   (:use :cl :std :cli :rdb)
    3.16   (:export :main))
    3.17 
    3.18-(in-package :tao)
    3.19+(in-package :examples/tao)
    3.20 
    3.21 (defmain ())
     4.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2+++ b/examples/vegadat.lisp	Sun Dec 24 19:24:39 2023 -0500
     4.3@@ -0,0 +1,38 @@
     4.4+;; from https://github.com/Lisp-Stat/plot/blob/master/src/vega/vega-datasets.lisp
     4.5+(defpackage :examples/vegadat
     4.6+  (:use :cl :std :net/fetch :dat)
     4.7+  (:export 
     4.8+   :*vega-datasets* :*vega-dataset-base-url*
     4.9+   :fetch-vega-dataset))
    4.10+
    4.11+(in-package :examples/vegadat)
    4.12+
    4.13+(defparameter *vega-dataset-base-url* "http://raw.githubusercontent.com/vega/vega-datasets/main/data/"
    4.14+  "Base URL for datasets included in Vega")
    4.15+
    4.16+(defparameter *vega-dataset-stash* "vega/")
    4.17+
    4.18+
    4.19+;; (gethash :airpots *vega-datasets*)
    4.20+(defvar *vega-datasets* (make-hash-table :size 66 :test #'equal)
    4.21+  "All Vega example data sets. k=symbol,v=url")
    4.22+
    4.23+(defun push-dataset (key)
    4.24+  "Push a dataset to *VEGA-DATASETS* by filename."
    4.25+  (let ((val (concatenate 'string *vega-dataset-base-url* key)))
    4.26+    (setf (gethash key *vega-datasets*) val)))
    4.27+
    4.28+;; 66 files total, mostly json and csv. 1 tsv file, 1 arrow file.
    4.29+(mapc #'push-dataset
    4.30+      '("airports.csv" "annual-precip.json" "anscombe.json" "barley.json" "budget.json" "budgets.json" "burtin.json" "cars.json" "countries.json" "crimea.json" "driving.json" "earthquakes.json" "flare-dependencies.json" "flare.json" "flights-10k.json" "flights-200k.json" "flights-20k.json" "flights-2k.json" "flights-5k.json" "football.json" "gapminder.json" "income.json" "jobs.json" "londonBoroughs.json" "londonCentroids.json" "londonTubeLines.json" "miserables.json" "monarchs.json" "movies.json" "normal-2d.json" "obesity.json" "ohlc.json" "penguins.json" "points.json" "political-contributions.json" "population.json" "udistrict.json" "unemployment-across-industries.json" "uniform-2d.json" "us-10m.json" "us-state-capitals.json" "volcano.json" "weather.json" "wheat.json" "world-110m.json" "airports.csv" "birdstrikes.csv" "co2-concentration.csv" "disasters.csv" "flights-3m.csv" "flights-airport.csv" "gapminder-health-income.csv" "github.csv" "iowa-electricity.csv" "la-riots.csv" "lookup_groups.csv" "lookup_people.csv" "population_engineers_hurricanes.csv" "seattle-weather-hourly-normals.csv" "seattle-weather.csv" "sp500-2000.csv" "sp500.csv" "stocks.csv" "us-employment.csv" "weather.csv" "windvectors.csv" "zipcodes.csv" "unemployment.tsv" "flights-200k.arrow"))
    4.31+
    4.32+(defun fetch-vega-datasets ()
    4.33+  (ensure-directories-exist *vega-dataset-stash*)
    4.34+  (maphash-keys
    4.35+   (lambda (x) (download (gethash x *vega-datasets*) 
    4.36+                         (merge-pathnames x *vega-dataset-stash*)))
    4.37+   *vega-datasets*))
    4.38+
    4.39+(defun purge-vega-datasets ()
    4.40+  (std:when-let ((stash (probe-file *vega-dataset-stash*)))
    4.41+    (sb-ext:delete-directory stash :recursive t)))