From d5cfe31b12886d87a766de542d61e8fbf8a3f9ef Mon Sep 17 00:00:00 2001 From: Alejandro Gallo Date: Fri, 7 Oct 2022 01:11:22 +0200 Subject: [PATCH] Add naive tuples scracth file --- misc/naive-tuples.lisp | 275 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 275 insertions(+) create mode 100644 misc/naive-tuples.lisp diff --git a/misc/naive-tuples.lisp b/misc/naive-tuples.lisp new file mode 100644 index 0000000..b18175e --- /dev/null +++ b/misc/naive-tuples.lisp @@ -0,0 +1,275 @@ +(defun tuples-atrip (nv) + (declare (optimize (speed 3) (safety 0) (debug 0))) + (loop :for a :below nv + :append + (loop :for b :from a :below nv + :append + (loop :for c :from b :below nv + :unless (= a b c) + :collect (list a b c))))) + +(defun tuples-half (nv) + (declare (optimize (speed 3) (safety 0) (debug 0))) + (loop :for a :below nv + :append + (loop :for b :from a :below nv + :append + (loop :for c :from b :below nv + :collect (list a b c))))) + +(defun tuples-all (nv) + (declare (optimize (speed 3) (safety 0) (debug 0))) + (loop :for a :below nv + :append + (loop :for b :below nv + :append + (loop :for c :below nv + :collect (list a b c))))) + +(defun tuples-all-nth (i nv) + (declare (optimize (speed 3) (safety 0) (debug 0))) + (list (floor i (* nv nv)) + (mod (floor i nv) nv) + (mod i nv))) + + +(defparameter tups (tuples-all 10)) + +(defun compare-all (l) + (declare (optimize (speed 3) (safety 0) (debug 0))) + (let* ((tups (tuples-all l))) + (loop for i below (length tups) + do (let* ((good (nth i tups)) + (bad (tuples-all-nth i l)) + (eq? (equal good bad))) + (unless eq? + (print (list :|i| i + :good good + :bad bad))))))) + + +;; (defun a-half (i nv) +;; (let ((divisor t) +;; (j i) +;; (total-blk 0)) +;; (loop :for a :below nv +;; :unless (eq divisor 0) +;; :do (let ((blk (a-block a nv))) +;; (multiple-value-bind (d r) (floor j blk) +;; (declare (ignore r)) +;; (when (> d 0) +;; (incf total-blk blk)) +;; (setq j (- j blk) +;; divisor d))) +;; :else +;; :return (values (- a 1) +;; i +;; total-blk)))) + +;; (defun b-half (i a nv a-block-sum) +;; "we have +;; \begin{equation} +;; i = \underbrace{B(a_0) + +;; \cdots + +;; B(a_{i-1})}_{\texttt{a-block-sum}} +;; + idx +;; \end{equation} +;; and with this we just have to divide. +;; " +;; (let ((bj (if (> a-block-sum 0) +;; (mod i a-block-sum) +;; i)) +;; (total-blk 0)) +;; (loop :for b :from a :below Nv +;; :with divisor = 1 +;; :unless (eq divisor 0) +;; :do (let ((blk (+ (- nv a) +;; #|because|# 1))) +;; (incf total-blk blk) +;; (if (> blk 0) +;; (multiple-value-bind (d r) (floor bj blk) +;; (declare (ignore r)) +;; (setq bj (- bj blk) +;; divisor d)) +;; (setq divisor 0))) +;; :else +;; :return (values (- b 1) +;; bj +;; total-blk)))) + +(defun a-block (a nv) + (declare (optimize (speed 3) (safety 0) (debug 0))) + (- (* (- nv 1) (- nv (- a 1))) + (- (floor (* (- nv 1) nv) + 2) + (floor (* (- a 1) (- a 2)) + 2)))) + +(defun a-block-sum (|t| nv) + (macrolet ((ssum (n) `(floor (* ,n (+ ,n 1)) + 2)) + (qsum (n) `(floor (* ,n + (+ ,n 1) + (+ 1 (* 2 ,n))) + 6))) + (let ((nv-1 (- nv 1)) + (t+1 (+ |t| 1))) + (+ (* t+1 nv-1 nv) + (* nv-1 t+1) + (- (* nv-1 + (ssum |t|))) + (- (* t+1 + (ssum nv-1))) + (floor (- (qsum |t|) + (* 3 (ssum |t|))) + 2) + t+1)))) + +(defun get-half (i nv &key from block) + (let ((divisor 1) + (j i) + (total-blk 0)) + (loop :for α :from from :below nv + :unless (eq divisor 0) + :do (let ((blk (funcall block α nv))) + (multiple-value-bind (d r) (floor j blk) + (declare (ignore r)) + (when (> d 0) + (incf total-blk blk) + (setq j (- j blk))) + (setq divisor d))) + :else + :return (values (- α 1) + j + total-blk)))) + +(defun tuples-half-nth (i nv) + (declare (optimize (speed 3) (safety 0) (debug 0))) + (flet ((bc-block (x %nv) + (+ 1 (- %nv x)))) + (multiple-value-bind (a aj blks) (get-half i nv :from 0 :block #'a-block) + (declare (ignore blks)) + (multiple-value-bind (b bj blks) (get-half aj nv + :from a + :block #'bc-block) + (declare (ignore blks)) + (multiple-value-bind (c cj blks) (get-half bj nv + :from b + :block #'bc-block) + (declare (ignore cj blks)) + (print (list :idxs aj bj cj)) + (list a b c)))))) + +(defun a-block-atrip (a nv) + (declare (optimize (speed 3) (safety 0) (debug 0))) + (- (a-block a nv) 1)) + +(defun a-block-sum-atrip (|t| nv) + (declare (optimize (speed 3) (safety 0) (debug 0))) + (- (a-block-sum |t| nv) (+ |t| 1))) + +(defun b-block-sum-atrip (a |t| nv) + (- (* nv + (1+ (- |t| a))) + (floor (- (* |t| (1+ |t|)) + (* a (- a 1))) + 2) + 1)) + +(defun nth-atrip (i nv) + (let ((sums (mapcar (lambda (s) (a-block-sum-atrip s nv)) + (loop :for j :below nv :collect j)))) + (multiple-value-bind (a ablk) + (loop :for sum :in sums + :with a = -1 + :with base = 0 + :do (incf a) + :if (eq (floor i sum) 0) + :return (values a base) + :else + :do (setq base sum)) + (multiple-value-bind (b bblk) + (let ((sums (mapcar (lambda (s) + (+ ablk + #+nil(- nv s 1) + (b-block-sum-atrip a s nv))) + (loop :for b :from a :below nv + :collect b)))) + (loop :for sum :in sums + :with b = (- a 1) + :with base = ablk + :do (incf b) + :if (< i sum) + :return (values b base) + :else + :do (progn + ;; (print sums) + (setq base sum)))) + (list a b (+ b + (- i bblk) + (if (eq a b) + 1 + 0))))))) + +(defun atrip-test (i nv) + (let ((tuples (tuples-atrip nv)) + (cheaper (nth-atrip i nv))) + (values (nth i tuples) + cheaper + (print (equal (nth i tuples) + cheaper))))) + +(let* ((l 101) + (tuples (tuples-atrip l))) + (loop :for a below l + :do (print (let ((s (a-block-atrip a l)) + (c (count-if (lambda (x) (eq (car x) a)) + tuples))) + (list :a a + :size s + :real c + :? (eq c s)))))) + +(ql:quickload 'vgplot) +(import 'vgplot:plot) +(import 'vgplot:replot) + +(let ((l 10)) + (plot (mapcar (lambda (x) (getf x :size)) + (loop :for a upto l + collect (list :a a :size (a-block a l)))) + "penis")) + +(let* ((l 50) + (tuples (tuples-half l))) + (loop :for a below l + :do (print (let ((s (a-block a l)) + (c (count-if (lambda (x) (eq (car x) a)) + tuples))) + (list :a a + :size s + :real c + :? (eq c s)))))) + +(defun range (from to) (loop for i :from from :to to collect i)) + +(defun half-again (i nv) + (let ((a-block-list (let ((ll (mapcar (lambda (i) (a-block i nv)) + (range 0 (- nv 1))))) + (loop :for i :from 1 :to (length ll) + :collect + (reduce #'+ + ll + :end i))))) + (loop :for blk :in a-block-list + :with a = 0 + :with total-blk = 0 + :if (eq 0 (floor i blk)) + :do + (let ((i (mod i blk))) + (print (list i (- i total-blk) blk a)) + (return)) + :else + :do (progn + (incf a) + (setq total-blk blk)))))