Skip to content

Instantly share code, notes, and snippets.

@iambrj
Last active May 7, 2022 10:16
Show Gist options
  • Save iambrj/ef2ac602d7a4ecfcc3930f8ba0431f3b to your computer and use it in GitHub Desktop.
Save iambrj/ef2ac602d7a4ecfcc3930f8ba0431f3b to your computer and use it in GitHub Desktop.
#lang racket
(provide (all-defined-out))
(define (my-last l)
(match l
['() (error "Too few elements")]
[`(,x) `(,x)]
[`(,_ . ,d) (my-last d)]))
(define (my-but-last l)
(match l
[(or '() `(,_)) (error "Too few elements")]
[`(,a1 ,a2) `(,a1 ,a2)]
[`(,_ . ,d) (my-but-last d)]))
(define (element-at l x)
(match l
['() (error "Too few elements")]
[`(,a . ,d) (if (= 1 x) a (element-at d (sub1 x)))]))
(define (my-length l)
(foldl (lambda (_ acc) (add1 acc)) 0 l))
(define (my-reverse l)
(foldl cons '() l))
(define (palindrome? l)
(equal? l (my-reverse l)))
; NOTE: Add (my-flatten 3) test, should throw error
(define (my-flatten l)
(match l
['() '()]
[`(,a . ,d)
(if (not (cons? a))
(cons a (my-flatten d))
(append (my-flatten a) (my-flatten d)))]))
(define (compress l)
(map car (pack l)))
(define (pack l)
(if (not (list? l))
(error "Not a list :" l)
(match l
['() '()]
[(list-rest (? ((curry eq?) (car l)) a*) ... d) (cons a* (pack d))])))
(define (encode l)
(map (lambda (x)
`(,(length x) ,(car x)))
(pack l)))
(define (encode-modified l)
(map (lambda (x)
(if (= (length x) 1)
(car x)
`(,(length x) ,(car x))))
(pack l)))
(define (copies n x [acc '()])
(if (zero? n) acc (copies (sub1 n) x (cons x acc))))
(define (decode l)
(match l
['() '()]
[`((,n ,x) . ,d) (append (copies n x) (decode d))]
[`(,(? (compose not cons?) a) . ,d) (cons a (decode d))]))
(define (encode-direct l [acc '()])
(match l
['() (map (lambda (cnt-x)
(match cnt-x
[`(1 ,x) x]
[else cnt-x]))
(reverse acc))]
[`(,a . ,d) (encode-direct d (inc acc a))]))
(define (inc encoded x)
(match encoded
['() `((1 ,x))]
[`((,cnt ,a) . ,d) (if (eq? a x)
`((,(add1 cnt) ,x) . ,d)
(cons `(1 ,x) encoded))]))
(define (dupli l)
(append-map ((curry copies) 2) l))
(define (repli l n)
(append-map ((curry copies) n) l))
(define (drop l n [c 1] [acc '()])
(match l
['() (reverse acc)]
[`(,a . ,d) (if (= c n)
(drop d n 1 acc)
(drop d n (add1 c) (cons a acc)))]))
(define (split l n [acc '()])
(if (zero? n)
`(,(reverse acc) ,l)
(split (cdr l) (sub1 n) (cons (car l) acc))))
(define (slice l s e)
(dump (take l e) (sub1 s)))
(define (dump l n)
(if (zero? n)
l
(dump (cdr l) (sub1 n))))
(define (take l n [acc '()])
(if (zero? n)
(reverse acc)
(take (cdr l) (sub1 n) (cons (car l) acc))))
(define (rotate l n)
(let* ([n (modulo n (length l))] ; NOTE: test if n larger than (length l) works
[ab (split l n)])
(append (second ab) (first ab))))
(define (remove-at l k)
(append (take l (sub1 k)) (dump l k)))
(define (insert-at x l k)
(append (take l (sub1 k)) `(,x) (dump l (sub1 k))))
(define (range-inc a b [acc '()])
(if (> a b) acc (range-inc a (sub1 b) (cons b acc))))
(define (range-dec a b [acc '()])
(if (< a b) acc (range-dec a (add1 b) (cons b acc))))
(define (range a b)
(if (< a b) (range-inc a b) (range-dec a b)))
(define (rnd-select l k)
(letrec ([rnd-remove (lambda (l k)
(if (zero? k)
l
(rnd-remove (remove-at l (random 1 (add1 (length l))))
(sub1 k))))])
(rnd-remove l (- (length l) k))))
(define (lotto-select n m [acc '()])
(if (zero? n) acc (lotto-select (sub1 n) m (cons (random 1 (add1 m)) acc))))
(define (rnd-permu l [acc '()])
(match l
['() acc]
[else (let ([x (car (rnd-select l 1))])
(rnd-permu (remove x l) (cons x acc)))]))
(define (combination r l)
(cond
[(zero? r) '(())]
[(< (length l) r) '()]
[(= (length l) r) `(,l)]
[else (let ([n-1Cr-1 (combination (- r 1) (cdr l))]
[n-1Cr (combination r (cdr l))])
(append (map ((curry cons) (car l)) n-1Cr-1) n-1Cr))]))
(define (group3 l) (group l '(2 3 4)))
(define (group l sz*)
(let ([dup (map ((curry chunk) sz*) (permutation l))])
(remove-duplicates dup ((curry andmap) permutation?))))
(define (permutation? l1 l2)
(equal? (count-elements l1) (count-elements l2)))
(define (count-elements l)
(foldl (lambda (x acc)
(hash-set acc x (add1 (if (hash-has-key? acc x)
(hash-ref acc x)
0))))
(make-immutable-hash)
l))
(define (chunk sz* l [acc '()])
(match sz*
[(? (compose ((curry =) (length l)) car) `(,sz)) (append acc `(,l))]
[`(,sz . ,sz*) (chunk sz* (dump l sz) (append acc `(,(take l sz))))]))
(define (permutation l)
(match l
[`(,a) `((,a))]
[`(,a . ,d)
(let ([pd* (permutation d)])
(remove-duplicates (append-map (insert-all a) pd*)))]))
(define ((insert-all x) l)
(foldr (lambda (pos acc)
(cons (insert-at x l pos) acc))
'()
(range 1 (add1 (length l)))))
(define (lsort l)
(sort l (lambda (x y) (< (length x) (length y)))))
(define (lfsort l)
(let ([f (length-frequencies l)])
(sort l (lambda (l1 l2)
(< (hash-ref f (length l1)) (hash-ref f (length l2)))))))
(define (length-frequencies l)
(foldr (lambda (x acc)
(let ([x (length x)])
(hash-set acc x (add1 (if (hash-has-key? acc x)
(hash-ref acc x)
0)))))
(make-immutable-hash)
l))
#|
Usage: `(eval-file "2019121006.rkt")` runs all tests and returns number of passing tests on file named 2019121006.rkt
If you haven't attempted some problems, e.g. say you haven't attempt group, add
dummy definitions as follows as the test suite assumes all definitons are
available:
```
(define (group . arg*) #f)
```
Also make sure all your functions terminate as the test suite will never
terminate otherwise.
|#
#lang racket
(provide (all-defined-out))
(define (eval-file file-name)
(define ns (make-base-namespace))
(printf "Testing ~s\n" file-name)
(eval `(begin (module a-test-module racket
(require rackunit
racket/sandbox
,file-name)
(provide (all-defined-out))
; q28(a)
(define (lsort-test lst)
(define (lst-smaller? a b) (< (length a) (length b)))
(sort lst lst-smaller?))
(define-check (check-last? res-lst-or-elem actual-elem message)
(match res-lst-or-elem
[actual-elem #t]
[(list actual-elem) #t]
[_ (fail-check message)]))
; q27
(define (group-test l sz*)
(let ([dup (map ((curry chunk) sz*) (permutation l))])
(remove-duplicates dup ((curry andmap) is-permutation?))))
(define (sort-group-internals result)
(map (lambda (grp) (map (lambda (lst) (sort lst <)) grp)) result))
(define (priv-dump l n)
(if (zero? n)
l
(priv-dump (cdr l) (sub1 n))))
(define (chunk sz* l [acc '()])
(match sz*
[(? (compose ((curry =) (length l)) car) `(,sz)) (append acc `(,l))]
[`(,sz . ,sz*) (chunk sz* (priv-dump l sz) (append acc `(,(take l sz))))]))
(define (permutation l)
(match l
[`(,a) `((,a))]
[`(,a . ,d)
(let ([pd* (permutation d)])
(remove-duplicates (append-map (insert-all a) pd*)))]))
(define (priv-insert-at x l k)
(append (take l (sub1 k)) `(,x) (priv-dump l (sub1 k))))
(define ((insert-all x) l)
(foldr (lambda (pos acc)
(cons (priv-insert-at x l pos) acc))
'()
(range 1 (add1 (length l)))))
(define (is-permutation? l1 l2)
(equal? (priv-count-elements l1) (priv-count-elements l2)))
(define (priv-count-elements l)
(foldl (lambda (x acc)
(hash-set acc x (add1 (if (hash-has-key? acc x)
(hash-ref acc x)
0))))
(make-immutable-hash)
l))
(define-check (check-group? actual-lst expected-lst message)
(unless (is-permutation? actual-lst expected-lst) (fail-check message)))
(define-syntax-rule (false-on-timeout e)
(with-limits 300 2048 e))
(define-test-suite a0
;q1
(check-last? (my-last '(1 2 3))
(last '(1 2 3))
"Question 1 - Test 1")
(check-exn exn:fail? (lambda () (my-last (list))))
(check-last? (my-last '((1 2) (3 4) (5 6)))
(last '((1 2) (3 4) (5 6)))
"Question 1 - Test 2")
;q2
(check-equal? (my-but-last '(1 2 3)) '(2 3) "Question 2 - Test 1")
(check-equal? (my-but-last '(1 2)) '(1 2) "Question 2 - Test 2")
(check-equal? (my-but-last '(1.4 2.5 3.6)) '(2.5 3.6) "Question 2 - Test 3")
(check-exn exn:fail? (lambda () (my-but-last '(1))))
(check-exn exn:fail? (lambda () (my-but-last '())))
; q3
(check-equal? (element-at '(1 2 3 4 5) 3) 3 "Question 3 - Test 1")
(check-equal? (element-at '(1 2 3 4 5) 1) 1 "Question 3 - Test 2")
(check-exn exn:fail? (lambda () (element-at '(1 2 3 4 5) 10)))
(check-exn exn:fail? (lambda () (element-at '() 1)))
; q4
(check-equal? (my-length '(1 2 3 4)) 4 "Question 4 - Test 1")
(check-equal? (my-length '()) 0 "Question 4 - Test 2")
(check-equal? (my-length '((1 2) (3 4))) 2 "Question 4 - Test 3")
; q5
(check-equal? (my-reverse '(1 2 3)) '(3 2 1) "Question 5 - Test 1")
(check-equal? (my-reverse '()) '() "Question 5 - Test 2")
(check-equal? (my-reverse '((1 2) (3 4) (5 6))) '((5 6) (3 4) (1 2)) "Question 5 - Test 3")
; q6
(check-equal? (palindrome? '(1 2 3 4 5)) #f "Question 6 - Test 1")
(check-equal? (palindrome? '(1 2 3 2 1)) #t "Question 6 - Test 2")
(check-equal? (palindrome? '(1)) #t "Question 6 - Test 3")
(check-equal? (palindrome? '((1 2) (3 4) (1 2))) #t "Question 6 - Test 4")
; q7
(check-equal? (my-flatten '(1 2)) '(1 2) "Question 7 - Test 1")
(check-equal? (my-flatten '((1 (2 3)) (((4)) 5))) '(1 2 3 4 5) "Question 7 - Test 2")
(check-equal? (my-flatten '()) '() "Question 8 - Test 3")
(check-exn exn:fail? (lambda () (my-flatten 4)))
; q8
(check-equal? (compress '(1 1 1 1 2 3 3 4 4 5 6)) '(1 2 3 4 5 6) "Question 8 - Test 1")
(check-equal? (compress '(1 2 3)) '(1 2 3) "Question 8 - Test 2")
(check-equal? (compress '()) '() "Question 8 - Test 3")
; q9
(check-equal? (pack '(1 1 2 3)) '((1 1) (2) (3)) "Question 9 - Test 1")
(check-equal? (pack '(1 1 1 2 2 3 4 4 4)) '((1 1 1) (2 2) (3) (4 4 4)) "Question 9 - Test 2")
(check-equal? (pack '(1)) '((1)) "Question 9 - Test 3")
(check-equal? (pack '()) '() "Question 9 - Test 4")
; q10
(check-equal? (encode '(1 1 1 2 3 3)) '((3 1) (1 2) (2 3)) "Question 10 - Test 1")
(check-equal? (encode '()) '() "Question 10 - Test 2")
(check-equal? (encode '(1 2 3)) '((1 1) (1 2) (1 3)) "Question 10 - Test 3")
; q11
(check-equal? (encode-modified '(1 1 1 2 3 3)) '((3 1) 2 (2 3)) "Question 11 - Test 1")
(check-equal? (encode-modified '(1 2 3)) '(1 2 3) "Question 11 - Test 2")
(check-equal? (encode-modified '()) '() "Question 11 - Test 3")
; q12
(check-equal? (decode '(1 2 3)) '(1 2 3) "Question 12 - Test 1")
(check-equal? (decode '((3 1) 2 (2 3))) '(1 1 1 2 3 3) "Question 12 - Test 2")
(check-equal? (decode '()) '() "Question 12 - Test 3")
; q13
(check-equal? (encode-direct '(1 1 1 2 3 3)) '((3 1) 2 (2 3)) "Question 13 - Test 1")
(check-equal? (encode-direct '()) '() "Question 13 - Test 2")
(check-equal? (encode-direct '(1 2 3)) '(1 2 3) "Question 13 - Test 3")
; q14
(check-equal? (dupli '(a b c c d)) '(a a b b c c c c d d) "Question 14 - Test 1")
(check-equal? (dupli '(1)) '(1 1) "Question 14 - Test 2")
(check-equal? (dupli '()) '() "Question 14 - Test 3")
; q15
(check-equal? (repli '(1 2 3 3) 3) '(1 1 1 2 2 2 3 3 3 3 3 3) "Question 15 - Test 1")
(check-equal? (repli '(1 2 2) 2) '(1 1 2 2 2 2) "Question 15 - Test 2")
(check-equal? (repli '() 15) '() "Question 15 - Test 3")
(check-equal? (repli '((apple banana) (15 16)) 2)
'((apple banana) (apple banana) (15 16) (15 16))
"Question 15 - Test 4")
; q16
(check-equal? (drop '(1 2 3 4 5 6 7 8) 3) '(1 2 4 5 7 8) "Question 16 - Test 1")
(check-equal? (drop '(1 2 3 4 5) 1) '() "Question 16 - Test 2")
(check-equal? (drop '() 3) '() "Question 16 - Test 3")
(check-equal? (drop '(1 2 3 4 5) 100) '(1 2 3 4 5) "Question 16 - Test 4")
; q17
(check-equal? (split '(1 2 3 4 5 6 7 8) 3) '((1 2 3) (4 5 6 7 8)) "Question 17 - Test 1")
(check-equal? (split '(1 2 3 4 5 6 7 8) 8) '((1 2 3 4 5 6 7 8) ()) "Question 17 - Test 2")
(check-exn exn:fail? (lambda () (split '(1 2 3 4 5) 16)))
; q18
(check-equal? (slice '(1 2 3 4 5 6 7 8) 3 7) '(3 4 5 6 7) "Question 18 - Test 1")
(check-equal? (slice '(1 2 3 4 5 6 7 8) 1 8) '(1 2 3 4 5 6 7 8) "Question 18 - Test 2")
(check-exn exn:fail? (lambda () (slice '(1 2 3 4 5) 3 8)))
(check-exn exn:fail? (lambda () (slice '(1 2 3 4 5) 4 2)))
; q19
(check-equal? (rotate '(1 2 3 4 5) 2) '(3 4 5 1 2) "Question 19 - Test 1")
(check-equal? (rotate '(1 2 3 4 5) 5) '(1 2 3 4 5) "Question 19 - Test 2")
(check-equal? (rotate '(1 2 3 4 5) -2) '(4 5 1 2 3) "Question 19 - Test 3")
(check-equal? (rotate '(1 2 3 4 5) 12) '(3 4 5 1 2) "Question 19 - Test 4")
; q20
(check-equal? (remove-at '(1 2 3 4) 2) '(1 3 4) "Question 20 - Test 1")
(check-equal? (remove-at '(1 2 3 4) 1) '(2 3 4) "Question 20 - Test 2")
(check-exn exn:fail? (lambda () (remove-at '(1 2 3 4) -3)))
(check-exn exn:fail? (lambda () (remove-at '(1 2 3 4) 15)))
; q21
(check-equal? (insert-at 3 '(1 2 4 5) 3) '(1 2 3 4 5) "Question 21 - Test 1")
(check-equal? (insert-at 4 '(1 2 3 4) 5) '(1 2 3 4 4) "Question 21 - Test 2")
(check-exn exn:fail? (lambda () (insert-at 3 '(1 2 3 4 5) -1)))
(check-exn exn:fail? (lambda () (insert-at 5 '(1 2 3 4 5) 8)))
; q22
(check-equal? (range 4 9) '(4 5 6 7 8 9) "Question 22 - Test 1")
(check-equal? (range 1 5) '(1 2 3 4 5) "Question 22 - Test 2")
(check-equal? (range 7 2) '(7 6 5 4 3 2) "Question 22 - Test 3")
; q26
(check-equal? (list->set (map list->set (combination 3 '(a b c d e f))))
(list->set (map list->set (combinations '(a b c d e f) 3))) "Question 26 - Test 1")
(check-equal? (list->set (map list->set (combination 6 '(a b c d e f))))
(list->set (map list->set (combinations '(a b c d e f) 6))) "Question 26 - Test 2")
(check-equal? (list->set (map list->set (combination 1 '(a b c d e f))))
(list->set (map list->set (combinations '(a b c d e f) 1))) "Question 26 - Test 3")
(check-equal? (list->set (sort-group-internals (group '(1 2 3 4) '(1 2 1))))
(list->set (group-test '(1 2 3 4) '(1 2 1)))
"Question 27(b) - Test 1")
(check-equal? (list->set (sort-group-internals (group '(1 2 3 4) '(1 1 2))))
(list->set (group-test '(1 2 3 4) '(1 1 2)))
"Question 27(b) - Test 2")
(check-exn exn:fail? (lambda ()
(group '(a b c) '(2 5 3))))
(check-exn exn:fail? (lambda ()
(group '(a b c d e f g h i) '(1 1 2)))
"Question 27 fail check 2")
(check-equal?
(lsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
(lsort-test '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
"Question 28(a) - Test 1")
(check-equal?
(lsort '())
(lsort-test '())
"Question 28(a) - Test 2")
(check-equal? (lsort '((a b c) (x y))) (lsort-test '((a b c) (x y))) "Question 28(a) - Test 3")
; q28(b)
(check-equal?
(lfsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
'((i j k l) (o) (a b c) (f g h) (d e) (d e) (m n))
"Question 28(b) - Test 1")
(check-equal?
(lfsort '((a b c) (d e)))
'((a b c) (d e))
"Question 28(b) - Test 2")
(check-equal?
(lfsort '()) '() "Question 28(b) - Test 3")
(check-equal?
(lfsort '((a b c) (d e) (b c)))
'((a b c) (d e) (b c))
"Question 28(b) - Test 4"))
(define (count-successes test)
(fold-test-results
(lambda (result seed)
(if (test-success? result)
(add1 seed)
seed))
0
test)))
(require 'a-test-module)
(count-successes a0))
ns))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment