I'm pretty new, trying to learn lisp, so I decided to try to write a program than could teach me. Most ideas are copied from PCL and almost all problems are copied from http://www.ic.unicamp.br/~meidanis/cour ... blems.html
Code: Select all
(defclass function-sketch ()
((name
:initarg :name
:initform (error "Must supply :name <function-sketch-name>")
:accessor name
:documentation "The name of the function-sketch")
(test-list
:initarg :test-list
:initform '()
:accessor test-list
:documentation "A list of cons cells looking like (<input-arguments-in-a-list> . <wished-for-return-value>)")
(description
:initarg :description
:initform ""
:accessor description
:documentation "A human readable description of why this function should be written.")
(implementations
:initarg :implementations
:initform '()
:accessor implementations
:documentation "A list containing valid implementations of the sketched function.")))
(defmethod print-object ((object function-sketch) stream)
(print-unreadable-object (object stream :type t)
(with-slots (name test-list description) object
(let ((print-list (loop for i in test-list
collect name
collect (car i)
collect (cdr i))))
(format stream
"~%~a~%~%Description:~%~a~%~%Tests to satisfy:~%~{(~a~{ ~a~^~}) ==> ~a~%~}"
name description print-list)))))
(defvar *function-sketch-lib* (make-array 1000 :adjustable t :fill-pointer 0))
(defun clear-sketch-lib ()
(setf
*function-sketch-lib* (make-array 1000 :adjustable t :fill-pointer 0)))
(defparameter *passed?* t)
(defun compare-to-sketch (user-fct sketch-object)
(with-slots (test-list) sketch-object
(loop for f in test-list do (report-result user-fct (car f) (cdr f)))))
(defun report-result (user-fct arglst wished-for-result)
(if (equal (apply user-fct arglst) wished-for-result)
(format t "Score! (~a~{ ~a~}) evaluated to ~a.~%" user-fct arglst (apply user-fct arglst))
(progn
(format t "Something's wrong. (~a~{ ~a~}) evaluated to ~a.~%" user-fct arglst (apply user-fct arglst))
(setf *passed?* nil))))
(defun assure-implementations (function-sketch-object)
(loop for i in (implementations function-sketch-object)
do (compare-to-sketch (eval i) function-sketch-object)
(when (not *passed?*)
(setf (implementations function-sketch-object) (delete i (implementations function-sketch-object)))
(format t "Removed ~a from implementations list." i)
(setf *passed?* t))))
(defun append-test-list (function-sketch-object test-list)
(setf (test-list function-sketch-object) (append (test-list function-sketch-object) test-list))
(assure-implementations function-sketch-object))
(defun set-test-list (function-sketch-object test-list)
(setf (test-list function-sketch-object) test-list)
(assure-implementations function-sketch-object))
(defun set-description (function-sketch-object description)
(setf (description function-sketch-object) description))
(defun add-implementation (function-sketch-object implementation)
(setf (implementations function-sketch-object) (cons implementation (implementations function-sketch-object))))
(defun intern-sketch (name &optional test-list description)
(unless (find name *function-sketch-lib* :key 'name)
(vector-push-extend (make-instance 'function-sketch :name name) *function-sketch-lib*)
(when test-list (set-test-list (find name *function-sketch-lib* :key 'name) test-list))
(when description (set-description (find name *function-sketch-lib* :key 'name) description))))
(defun challenge-me (&optional library-index)
(cond
((not (or (null library-index) (numberp library-index)))
(progn (princ "challenge-me didn't understand your library-index, choose new.")
(return-from challenge-me (challenge-me (read)))))
((zerop (length *function-sketch-lib*)) (error "*function-sketch-lib* is empty."))
((null library-index) (return-from challenge-me (challenge-me (random (length *function-sketch-lib*)))))
((or (>= library-index (length *function-sketch-lib*)) (> 0 library-index))
(progn (princ "Index out of bounds, choose new.")
(return-from challenge-me (challenge-me (read))))))
(let ((chosen-sketch (elt *function-sketch-lib* library-index)))
(print chosen-sketch)
(format t "~%Now write a function that fulfills the tests.~%")
(let ((data (read)))
(compare-to-sketch (eval data) chosen-sketch)
(if *passed?*
(progn
(add-implementation chosen-sketch data)
(format t
"Congratulations, your function passed all the tests!
It is now added in implementations-list of sketch object ~a.~%"
(name chosen-sketch)))
(setf *passed?* t)))))
(intern-sketch 'add-two '(((1 1) . 2) ((1 2) . 3) ((0 0) . 0)) "Adds two arguments...")
(intern-sketch 'add-three '(((1 1 1) . 3) ((1 2 2) . 5) ((0 0 0) . 0)) "Adds three arguments...")
(intern-sketch 'return-two '(((1 1) . 2) ((1 2) . 2) ((0 0) . 2)) "Returns 2 no matter what the input...")
(intern-sketch 'return-three '(((1 1) . 3) ((1 2) . 3) ((0 0) . 3)) "Returns 3 no matter what the input...")
(intern-sketch 'my-last '((((1 2 3)) . (3)) (((a b c)) . (c)) (((1)) . (1))) "Extracts the last box from a list.")
(intern-sketch 'my-two-last '((((1 2 3)) . (2 3)) (((a b c)) . (b c)) (((1 0)) . (1 0)))
"Extracts the two last boxes from a list.")
(intern-sketch 'my-kth-element '((((1 2 3) 2) . 3) (((a b c) 1) . b) (((1) 0) . 1))
"Extracts the k'th element from a list (zero based).")
(intern-sketch 'my-#-elements '((((1 2 3)) . 3) (((a b c d)) . 4) (((1)) . 1))
"Gives the number of elements in a list.")
(intern-sketch 'my-reverse '((((1 2 3)) . (3 2 1)) (((a b c d)) . (d c b a)) (((1)) . (1)))
"Gives the reverse of a list.")
(intern-sketch 'my-palindrome? '((((1 2 3)) . nil) (((a b c d c b a)) . t) (((1)) . t))
"Returns T if list is a palindrome, nil otherwise.")
(intern-sketch 'my-flatten '((((1 (2 (3)))) . (1 2 3)) (((a (b c (d)) c (b a))) . (a b c d c b a)) ((((1))) . (1)))
"Flattens nested list structure.")
(intern-sketch 'my-consecutive-duplicate-killer
'((((a a a a b c c a a d e e e e)) . (a b c a d e))
(((1 0 0 1 1 1 0)) . (1 0 1 0)))
"Replaces consecutive copies of element by single element. Conserves order of elements.")
(intern-sketch 'my-pack
'((((a a a a b c c a a d e e e e)) . ((a a a a) (b) (c c) (a a) (d) (e e e e)))
(((1 0 0 1 1 1 0)) . ((1) (0 0) (1 1 1) (0))))
"Packs consecutive duplicates of list elements into sublists.")
(intern-sketch 'my-encode
'((((a a a a b c c a a d e e e e)) . ((4 a) (1 b) (2 c) (2 a) (1 d) (4 e)))
(((1 0 0 1 1 1 0)) . ((1 1) (2 0) (3 1) (1 0))))
"All elements are encoded as lists (N E) where N is # of consecutive repetitions
of the element E. ")
(intern-sketch 'my-encode-duplicates
'((((a a a a b c c a a d e e e e)) . ((4 a) b (2 c) (2 a) d (4 e)))
(((1 0 0 1 1 1 0)) . (1 (2 0) (3 1) 0)))
"Consecutive duplicates are encoded as lists (N E) where N
is # of consecutive repetitions of element E. Single elements are left untouched.")
(intern-sketch 'my-unpack
'(((((4 a) (1 b) (2 c) (2 a) (1 d) (4 e))) . (a a a a b c c a a d e e e e))
((((1 1) (2 0) (3 1) (1 0))) . (1 0 0 1 1 1 0)))
"Constructs a list from a packed list where consecutive repetitions are encoded as lists (N E) where N
is # of consecutive repetitions of element E.")
(intern-sketch 'my-unpack-duplicates
'(((((4 a) b (2 c) (2 a) d (4 e))) . (a a a a b c c a a d e e e e))
(((1 (2 0) (3 1) 0)) . (1 0 0 1 1 1 0)))
"Constructs a list from a packed list where consecutive duplicates are encoded as lists (N E) where N
is # of duplicates of element E. Single elements are left untouched.")
(intern-sketch 'my-duplicate
'((((1 2 3)) . (1 1 2 2 3 3)) (((a b c d)) . (a a b b c c d d)) (((1)) . (1 1)))
"Duplicates the elements of a list.")
(intern-sketch 'my-replicate
'((((1 2 3) 3) . (1 1 1 2 2 2 3 3 3)) (((a b c d) 1) . (a b c d)) (((1) 5) . (1 1 1 1 1)))
"Replicates the elements of a list a given number of times.")
(intern-sketch 'my-nth-drop
'((((1 2 3 4 5 6) 3) . (1 2 4 5)) (((a b c d) 1) . ()) (((a b c d e f) 5) . (a b c d f)))
"Drops every N'th element from a list.")
(intern-sketch 'my-split
'((((1 2 3 4 5 6) 3) . ((1 2 3) (4 5 6)))
(((a b c d) 1) . ((a) (b c d)))
(((a b c d e f) 5) . ((a b c d e) (f))))
"Splits a list into two parts; the length of the first part is given.")
(intern-sketch 'my-slice
'((((1 2 3 4 5 6) 1 3) . (2 3))
(((a b c d) 0 1) . ())
(((a b c d e f) 5 6) . (f)))
"Extracts a slice from a list. (zero based. Including firstindex, upto but not including second index)")
(intern-sketch 'my-rotate
'((((1 2 3 4 5 6) 3) . (4 5 6 1 2 3))
(((a b c d) -1) . (d a b c))
(((a b c d e f) 1) . (b c d e f a)))
"Rotates a list N places to the left.")
(intern-sketch 'my-remove-kth
'((((1 2 3 4 5 6) 0) . (2 3 4 5 6))
(((a b c d) 2) . (a b d))
(((a b c d e f) -1) . (a b c d e)))
"Removes the K'th element from a list. Zero based. Should support negative indexes.")
(intern-sketch 'my-list-insert
'(((3 (1 2 3 4 5 6) 0) . (3 1 2 3 4 5 6))
((Q (a b c d) 2) . (a b Q c d))
((Q (a b c d e f) -1) . (a b c d e f Q)))
"Inserts an element at a given (zero based) position into a list.")
(intern-sketch 'my-range
'(((0 10) . (0 1 2 3 4 5 6 7 8 9))
((1 -2) . (1 0 -1))
((10 0) . (10 9 8 7 6 5 4 3 2 1)))
"Creates a list containing all integers within a given range.
If first argument is smaller than second, produce a list in decreasing order.")To get random challenge write:
Code: Select all
(challenge-me)Code: Select all
(challenge-me <index>)Code: Select all
(loop for i from 0 to (1- (length *function-sketch-lib*)) do (challenge-me i))Code: Select all
(implementations (find '<sketchname> *function-sketch-lib* :key 'name))Code: Select all
*function-sketch-lib*Code: Select all
(clear-sketch-lib)Feel free to post new sketches, implementations or comments on the code. I'm here to learn.
