2019121006.rkt

#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))

eval-submission.rkt

#|
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))