Compare commits

...

10 Commits

Author SHA1 Message Date
Aryadev Chavali
cd6ac8930d Overhaul
Loads of changes, some which I wasn't sure what I was on when doing
them
2025-07-10 00:08:23 +01:00
Aryadev Chavali
062b5f59d7 Add a reverse argument sort 2025-03-02 21:42:33 +00:00
Aryadev Chavali
5f4bfd77bd Fix some issues in main 2025-03-02 01:17:56 +00:00
Aryadev Chavali
93790fad88 Move all test code into one file. 2025-03-02 01:17:56 +00:00
Aryadev Chavali
191ef05401 Implement test for card->int 2025-02-24 23:52:21 +00:00
Aryadev Chavali
7d7987cdc2 Implement test for int->card 2025-02-24 23:38:59 +00:00
Aryadev Chavali
f4d98ad07d Implement test for suit->int and int->suit being complete inverses 2025-02-24 23:38:46 +00:00
Aryadev Chavali
02b87cdc9c Implement test for suit->int 2025-02-24 23:38:38 +00:00
Aryadev Chavali
ac8860e1d7 Implement test for rank->int and int->rank being complete inverses 2025-02-24 23:38:11 +00:00
Aryadev Chavali
7c7bbd3361 Implement test for rank->int 2025-02-24 23:38:03 +00:00
15 changed files with 374 additions and 313 deletions

2
.gitignore vendored
View File

@@ -1,3 +1,3 @@
TAGS
bin/
/system-index.txt
system-index.txt

View File

@@ -23,4 +23,5 @@ Requirements:
Run:
$ ./build
to compile the program.
to compile the program. Binary artifact should be located under
`./bin/cantedraw`.

View File

@@ -2,7 +2,7 @@
:author "Aryadev Chavali <aryadev@aryadevchavali.com>"
:license "GPL-2"
:depends-on (:alexandria)
:in-order-to ((asdf:test-op (asdf:test-op :cantedraw/tests)))
:in-order-to ((test-op (test-op :cantedraw/tests)))
:components ((:file "packages")
(:module "lib"
:components
@@ -25,14 +25,8 @@
:parachute)
:components ((:module "tests"
:components
((:file "macros")
(:file "functions")
(:file "model")
;; (:file "player")
;; (:file "game")
(:file "main"))))
:perform (test-op (op c) (uiop:symbol-call :parachute :test
:cantedraw/tests/main)))
((:file "test"))))
:perform (test-op (op c) (uiop:symbol-call :parachute :test :cantedraw/tests/main)))
;; Compress image for smaller binary size.
#+nil

View File

