(in-package "ACL2") (program) (redef) (set-guard-checking :none) ;; First we will do a wrong version of the factorial program. (defun fact (n) (if (equal n 0) 1 (* n (fact (- n 1))))) ;; This one causes a stack overflow because of infinite loop. (fact -2) ;; This one causes a guard violation. (fact "warren") ;; But we can override the guard violation. (set-guard-checking :none) ;; Now it will cause stack overflow. (fact "warren") ;; The fix: Use zp. Of course we have already seen that. (defun fact (n) (if (zp n) 1 (* n (fact (- n 1))))) ;; Test the same examples (fact -2) (fact "warren") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Problem 2: Finding a minimum value in a integer list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Sometimes we need to use an auxiliary function. (defun find-min-aux (l min-so-far) (if (endp l) min-so-far (if (< (car l) min-so-far) (find-min-aux (cdr l) (car l)) (find-min-aux (cdr l) min-so-far)))) (defun find-min (l) (find-min-aux l (car l))) ;; But what will be the value of find-min when you give it an empty ;; list? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Problem 3: Sorting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; We first define a function insert that inserts an element in the ;; right position of an already sorted list. (defun insert (e x) (if (endp x) (list e) (if (< e (car x)) (cons e x) (cons (car x) (insert e (cdr x)))))) (defun insertion-sort (x) (if (endp x) nil (insert (car x) (insertion-sort (cdr x))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Problem 4: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Some problems are inherently recursive. ;; Here is the Tower of Hanoi problem. This problem is illustrated by ;; the following picture. ;; | | | ;; | | | ;; --- | | ;; ----- | | ;; ------- | | ;; A B C ;; We have three pegs -- a, b, and c -- and n disks of different ;; sizes. The disks are all initially on peg a. The goal is to move ;; all disks to peg c while observing the following two rules. ;; 1. Only one disk may be moved at a time, and it must start and ;; finish the move as the topmost disk on some peg; ;; 2. A disk can never be placed on top of a smaller disk. (defun move (a b) (list 'move a 'to b)) (defun hanoi (a b c n) (if (zp n) nil (if (equal n 1) (list (move a c)) (append (hanoi a c b (- n 1)) (cons (move a c) (hanoi b a c (- n 1))))))) (defun fibHelper (k i ans ansSub1) (if (>= k i) ans (fibHelper (1+ k) i (+ ans ansSub1) ans))) (defun fib2 (i) (fibHelper 1 i 1 0))