From d7d6b9708fc11321366365b11f8b546c7fde4c45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kasper=20Ga=C5=82kowski?= Date: Fri, 14 Jun 2024 19:59:04 +0200 Subject: [PATCH] lisp version --- lisp/flake.lock | 25 +++++++ lisp/flake.nix | 21 ++++++ lisp/gnip.asd | 3 + lisp/gnip.lisp | 182 ++++++++++++++++++++++++++++++++++++++++++++++++ lisp/run.lisp | 5 ++ 5 files changed, 236 insertions(+) create mode 100644 lisp/flake.lock create mode 100644 lisp/flake.nix create mode 100644 lisp/gnip.asd create mode 100644 lisp/gnip.lisp create mode 100755 lisp/run.lisp diff --git a/lisp/flake.lock b/lisp/flake.lock new file mode 100644 index 0000000..6b28238 --- /dev/null +++ b/lisp/flake.lock @@ -0,0 +1,25 @@ +{ + "nodes": { + "nixpkgs": { + "locked": { + "lastModified": 1718276985, + "narHash": "sha256-u1fA0DYQYdeG+5kDm1bOoGcHtX0rtC7qs2YA2N1X++I=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "3f84a279f1a6290ce154c5531378acc827836fbb", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "nixpkgs": "nixpkgs" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/lisp/flake.nix b/lisp/flake.nix new file mode 100644 index 0000000..938a9f4 --- /dev/null +++ b/lisp/flake.nix @@ -0,0 +1,21 @@ +{ + description = "lisp env"; + + outputs = { self, nixpkgs }: let + inherit (nixpkgs) lib; + systems = ["x86_64-linux"]; + in { + devShells = lib.genAttrs systems (system: + let + pkgs = nixpkgs.legacyPackages.${system}; + in { + default = pkgs.mkShell { + packages = [ + (pkgs.sbcl.withPackages (ps: [ + ps.alexandria ps.distributions + ])) + ]; + }; + }); + }; +} diff --git a/lisp/gnip.asd b/lisp/gnip.asd new file mode 100644 index 0000000..d848d90 --- /dev/null +++ b/lisp/gnip.asd @@ -0,0 +1,3 @@ +(defsystem gnip + :depends-on (alexandria distributions) + :components ((:file gnip))) diff --git a/lisp/gnip.lisp b/lisp/gnip.lisp new file mode 100644 index 0000000..35bea05 --- /dev/null +++ b/lisp/gnip.lisp @@ -0,0 +1,182 @@ +(defpackage gnip + (:use :cl) + (:import-from :alexandria) + (:import-from :distributions)) + +(in-package gnip) + +(defstruct user + (id 0 :type (integer 0)) + (tweet-count 0 :type (integer 0))) + +(defstruct tweet + (user-id 0 :type alexandria:non-negative-fixnum) + (timestamp 0 :type alexandria:non-negative-fixnum)) + +(declaim (ftype (function ((integer 0) (double-float 0d0)) (vector user)) + gen-users)) +(defun gen-users (num-users shape) + (let ((scale 10d0) + (dist (distributions:r-log-normal 0d0 2.0d0)) + (users (make-array num-users :adjustable t :fill-pointer 0))) + (dotimes (id num-users) + (let ((tweet-count (max 0 (round (distributions:draw dist))))) + (vector-push-extend (make-user :id id :tweet-count tweet-count) users))) + users)) + +(declaim (ftype (function ((integer 0) + (double-float 0d0) + (integer 0) + (integer 0)) + (values (vector user) hash-table)) + gen-test-data)) +(defun gen-test-data (num-users shape start-time end-time) + (let ((users (gen-users num-users shape)) + (user-tweets (make-hash-table :test 'eql))) + (loop :for user :across users :do + (dotimes (_ (user-tweet-count user)) + (let* ((offset (random (- end-time start-time))) + (tweet-time (+ start-time offset)) + (tweet (make-tweet :user-id (user-id user) + :timestamp tweet-time))) + (vector-push-extend + tweet + (alexandria:ensure-gethash + (user-id user) + user-tweets + (make-array 22 :adjustable t :fill-pointer 0)))))) + (values users user-tweets))) + +(defstruct stats + (num-requests 0 :type (integer 0)) + (num-users 0 :type (integer 0)) + (num-tweets 0 :type (integer 0)) + (avg-tweets-per-user 0 :type (integer 0)) + (avg-tweets-per-req 0 :type (integer 0))) + +(declaim (ftype (function (stats (integer 0) hash-table) (values)) update-stats)) +(defun update-stats (stats reqs data) + (with-slots (num-requests num-users num-tweets avg-tweets-per-user avg-tweets-per-req) stats + (incf num-requests reqs) + (incf num-users (hash-table-count data)) + (incf num-tweets (loop :for v :being :the :hash-value :of data :sum v)) + (setf avg-tweets-per-user (truncate num-tweets num-users)) + (setf avg-tweets-per-req (truncate num-tweets num-requests)) + (values))) + +(declaim (ftype (function (tweet tweet) boolean) tweet<)) +(declaim (inline tweet<)) +(defun tweet< (a b) + (< (tweet-timestamp a) (tweet-timestamp b))) + +(declaim (ftype (function ((vector user) + hash-table + (integer 0) + (integer 0) + (member :all :first)) + (values (integer 0) hash-table)) + sim-request)) +(defun sim-request (users users-tweets max-tweets/request min-tweets/user mode) + (let ((results (make-hash-table)) + (tweets (make-array 0 :element-type 'tweet + :adjustable t + :fill-pointer 0))) + (loop :for user :of-type user :across users :do + (setf (gethash (user-id user) results) 0) + (multiple-value-bind (user-tweets present-p) + (gethash (user-id user) users-tweets) + (when present-p + (loop :for tweet :of-type tweet :across user-tweets :do + (vector-push-extend tweet tweets))))) + (locally (declare (inline sort)) (sort tweets #'tweet<)) + (let ((req-count 1) + (idx 0) + (batch-count 0)) + (loop :for tweet :across tweets :do + (incf idx) + (incf batch-count) + (incf (gethash (tweet-user-id tweet) results)) + (when (zerop (mod batch-count max-tweets/request)) + (multiple-value-bind (max-user-tweets min-user-tweets) + (loop :for v :being :the :hash-value :of results + :maximize v :into max + :minimize v :into min + :finally (return (values max min))) + (case mode + (:first + (if (>= max-user-tweets min-tweets/user) + (return) + (incf req-count))) + (:all + (if (>= min-user-tweets min-tweets/user) + (return) + (incf req-count))))))) + (values req-count results)))) + +(declaim (ftype (function ((vector user) + hash-table + (integer 0) + (integer 0) + (integer 0) + (member :all :first)) + stats) + sim-scenario)) +(defun sim-scenario + (users users-tweets max-tweets/request max-requests min-tweets/user mode) + (let ((stats (make-stats))) + (loop :for chunk :below (truncate (length users) 100) + :for users-chunk + := (make-array 100 :displaced-to users + :displaced-index-offset (* chunk 100)) + :do (multiple-value-bind (reqs data) + (sim-request users-chunk + users-tweets + max-tweets/request + min-tweets/user + mode) + (update-stats stats reqs data) + (when (>= (stats-num-requests stats) max-requests) + (return)))) + stats)) + +(defun run () + (let* ((num-users 10000000) + (start-time (- (sb-ext:get-time-of-day) (* 7 24 60 60))) + (end-time (sb-ext:get-time-of-day)) + (max-requests 12500)) + (multiple-value-bind (users tweets) + (gen-test-data num-users 1.5d0 start-time end-time) + (format t "total tweets: ~A~%" + (loop :for v :of-type (vector tweet) + :being :the :hash-value :of tweets + :sum (length v))) + ;; asc + (format t "asc all~%") + (sort users #'< :key #'user-tweet-count) + (format t "~A~%" (sim-scenario users tweets 500 max-requests 100 :all)) + (format t "====~%") + ;; desc + (format t "desc all~%") + (alexandria:nreversef users) + (format t "~A~%" (sim-scenario users tweets 500 max-requests 100 :all)) + (format t "====~%") + ;; random + (format t "random all~%") + (alexandria:shuffle users) + (format t "~A~%" (sim-scenario users tweets 500 max-requests 100 :all)) + (format t "====~%") + ;; asc first + (format t "asc first~%") + (sort users #'< :key #'user-tweet-count) + (format t "~A~%" (sim-scenario users tweets 500 max-requests 100 :first)) + (format t "====~%") + ;; desc first + (format t "desc first~%") + (alexandria:nreversef users) + (format t "~A~%" (sim-scenario users tweets 500 max-requests 100 :first)) + (format t "====~%") + ;; random first + (format t "random first~%") + (alexandria:shuffle users) + (format t "~A~%" (sim-scenario users tweets 500 max-requests 100 :first)) + (format t "====~%")))) diff --git a/lisp/run.lisp b/lisp/run.lisp new file mode 100755 index 0000000..2fa9b1b --- /dev/null +++ b/lisp/run.lisp @@ -0,0 +1,5 @@ +#!/usr/bin/env -S sbcl --dynamic-space-size 16GiB --script +(load (sb-ext:posix-getenv "ASDF")) +(push (truename ".") asdf:*central-registry*) +(asdf:load-system 'gnip) +(gnip::run)