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)))