@@ -19,21 +19,21 @@
(in-package :cantedraw.lib.functions)
(fn range (start end &optional (step 1)) (-> (fixnum fixnum &optional fixnum) list)
"Make a list of numbers from START to END (exclusive). If STEP is given, then
each member is STEP distance apart."
(fn range (&key (start 0) (end 0) (step 1))
(-> (&key (:start fixnum) (:end fixnum) (:step fixnum))
list)
"Return list of integers in interval [START, END). If STEP is given, then
each member is STEP distance apart i.e. {START + n * STEP | n from 0}.
If END is not given, return interval [0, START)."
(if (< end start)
(error (format nil "~a < ~a" end start))
(loop :for i :from start :to (1- end) :by step
:collect i)))
(fn take (n lst) (-> (fixnum sequence) sequence)
"Return the first N elements of LST."
(subseq lst 0 n))
(fn split (n lst) (-> (fixnum sequence) (values sequence sequence))
"Return CONS where CAR is the first N elements of LST and CDR is the rest."
(values (take n lst)
(values (subseq lst 0 n)
(subseq lst n)))
(fn rev-map (indicator lst &key (key-eq #'eq))

View File

@@ -124,3 +124,8 @@ sequentially via ->>"
(defmacro alist-val (key alist)
"Helper macro for getting the value of KEY in ALIST."
`(cdr (assoc ,key ,alist)))
(defmacro call-rev (func-name &rest arguments)
"Call a function with arguments but in reverse
i.e. (call-rev f x1 x2 ... xn) => (f xn ... x2 x1)."
`(,func-name ,@(reverse arguments)))

View File

@@ -22,7 +22,7 @@
(:use :cl)
(:export
:--> :->> :-<>
:-> :fn
:-> :fn :call-rev
:while :alist-val
:$-> :$>> :$<>))
@@ -31,8 +31,7 @@
(:use :cl :5d-lib.macros)
(:export
:parse-integer*
:range :take :split
:rev-map
:range :split :rev-map
:remove-at-indices))
(defpackage cantedraw.model
@@ -40,7 +39,7 @@
(:use :cl :5d-lib.macros :5d-lib.functions)
(:export
;; Types
:int-card :rank :suit :cardset
:int-card :rank :suit :cardset :cardset-p
;; card struct
:card :make-card :card-suit :card-rank :card-p
;; Converters
@@ -59,9 +58,10 @@
:5d-lib.macros :5d-lib.functions
:5d.model)
(:export
:player
:error-player-nonexistent
:error-player-broke
;; player struct
:player :make-player :player-name :player-balance :player-hand :player-p
:make-player-table
:error-player-nonexistent :error-player-broke
:player-exists? :player-bankrupt? :player-can-pay?
:player-debit
:player-credit
@@ -81,5 +81,5 @@
(:nicknames :5d.main)
(:use :cl
:5d-lib.macros :5d-lib.functions
:5d.model :5d.game)
:5d.model :5d.player :5d.game)
(:export :start))

View File

@@ -19,8 +19,8 @@
(in-package :cantedraw.game)
(fn deal-cards (n deck) (-> (fixnum cardset) (cons cardset cardset))
(destructuring-bind (hand . rest) (split n deck)
(fn deal-cards (n deck) (-> (fixnum cardset) (cons cardset ))
(multiple-value-bind (hand rest) (split n deck)
(cons (sort hand #'card<) rest)))
(fn deal-hands (n deck) (-> (fixnum cardset) (cons list cardset))

View File

@@ -41,7 +41,7 @@
(while (null inp)
(format t "Need at least one integer...~%")
(force-output)
(setq inp (read-integers)))
(->> (read-integers) (setq inp)))
inp))
(fn is-valid-hand-index (n) (-> (fixnum) boolean)
@@ -51,16 +51,16 @@
(fn read-until-valid-integers () (-> nil list)
(let ((inp (remove-duplicates (read-integers))))
(while (not (and (every #'is-valid-hand-index inp)
(< (length inp) 5)
(<= (length inp) 5)
(>= (length inp) 0)))
(format t "Need at most 5 integers between 0 and 4...~%")
(force-output)
(setq inp (remove-duplicates (read-integers))))
(->> (read-integers) remove-duplicates (setq inp)))
inp))
(fn read-and-confirm-valid-integers (hand) (-> nil list)
(fn read-and-confirm-valid-integers (hand) (-> (cardset) list)
(let ((confirm nil)
inp)
(inp nil))
(while (null confirm)
(setq inp (read-until-valid-integers))
(if (null inp)
@@ -97,8 +97,10 @@
(->> (make-deck)
alexandria:shuffle
(read-redeal-print nil))
(format t "~C[2J" #\Esc)
(format t "Cards remaining: {~a}
Final hand: [~a]"
Final hand: [~a]
"
(cardset->str rest)
(cardset->str final-hand))))

View File

@@ -32,9 +32,9 @@
(deftype int-card () `(integer 0 51))
(deftype cardset () `(and list (satisfies cardsetp)))
(deftype cardset () `(and list (satisfies cardset-p)))
(fn cardsetp (lst) (-> (list) boolean)
(fn cardset-p (lst) (-> (list) boolean)
(every #'card-p lst))
(fn int->suit (n) (-> (fixnum) suit)

View File

@@ -40,8 +40,8 @@
(id err) (balance err) (required err)))))
(fn player-exists? (id table) (-> (symbol hash-table) boolean)
(and (gethash id table)
(player-p (gethash id table))))
(let ((item (gethash id table)))
(and item (player-p item))))
(defun error-if-no-player (id table)
(unless (player-exists? id table)
@@ -60,12 +60,12 @@
(unless (player-can-pay? id table amount)
(error 'error-player-broke
:id id :balance (player-balance (gethash id table)) :required amount))
(decf (player-balance (gethash id table)) amount))
(-<> id (gethash table) player-balance (decf amount)))
(fn player-credit (id table amount) (-> (symbol hash-table fixnum) fixnum)
(error-if-no-player id table)
(incf (player-balance (gethash id table)) amount))
(-<> id (gethash table) player-balance (incf amount)))
(fn player-set-cards (id table cards) (-> (symbol hash-table cardset) t)
(error-if-no-player id table)
(setf (player-hand (gethash id table)) cards))
(-<> id (gethash table) player-hand (setf cards)))

View File

@@ -1,115 +0,0 @@
;;; functions.lisp - 2025-02-20
;; Copyright (C) 2025 Aryadev Chavali
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for
;; details.
;; You may distribute and modify this code under the terms of the GNU General
;; Public License Version 2, which you should have received a copy of along with
;; this program. If not, please go to <https://www.gnu.org/licenses/>.
;;; Code:
(defpackage cantedraw/tests/functions
(:use
:cl :parachute :cantedraw.lib.macros
:cantedraw.lib.functions))
(in-package :cantedraw/tests/functions)
(define-test function-test)
(define-test (function-test "parse-integer*")
:compile-at :execute
(is eq 2 (parse-integer* "2"))
(is eq 2048 (parse-integer* "2048abcdef"))
(is eq nil (parse-integer* "a2048abcdef"))
(is eq nil (parse-integer* "garbage"))
(fail (parse-integer* nil)))
(define-test (function-test range)
:compile-at :execute
(fail (range 1 0))
(fail (range nil nil))
(fail (range "a" "b"))
(true (null (range 1 1)))
(is equal '(1 2 3 4) (range 1 5))
(is equal '(-3 -2 -1 0) (range -3 1)))
(define-test (function-test take)
:depends-on ((cantedraw/tests/macros ->>))
:compile-at :execute
(fail (take nil nil))
(fail (take 100 nil))
(fail (take nil 100))
(true (->> (list 1 2 3 4) (take 0) null))
(is equal "H" (take 1 "Hello"))
(is equal '(1 2) (take 2 '(1 2 3 4 5))))
(define-test (function-test split)
:compile-at :execute
(fail (split nil nil))
(fail (split 100 nil))
(fail (split nil 100))
(is-values (split 0 '(1 2 3 4))
(eq nil)
(equal '(1 2 3 4)))
(is-values (split 1 '(1 2 3 4))
(equal '(1))
(equal '(2 3 4)))
(is-values (split 5 "Hello World")
(string= "Hello")
(string= " World")))
(define-test (function-test rev-map)
:depends-on (range
(cantedraw/tests/macros ->>))
:compile-at :execute
(fail (rev-map nil nil))
(fail (rev-map "a string" "another string" :key-eq "not a function"))
(true (->> nil (rev-map #'identity) null))
(let ((res (rev-map #'evenp (range 1 7))))
(false (null res))
(is equal 2 (length res))
(is equal 3 (->> (assoc t res) cdr length))
(is equal 3 (->> (assoc nil res) cdr length))
(true (->> (assoc t res) cdr (every #'evenp)))
(true (->> (assoc nil res) cdr (every #'oddp))))
(let* ((mod* (lambda (n) (mod n 3)))
(res (rev-map mod* (range 1 12))))
(false (null res))
(is equal 3 (length res))
(is equal 3 (->> (assoc 0 res) cdr length))
(is equal 4 (->> (assoc 1 res) cdr length))
(is equal 4 (->> (assoc 2 res) cdr length))
(true (->> (assoc 0 res) cdr (every (lambda (x) (= (mod x 3) 0)))))
(true (->> (assoc 1 res) cdr (every (lambda (x) (= (mod x 3) 1)))))
(true (->> (assoc 2 res) cdr (every (lambda (x) (= (mod x 3) 2))))))
(let ((res (rev-map #'identity "lots of letters")))
(false (null res))
(is equal 2 (->> (assoc #\l res) cdr length))
(is equal 3 (->> (assoc #\t res) cdr length))
(is equal 2 (->> (assoc #\space res) cdr length))
(is equal 2 (->> (assoc #\s res) cdr length))))
(define-test (function-test remove-at-indices)
:depends-on (range)
:compile-at :execute
(fail (remove-at-indices "a string" "another string"))
(true (null (remove-at-indices nil nil)))
(is equal '(1 2 3) (remove-at-indices nil '(1 2 3)))
(is equal '(2) (remove-at-indices '(0 2) '(1 2 3)))
(let* ((inp (range 100 200))
(t1 (remove-at-indices (range 0 100 2) inp))
(t2 (remove-at-indices (range 1 100 2) inp)))
(is equal 50 (length t1))
(is equal 50 (length t2))
(true (every (lambda (n) (not (member n t2))) t1))
(true (every (lambda (n) (not (member n t1))) t2)))
(let* ((indices (list 0 5 6 7 8 9 10))
(str-lst (remove-at-indices indices "Hello World"))
(ret (coerce str-lst 'string)))
(is string= "ello" ret)))

View File

@@ -1,64 +0,0 @@
;;; main.lisp - 2025-02-16
;; Copyright (C) 2025 Aryadev Chavali
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for
;; details.
;; You may distribute and modify this code under the terms of the GNU General
;; Public License Version 2, which you should have received a copy of along with
;; this program. If not, please go to <https://www.gnu.org/licenses/>.
;;; Code:
(defpackage cantedraw/tests/macros
(:use :cl :cantedraw.lib.macros
:parachute))
(in-package :cantedraw/tests/macros)
(define-test macro-test)
(define-test (macro-test "-->")
(true (null (--> x)))
(is eq 'a (--> x 'a))
(is eq 2 (--> x 1 (1+ x)))
(is eq 2 (--> x 1 1+))
(is string= "World!" (--> _ "Hello" (format nil "~a World!" _) (subseq _ 6))))
(define-test (macro-test "->>")
(true (null (->>)))
(let ((a (gensym))
(b (gensym))
(c (gensym))
(d (gensym)))
(is eq a (->> a))
(is equal `(,a ,b) (macroexpand `(->> ,b (,a))))
(is equal `(,a ,b) (macroexpand `(->> ,b ,a)))
(is equal `(,a (,b ,c)) (macroexpand `(->> ,c (,b) (,a))))
(is equal `(,a (,b ,c)) (macroexpand `(->> ,c ,b ,a)))
(is equal `(,a ,b ,c) (macroexpand `(->> ,c (,a ,b))))
(is equal `(,a ,b (,c ,d)) (macroexpand `(->> (,c ,d) (,a ,b))))
(is equal `(,a (,b (,c ,d))) (macroexpand `(->> ,d (,c) (,b) (,a))))
(is equal `(,a (,b (,c ,d))) (macroexpand `(->> ,d ,c ,b ,a))))
(is string= "Hello, World!" (->> "world!" (format nil "hello, ~a") string-capitalize)))
(define-test (macro-test "-<>")
(true (null (-<>)))
(let ((a (gensym))
(b (gensym))
(c (gensym))
(d (gensym)))
(is eq a (-<> a))
(is equal `(,a ,b) (macroexpand `(-<> ,b (,a))))
(is equal `(,a ,b) (macroexpand `(-<> ,b ,a)))
(is equal `(,a (,b ,c)) (macroexpand `(-<> ,c (,b) (,a))))
(is equal `(,a (,b ,c)) (macroexpand `(-<> ,c ,b ,a)))
(is equal `(,a ,b ,c) (macroexpand `(-<> ,b (,a ,c))))
(is equal `(,a (,b (,c ,d))) (macroexpand `(-<> ,d (,c) (,b) (,a))))
(is equal `(,a (,b (,c ,d))) (macroexpand `(-<> ,d ,c ,b ,a)))
(is equal `(,a (,b ,c) ,d) (macroexpand `(-<> ,c (,b) (,a ,d)))))
(is equal 69 (-<> 489 (- 420)))
(is string= "HELLO" (-<> "Hello World!" (subseq 0 5) string-upcase)))

View File

@@ -1,26 +0,0 @@
;;; main.lisp - 2025-02-20
;; Copyright (C) 2025 Aryadev Chavali
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for
;; details.
;; You may distribute and modify this code under the terms of the GNU General
;; Public License Version 2, which you should have received a copy of along with
;; this program. If not, please go to <https://www.gnu.org/licenses/>.
;;; Code:
(defpackage cantedraw/tests/main
(:use :cl :parachute))
(in-package :cantedraw/tests/main)
(define-test all
:serial t
:depends-on ((cantedraw/tests/macros macro-test)
(cantedraw/tests/functions function-test)
(cantedraw/tests/model model-test)))

View File

@@ -1,65 +0,0 @@
;;; model.lisp - 2025-02-21
;; Copyright (C) 2025 Aryadev Chavali
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for
;; details.
;; You may distribute and modify this code under the terms of the GNU General
;; Public License Version 2, which you should have received a copy of along with
;; this program. If not, please go to <https://www.gnu.org/licenses/>.
;;; Code:
(defpackage cantedraw/tests/model
(:use
:cl :parachute
:cantedraw.lib.macros :cantedraw.lib.functions
:cantedraw.model))
(in-package :cantedraw/tests/model)
(define-test model-test)
(define-test (model-test int->rank)
:depends-on ((cantedraw/tests/macros ->>)
(cantedraw/tests/functions rev-map))
:compile-at :execute
(fail (int->rank nil))
(fail (int->rank "Not a number"))
;; Proving int->rank maps 0-51 to produces 13 ranks, all equally distributed.
(let ((mapping (rev-map #'int->rank (range 0 52))))
;; Prove there are 13 ranks
(is eq 13 (length mapping))
;; Prove every rank is equivalent in length.
(is eq 1 (->> mapping
(mapcar ($>> cdr length))
remove-duplicates
length))
;; Prove Ace, 2, ..., 10, Jack, Queen, King are the 13 ranks.
(true (every #'identity
(->> (list :ace :king :queen :jack)
(append (range 2 11))
(mapcar (lambda (rank) (assoc rank mapping))))))))
(define-test (model-test int->suit)
:depends-on ((cantedraw/tests/macros ->>)
(cantedraw/tests/functions rev-map))
:compile-at :execute
(fail (int->suit nil))
(fail (int->suit "Not a number"))
;; Proving int->suit splits 0-51 perfectly between the 4 suits
(let ((mapping (rev-map #'int->suit (range 0 53))))
(is eq 5 (length mapping))
(let ((spades (alist-val :spades mapping))
(hearts (alist-val :hearts mapping))
(clubs (alist-val :clubs mapping))
(diamonds (alist-val :diamonds mapping))
(jokers (alist-val :joker mapping)))
(is eq 1 (length jokers))
(is eq 1 (->> (list spades hearts clubs diamonds)
(mapcar #'length)
remove-duplicates
length)))))

329
tests/test.lisp Normal file
View File

@@ -0,0 +1,329 @@
;;; test.lisp - 2025-03-01
;; Copyright (C) 2025 Aryadev Chavali
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for
;; details.
;; You may distribute and modify this code under the terms of the GNU General
;; Public License Version 2, which you should have received a copy of along with
;; this program. If not, please go to <https://www.gnu.org/licenses/>.
;; Packages
(defpackage cantedraw/tests/main
(:use :cl :parachute))
(defpackage cantedraw/tests/macros
(:use :cl :parachute
:cantedraw.lib.macros))
(defpackage cantedraw/tests/functions
(:use :cl :parachute
:cantedraw.lib.macros :cantedraw.lib.functions))
(defpackage cantedraw/tests/model
(:use :cl :parachute
:cantedraw.lib.macros :cantedraw.lib.functions
:cantedraw.model))
;; Implementations
;;; main
(in-package :cantedraw/tests/main)
(define-test all
:serial t
:depends-on ((cantedraw/tests/macros macro-test)
(cantedraw/tests/functions function-test)
(cantedraw/tests/model model-test)))
;;; macros
(in-package :cantedraw/tests/macros)
(define-test macro-test)
(define-test (macro-test "-->")
(true (null (--> x)))
(is eq 'a (--> x 'a))
(is eq 2 (--> x 1 (1+ x)))
(is eq 2 (--> x 1 1+))
(is string= "World!" (--> _ "Hello" (format nil "~a World!" _) (subseq _ 6))))
(define-test (macro-test "->>")
(true (null (->>)))
(let ((a (gensym))
(b (gensym))
(c (gensym))
(d (gensym)))
(is eq a (->> a))
(is equal `(,a ,b) (macroexpand `(->> ,b (,a))))
(is equal `(,a ,b) (macroexpand `(->> ,b ,a)))
(is equal `(,a (,b ,c)) (macroexpand `(->> ,c (,b) (,a))))
(is equal `(,a (,b ,c)) (macroexpand `(->> ,c ,b ,a)))
(is equal `(,a ,b ,c) (macroexpand `(->> ,c (,a ,b))))
(is equal `(,a ,b (,c ,d)) (macroexpand `(->> (,c ,d) (,a ,b))))
(is equal `(,a (,b (,c ,d))) (macroexpand `(->> ,d (,c) (,b) (,a))))
(is equal `(,a (,b (,c ,d))) (macroexpand `(->> ,d ,c ,b ,a))))
(is string= "Hello, World!" (->> "world!" (format nil "hello, ~a") string-capitalize)))
(define-test (macro-test "-<>")
(true (null (-<>)))
(let ((a (gensym))
(b (gensym))
(c (gensym))
(d (gensym)))
(is eq a (-<> a))
(is equal `(,a ,b) (macroexpand `(-<> ,b (,a))))
(is equal `(,a ,b) (macroexpand `(-<> ,b ,a)))
(is equal `(,a (,b ,c)) (macroexpand `(-<> ,c (,b) (,a))))
(is equal `(,a (,b ,c)) (macroexpand `(-<> ,c ,b ,a)))
(is equal `(,a ,b ,c) (macroexpand `(-<> ,b (,a ,c))))
(is equal `(,a (,b (,c ,d))) (macroexpand `(-<> ,d (,c) (,b) (,a))))
(is equal `(,a (,b (,c ,d))) (macroexpand `(-<> ,d ,c ,b ,a)))
(is equal `(,a (,b ,c) ,d) (macroexpand `(-<> ,c (,b) (,a ,d)))))
(is equal 69 (-<> 489 (- 420)))
(is string= "HELLO" (-<> "Hello World!" (subseq 0 5) string-upcase)))
;;; functions
(in-package :cantedraw/tests/functions)
(define-test function-test)
(define-test (function-test "parse-integer*")
:compile-at :execute
(is eq 2 (parse-integer* "2"))
(is eq 2048 (parse-integer* "2048abcdef"))
(is eq nil (parse-integer* "a2048abcdef"))
(is eq nil (parse-integer* "garbage"))
(fail (parse-integer* nil)))
(define-test (function-test range)
:compile-at :execute
(fail (range :start 1 :end 0))
(fail (range :start nil :end nil))
(fail (range :start "a" :end "b"))
(true (null (range :start 1 :end 1)))
(is equal '(1 2 3 4) (range :start 1 :end 5))
(is equal '(-3 -2 -1 0) (range :start -3 :end 1)))
(define-test (function-test split)
:compile-at :execute
(fail (split nil nil))
(fail (split 100 nil))
(fail (split nil 100))
(is-values (split 0 '(1 2 3 4))
(eq nil)
(equal '(1 2 3 4)))
(is-values (split 1 '(1 2 3 4))
(equal '(1))
(equal '(2 3 4)))
(is-values (split 5 "Hello World")
(string= "Hello")
(string= " World")))
(define-test (function-test rev-map)
:depends-on (range
(cantedraw/tests/macros ->>))
:compile-at :execute
(fail (rev-map nil nil))
(fail (rev-map "a string" "another string" :key-eq "not a function"))
(true (->> nil (rev-map #'identity) null))
(let ((res (rev-map #'evenp (range :start 1 :end 7))))
(false (null res))
(is equal 2 (length res))
(is equal 3 (->> (assoc t res) cdr length))
(is equal 3 (->> (assoc nil res) cdr length))
(true (->> (assoc t res) cdr (every #'evenp)))
(true (->> (assoc nil res) cdr (every #'oddp))))
(let* ((mod* (lambda (n) (mod n 3)))
(res (rev-map mod* (range :start 1 :end 12))))
(false (null res))
(is equal 3 (length res))
(is equal 3 (->> (assoc 0 res) cdr length))
(is equal 4 (->> (assoc 1 res) cdr length))
(is equal 4 (->> (assoc 2 res) cdr length))
(true (->> (assoc 0 res) cdr (every (lambda (x) (= (mod x 3) 0)))))
(true (->> (assoc 1 res) cdr (every (lambda (x) (= (mod x 3) 1)))))
(true (->> (assoc 2 res) cdr (every (lambda (x) (= (mod x 3) 2))))))
(let ((res (rev-map #'identity "lots of letters")))
(false (null res))
(is equal 2 (->> (assoc #\l res) cdr length))
(is equal 3 (->> (assoc #\t res) cdr length))
(is equal 2 (->> (assoc #\space res) cdr length))
(is equal 2 (->> (assoc #\s res) cdr length))))
(define-test (function-test remove-at-indices)
:depends-on (range)
:compile-at :execute
(fail (remove-at-indices "a string" "another string"))
(true (null (remove-at-indices nil nil)))
(is equal '(1 2 3) (remove-at-indices nil '(1 2 3)))
(is equal '(2) (remove-at-indices '(0 2) '(1 2 3)))
(let* ((inp (range :start 100 :end 200))
(t1 (remove-at-indices (range :start 0 :end 100 :step 2) inp))
(t2 (remove-at-indices (range :start 1 :end 100 :step 2) inp)))
(is equal 50 (length t1))
(is equal 50 (length t2))
(true (every (lambda (n) (not (member n t2))) t1))
(true (every (lambda (n) (not (member n t1))) t2)))
(let* ((indices (list 0 5 6 7 8 9 10))
(str-lst (remove-at-indices indices "Hello World"))
(ret (coerce str-lst 'string)))
(is string= "ello" ret)))
;;; model
(in-package :cantedraw/tests/model)
(define-test model-test)
(define-test (model-test int->rank)
:depends-on ((cantedraw/tests/macros ->>)
(cantedraw/tests/functions rev-map))
:compile-at :execute
(fail (int->rank nil))
(fail (int->rank "Not a number"))
;; Proving int->rank maps 0-51 to produces 13 ranks, all equally distributed.
(let ((mapping (rev-map #'int->rank (range :start 0 :end 52))))
;; Prove there are 13 ranks
(is eq 13 (length mapping))
;; Prove every rank is equivalent in length.
(is eq 1 (->> mapping
(mapcar ($>> cdr length))
remove-duplicates
length))
;; Prove Ace, 2, ..., 10, Jack, Queen, King are the 13 ranks.
(true (every #'identity
(->> (list :ace :king :queen :jack)
(append (range :start 2 :end 11))
(mapcar (lambda (rank) (assoc rank mapping))))))))
(define-test (model-test rank->int)
:depends-on ((cantedraw/tests/macros ->>))
:compile-at :execute
(fail (rank->int nil))
(fail (rank->int 1738))
(fail (rank->int "not a rank"))
(fail (rank->int :still-not-a-rank))
;; Prove ranks are mapped to unique positive integers
(let ((res (->> (list :jack :queen :king :ace)
(append (range :start 2 :end 11))
(mapcar #'rank->int))))
(true (every #'integerp res))
(true (every #'(lambda (x) (<= 0 x)) res))
(is equal (length res) (length (remove-duplicates res)))))
(define-test (model-test "int->rank and rank->int are complete inverses")
:depends-on (rank->int int->rank)
(let ((int-range (range :start 0 :end 13))
(rank-range (->> (list :ace :jack :queen :king)
(append (range :start 2 :end 11)))))
(is equal rank-range
(mapcar ($>> rank->int int->rank) rank-range))
(is equal int-range
(mapcar ($>> int->rank rank->int) int-range))))
(define-test (model-test int->suit)
:depends-on ((cantedraw/tests/macros ->>)
(cantedraw/tests/functions rev-map))
:compile-at :execute
(fail (int->suit nil))
(fail (int->suit "Not a number"))
;; Proving int->suit splits 0-51 perfectly between the 4 suits
(let ((mapping (rev-map #'int->suit (range :start 0 :end 53))))
(is eq 5 (length mapping))
(let ((spades (alist-val :spades mapping))
(hearts (alist-val :hearts mapping))
(clubs (alist-val :clubs mapping))
(diamonds (alist-val :diamonds mapping))
(jokers (alist-val :joker mapping)))
(is eq 1 (length jokers))
(is eq 1 (->> (list spades hearts clubs diamonds)
(mapcar #'length)
remove-duplicates
length)))))
(define-test (model-test suit->int)
:depends-on ((cantedraw/tests/macros ->>))
:compile-at :execute
(fail (suit->int nil))
(fail (suit->int "not a suit"))
(fail (suit->int :still-not-a-suit))
(fail (suit->int 42069))
;; Prove suits are mapped to unique positive integers
(let ((res (->> (list :diamonds :clubs :hearts :spades :joker)
(mapcar #'suit->int))))
(true (every #'integerp res) "All integers")
(true (every ($>> (<= 0)) res) "All positive")
(is equal (length res) (length (remove-duplicates res)) "Unique mapping")))
(define-test (model-test "int->suit and suit->int are complete inverses")
:depends-on (suit->int int->suit)
(let ((int-range (list 0 13 26 39 52))
(suit-range (list :diamonds :clubs :hearts :spades :joker)))
(is equal suit-range
(mapcar ($>> suit->int int->suit) suit-range))
(is equal int-range
(mapcar ($>> int->suit suit->int) int-range))))
(define-test (model-test int->card)
:depends-on ((cantedraw/tests/functions range))
:compile-at :execute
(fail (int->card nil))
(fail (int->card "Not a number"))
;; Proving int->card maps 0-51 to exactly 52 unique cards
(let ((mapping (mapcar #'int->card (range :start 0 :end 52))))
(is eq 52 (length (remove-duplicates mapping :test #'equal))
"52 unique elements.")
(true (every #'card-p mapping)
"Every element is a card."))
;; Prove that cards outside of [0, 51] are mapped to jokers (not exhaustive)
(loop :for positive :from 100 :to 200
:for negative :from -200 :to -100
:for inp := (mapcar #'int->card (list positive negative))
:do (true (every #'card-p inp)
"Is a card.")
:do (true (every (lambda (c) (eq :joker (card-suit c))) inp)
"Are jokers.")))
(define-test (model-test card->int)
:depends-on ((cantedraw/tests/functions range))
:compile-at :execute
(fail (card->int nil))
(fail (card->int 1738))
(fail (card->int "not a card"))
(fail (card->int :still-not-a-card))
(let ((ranks (append (range :start 2 :end 11) (list :jack :queen :king :ace))))
(let ((res (->> (loop :for suit :in (list :diamonds :clubs :hearts :spades)
:nconc
(mapcar (lambda (rank) (make-card :rank rank :suit suit)) ranks))
(mapcar #'card->int))))
(true (every #'integerp res) "Every mapped element is an integer.")
(true (every #'(lambda (x) (<= 0 x)) res) "Every mapped element is positive")
(is eq (length res) (length (remove-duplicates res))
"All mapped integers are unique."))
(let ((res (->> (loop :for rank :in ranks
:collect (make-card :rank rank :suit :joker))
(mapcar #'card->int))))
(true (every #'integerp res) "Every mapped element is an integer.")
(true (every (lambda (n) (or (< n 0) (> n 51))) res)
"Every mapped element is outside of [0,51]")
(is eq (length res) (length (remove-duplicates res))
"All mapped integers are unique."))))
(define-test (model-test "int->card and card->int are complete inverses")
:depends-on (card->int int->card)
(let ((int-range (range :start 0 :end 52))
(card-range
(loop :for rank :in (append (range :start 2 :end 11) (list :ace :king :jack :queen))
:nconcing (-<> (lambda (suit) (make-card :rank rank :suit suit))
(mapcar (list :Diamonds :Clubs :Hearts :Spades)))
:into Y
:finally (return (sort Y #'card<)))))
(is equalp card-range (mapcar ($>> card->int int->card) card-range)
"int->card(card->int s) = s")
(is equalp int-range (mapcar ($>> int->card card->int) int-range)
"card->int(int->card i) = i")))