# HG changeset patch # User ellis # Date 1703463879 18000 # Node ID c6d0a37a046a6a7b514fdca47aa60ef98810c489 # Parent 0f678bfd86993de6d7d307732ddf780ea90e4678 mini-redis and vegadat diff -r 0f678bfd8699 -r c6d0a37a046a examples/db/cl-simple-example.lisp --- a/examples/db/cl-simple-example.lisp Tue Dec 19 16:52:10 2023 -0500 +++ b/examples/db/cl-simple-example.lisp Sun Dec 24 19:24:39 2023 -0500 @@ -1,4 +1,4 @@ -;;; cl-simple-example.lisp --- Common Lisp port of rocksdb/example/c_simple_example.c +;;; cl-simple-example.lisp --- Common Lisp port of rocksdb/examples/c_simple_example.c ;; ref: https://github.com/facebook/rocksdb/blob/main/examples/c_simple_example.c @@ -32,18 +32,14 @@ |# ;;; Code: -(defpackage :examples/rdb/cl-simple-example - (:nicknames :cl-simple-example) +(defpackage :examples/cl-simple-example (:use :cl :std :cli :rdb :sb-alien :rocksdb) (:export :main)) -(rocksdb:load-rocksdb :save t) - -(in-package :cl-simple-example) +(in-package :exmaples/cl-simple-example) +(declaim (optimize (speed 3))) -(in-readtable :std) - -(defvar *num-cpus* (alien-funcall (extern-alien "sysconf" (function long integer)) sb-unix:sc-nprocessors-onln) +(defvar *num-cpus* (alien-funcall (extern-alien "sysconf" (function int int)) sb-unix:sc-nprocessors-onln) "CPU count.") (defparameter *db-path* "/tmp/rocksdb-cl-simple-example") @@ -52,8 +48,7 @@ (defmain () ;; open Backup Engine that we will use for backing up our database - (let ((options - (make-rocksdb-options + (let ((options (make-rocksdb-options (lambda (opt) (rocksdb-options-increase-parallelism opt *num-cpus*) ;; set # of online cores (rocksdb-options-optimize-level-style-compaction opt 0) diff -r 0f678bfd8699 -r c6d0a37a046a examples/db/mini-redis.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/db/mini-redis.lisp Sun Dec 24 19:24:39 2023 -0500 @@ -0,0 +1,126 @@ +;;; examples/db/mini-redis.lisp --- Mini-Redis client/server + +;; based on https://github.com/no-defun-allowed/concurrent-hash-tables/blob/master/Examples/phony-redis.lisp + +;;; Code: +(require 'sb-concurrency) +(defpackage :examples/mini-redis + (:use :cl :std :net :obj :cli :sb-concurrency :sb-thread) + (:export)) + +(in-package :examples/mini-redis) + +(defun make-server () + (make-castable :test #'equal)) + +(defstruct conn tx rx) + +(defun connect-to-server (server) + (let ((tx (make-mailbox)) + (rx (make-mailbox))) + (make-thread + (lambda () + (let ((msg (receive-message tx))) + (loop do + (case (car msg) + (:quit (return)) + (:get + (multiple-value-bind (val p) + (obj/hash:cgethash (cdr msg) server) + (if p + (send-message rx `(:found ,val)) + (send-message rx `(:not-found))))) + (:put + (setf (cgethash (cadr msg) server) + (copy-seq (caddr msg))) + (send-message rx '(:ok))) + (t (return)))))) + :name "mini-redis-conn") + (make-conn :tx tx :rx rx))) + +(defun find-val (conn name) + (send-message + (conn-tx conn) + `(:get ,name)) + (let ((rx (receive-message (conn-rx conn)))) + (case (car rx) + (:found + (values (cdr rx) t)) + (:not-found + (values nil nil))))) + +(defun (setf find-val) (val conn name) + (send-message + (conn-tx conn) + `(:put ,name ,val)) + (receive-message + (conn-rx conn))) + +(defun close-conn (conn) + (send-message + (conn-tx conn) + `(:quit))) + +(defun worker (n server + ready start + writer-proportion names) + (declare (optimize (speed 3)) + (single-float writer-proportion)) + (let ((name (elt names n)) + (bitmap (make-array 100 + :element-type '(unsigned-byte 8) + :initial-element 0)) + (conn (connect-to-server server))) + (dotimes (i 100) + (setf (aref bitmap i) + (if (< (random 1.0) writer-proportion) + 1 + 0))) + (signal-semaphore ready) + (wait-on-semaphore start) + (let ((position 0)) + (dotimes (o (the fixnum *ops*)) + (if (zerop (aref bitmap position)) + (find-val conn name) + (setf (find-val conn name) + #(1))) + (setf position (mod (1+ position) 100)))) + (close-conn conn))) + +(defparameter *worker-count* 8) +(defparameter *writer-proportion* 0.5) +(defvar *keys* + (loop for n below 130 by 2 + collect (format nil "~r" n))) +(defvar *other-keys* + (loop for n from 1 below 128 by 2 + collect (format nil "~r" n))) +(defvar *ops* 10000000) + +(defun run (&optional (worker-count *worker-count*) + (writer-proportion *writer-proportion*) + (keys *keys*)) + (let* ((ready (make-semaphore :name "ready-threads")) + (start (make-semaphore :name "start-threads")) + (server (make-server)) + (workers (loop for n below worker-count + collect (let ((n n)) + (make-thread + (lambda () + (worker n server + ready start + writer-proportion + keys))))))) + (dotimes (n worker-count) + (wait-on-semaphore ready)) + (let ((start-time (get-internal-real-time))) + (signal-semaphore start worker-count) + (mapc #'join-thread workers) + (let* ((time (float (/ (- (get-internal-real-time) start-time) + internal-time-units-per-second))) + (throughput (/ (* *ops* worker-count) time))) + (format t "~&~20@a: ~$ seconds (~d transactions/second)" + "mini-redis" time (round throughput)))))) + +(defmain () + (run 4 1.0 *keys*)) diff -r 0f678bfd8699 -r c6d0a37a046a examples/db/tao.lisp --- a/examples/db/tao.lisp Tue Dec 19 16:52:10 2023 -0500 +++ b/examples/db/tao.lisp Sun Dec 24 19:24:39 2023 -0500 @@ -1,13 +1,14 @@ -;;; tao.lisp --- Common Lisp implementation of the TAO data model +;;; examples/db/tao.lisp --- Common Lisp implementation of the TAO data model ;; https://research.facebook.com/publications/tao-facebooks-distributed-data-store-for-the-social-graph/ +;; a minimal Lisp implementation of TAO. + ;;; Code: -(defpackage :examples/rdb/tao - (:nicknames :tao) +(defpackage :examples/tao (:use :cl :std :cli :rdb) (:export :main)) -(in-package :tao) +(in-package :examples/tao) (defmain ()) diff -r 0f678bfd8699 -r c6d0a37a046a examples/vegadat.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/vegadat.lisp Sun Dec 24 19:24:39 2023 -0500 @@ -0,0 +1,38 @@ +;; from https://github.com/Lisp-Stat/plot/blob/master/src/vega/vega-datasets.lisp +(defpackage :examples/vegadat + (:use :cl :std :net/fetch :dat) + (:export + :*vega-datasets* :*vega-dataset-base-url* + :fetch-vega-dataset)) + +(in-package :examples/vegadat) + +(defparameter *vega-dataset-base-url* "http://raw.githubusercontent.com/vega/vega-datasets/main/data/" + "Base URL for datasets included in Vega") + +(defparameter *vega-dataset-stash* "vega/") + + +;; (gethash :airpots *vega-datasets*) +(defvar *vega-datasets* (make-hash-table :size 66 :test #'equal) + "All Vega example data sets. k=symbol,v=url") + +(defun push-dataset (key) + "Push a dataset to *VEGA-DATASETS* by filename." + (let ((val (concatenate 'string *vega-dataset-base-url* key))) + (setf (gethash key *vega-datasets*) val))) + +;; 66 files total, mostly json and csv. 1 tsv file, 1 arrow file. +(mapc #'push-dataset + '("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")) + +(defun fetch-vega-datasets () + (ensure-directories-exist *vega-dataset-stash*) + (maphash-keys + (lambda (x) (download (gethash x *vega-datasets*) + (merge-pathnames x *vega-dataset-stash*))) + *vega-datasets*)) + +(defun purge-vega-datasets () + (std:when-let ((stash (probe-file *vega-dataset-stash*))) + (sb-ext:delete-directory stash :recursive t)))