Advertisement
Guest User

LogCompAndyJack^2 - 2

a guest
Jan 24th, 2017
104
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 19.28 KB | None | 0 0
  1. #|
  2.  
  3. CS 2800 Homework 2 - Spring 2017
  4.  
  5. This homework is done in groups. More elaborate instructions will be
  6. posted on the course website soon:
  7.  
  8. * One group member will create a group in BlackBoard.
  9.  
  10. * Other group members then join the group.
  11.  
  12. * Homework is submitted once. Therefore make sure the person
  13. submitting actually does so. In previous terms when everyone needed
  14. to submit we regularly had one person forget but the other submissions
  15. meant the team did not get a zero. Now if you forget, your team gets 0.
  16. - It wouldn't be a bad idea for groups to email confirmation messages
  17. to each other to reduce anxiety.
  18.  
  19. * Submit the homework file (this file) on Blackboard. Do not rename
  20. this file. There will be a 10 point penalty for this.
  21.  
  22. * You must list the names of ALL group members below, using the given
  23. format. This way we can confirm group membership with the BB groups.
  24. If you fail to follow these instructions, it costs us time and
  25. it will cost you points, so please read carefully.
  26.  
  27. The format should be: FirstName1 LastName1, FirstName2 LastName2, ...
  28. For example:
  29. Names of ALL group members: David Sprague, Peizun Liu
  30.  
  31. There will be a 10 pt penalty if your names do not follow this format.
  32. Names of ALL group members: Andrew Schoenberger, Jack Mastrangelo, Jackson Steilberg ...
  33.  
  34. * Later in the term if you want to change groups, the person who created
  35. the group should stay in the group. Other people can leave and create
  36. other groups or change memberships (the Axel Rose membership clause).
  37. We will post additional instructions about this later.
  38.  
  39. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  40.  
  41. For this homework you will need to use ACL2s.
  42.  
  43. Technical instructions:
  44.  
  45. - open this file in ACL2s as hw02.lisp
  46.  
  47. - make sure you are in BEGINNER mode. This is essential! Note that you can
  48. only change the mode when the session is not running, so set the correct
  49. mode before starting the session.
  50.  
  51. - insert your solutions into this file where indicated (usually as "...")
  52.  
  53. - only add to the file. Do not remove or comment out anything pre-existing.
  54.  
  55. - make sure the entire file is accepted by ACL2s. In particular, there must
  56. be no "..." left in the code. If you don't finish all problems, comment
  57. the unfinished ones out. Comments should also be used for any English
  58. text that you may add. This file already contains many comments, so you
  59. can see what the syntax is.
  60.  
  61. - when done, save your file and submit it as hw02.lisp
  62.  
  63. - avoid submitting the session file (which shows your interaction with the
  64. theorem prover). This is not part of your solution. Only submit the lisp
  65. file.
  66.  
  67. Instructions for programming problems:
  68.  
  69. For each function definition, you must provide both contracts and a body.
  70.  
  71. You must also ALWAYS supply your own tests. This is in addition to the
  72. tests sometimes provided. Make sure you produce sufficiently many new test
  73. cases. This means: cover at least the possible scenarios according to the
  74. data definitions of the involved types. For example, a function taking two
  75. lists should have at least 4 tests: all combinations of each list being
  76. empty and non-empty.
  77.  
  78. Beyond that, the number of tests should reflect the difficulty of the
  79. function. For very simple ones, the above coverage of the data definition
  80. cases may be sufficient. For complex functions with numerical output, you
  81. want to test whether it produces the correct output on a reasonable
  82. number of inputs.
  83.  
  84. Use good judgment. For unreasonably few test cases we will deduct points.
  85.  
  86. We will use ACL2s' check= function for tests. This is a two-argument
  87. function that rejects two inputs that do not evaluate equal. You can think
  88. of check= roughly as defined like this:
  89.  
  90. (defunc check= (x y)
  91. :input-contract (equal x y)
  92. :output-contract (equal (check= x y) t)
  93. t)
  94.  
  95. That is, check= only accepts two inputs with equal value. For such inputs, t
  96. (or "pass") is returned. For other inputs, you get an error. If any check=
  97. test in your file does not pass, your file will be rejected.
  98.  
  99. |#
  100.  
  101. #|
  102.  
  103. Since this is our first programming exercise, we will simplify the
  104. interaction with ACL2s somewhat: instead of asking it to formally *prove*
  105. the various conditions for admitting a function, we will just require that
  106. they be *tested* on a reasonable number of inputs. This is achieved using
  107. the following directive (do not remove it!):
  108.  
  109. |#
  110.  
  111. :program
  112. #|
  113.  
  114. Notes:
  115.  
  116. 1. Testing is cheaper but less powerful than proving. So, by turning off
  117. proving and doing only testing, it is possible that the functions we are
  118. defining cause runtime errors even if called on valid inputs. In the future
  119. we will require functions complete with admission proofs, i.e. without the
  120. above directive. For this first homework, the functions are simple enough
  121. that there is a good chance ACL2s's testing will catch any contract or
  122. termination errors you may have.
  123.  
  124. 2. The tests ACL2s runs test only the conditions for admitting the
  125. function. They do not test for "functional correctness", i.e. does the
  126. function do what it is supposed to do? ACL2s has no way of telling what
  127. your function is supposed to do. That is what your own tests are for.
  128.  
  129. 3. For now testing is written using check= expressions. These take the following
  130. format (and should be familiar to those of you that took Fundies I)
  131. (check= <expression> <thing it should be equal to>)
  132. EX: (check= (- 4/3 1) 1/3)
  133.  
  134. |#
  135.  
  136. #|
  137. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  138. Part I:
  139. The functions below should warm you up for the rest of the
  140. assignment.
  141. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  142. |#
  143.  
  144. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  145. ;; Define
  146. ;; TriXOR: Bool x Bool x Bool -> Bool
  147. ;;
  148. ;; (TriXOR x y z) takes three booleans x y and z and returns true if and
  149. ;; only if exactly 1 of the variables is true. This is XOR applied
  150. ;; to three variables.
  151. (defunc TriXOR (x y z)
  152. :input-contract (and (booleanp x) (booleanp y) (booleanp z))
  153. :output-contract (booleanp (TriXOR x y z))
  154. (or (and x (not y) (not z))
  155. (and (not x) y (not z))
  156. (and (not x) (not y) z)))
  157.  
  158. (check= (TriXOR t t nil) nil)
  159. (check= (TriXOR nil t nil) t)
  160. ;; Additional checks needed
  161. (check= (TriXOR t nil nil) t)
  162. (check= (TriXOR nil nil t) t)
  163. (check= (TriXOR nil nil nil) nil)
  164. (check= (TriXOR t t t) nil)
  165. (check= (TriXOR nil t t) nil)
  166. (check= (TriXOR t nil t) nil)
  167.  
  168. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  169. ;; Define
  170. ;; how-many: All x List -> Nat
  171. ;;
  172. ;; (how-many e l) returns the number of occurrences of element e
  173. ;; in list l.
  174. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  175. (defunc how-many (e l)
  176. :input-contract (listp l)
  177. :output-contract (natp (how-many e l))
  178. (cond
  179. ((endp l) 0)
  180. ((equal (first l) e) (+ 1 (how-many e (rest l))))
  181. (t (how-many e (rest l)))))
  182.  
  183. (check= (how-many 1 ()) 0)
  184. (check= (how-many 1 '(1 1)) 2)
  185. ;; Add additional tests
  186. (check= (how-many 1 '(2 2 2 2 2)) 0)
  187. (check= (how-many t '(nil nil t nil nil)) 1)
  188. (check= (how-many 1 '(1 2 1 2 1 2)) 3)
  189. (check= (how-many 1 '(1 1 5 1 51111)) 3)
  190.  
  191.  
  192. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  193. ; Define
  194. ; same-multiplicity: List x List x List -> Boolean
  195. ;
  196. ; (same-multiplicity l l1 l2) returns t iff every element of l occurs in l1
  197. ; and l2 the same number of times.
  198. ; REMEMBER: you can ALWAYS use functions from earlier in the
  199. ; program. The functions were given in this order for a reason.
  200. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  201. (defunc same-multiplicity (l l1 l2)
  202. :input-contract (and (listp l) (listp l1) (listp l2))
  203. :output-contract (booleanp (same-multiplicity l l1 l2))
  204. (cond ((endp l) t)
  205. ((equal (how-many (first l) l1) (how-many (first l) l2))
  206. (same-multiplicity (rest l) l1 l2))
  207. (t nil)))
  208.  
  209. (check= (same-multiplicity '(1) '(2 1 3) '(1 2 2)) t)
  210. (check= (same-multiplicity '(1 2) '(2 1 3) '(1 2 2)) nil)
  211. (check= (same-multiplicity '(1 2) '(5 3 5 2 1) '(2 4 1)) t)
  212. (check= (same-multiplicity '() '(1 2 3) '(4 5 6)) t)
  213. (check= (same-multiplicity '(1 2 3 4) '() '(6 7)) t)
  214. (check= (same-multiplicity '(1 2 3 4) '(4 3) '()) nil)
  215. (check= (same-multiplicity '(1 2 3 4) '() '()) t)
  216. (check= (same-multiplicity '(1 2) '() '(6)) t)
  217. (check= (same-multiplicity '(1 2 6 7) '(3 4 6 8 7) '(7 6)) t)
  218. (check= (same-multiplicity '(t nil) '(nil t 1 2) '(5 t nil)) t)
  219. (check= (same-multiplicity '() '() '()) t)
  220. (check= (same-multiplicity '(1) '(451) '(22)) t)
  221.  
  222. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  223. ;; flat-listp
  224. ;; flat-listp: Any -> Boolean
  225. ;;
  226. ;; (flat-listp l) takes an input l and returns true if and only if
  227. ;; l is a list AND each element in l is not a list.
  228. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  229. (defunc flat-listp (l)
  230. :input-contract t
  231. :output-contract (booleanp (flat-listp l))
  232. (if (listp l)
  233. (cond ((endp l) t)
  234. ((not (listp (first l))) (flat-listp (rest l)))
  235. (t nil))
  236. nil))
  237.  
  238. (check= (flat-listp '(1 2 (3))) nil)
  239. (check= (flat-listp '(1 2 3)) t)
  240. ;; Make sure you add additional tests
  241. (check= (flat-listp '()) t)
  242. (check= (flat-listp '(())) nil)
  243. (check= (flat-listp '(1 2 ())) nil)
  244. (check= (flat-listp 1) nil)
  245. (check= (flat-listp t) nil)
  246. (check= (flat-listp '((4 3 2))) nil)
  247.  
  248. #|
  249. Part II: List manipulation
  250. This following section deals with functions involving lists in general.
  251. Some functions you write may be useful in subsequent functions.
  252. In all cases, you can define your own helper functions if that simplifies
  253. your coding
  254. |#
  255.  
  256. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  257. ;; merge-lists
  258. ;; merge-lists: List x List -> List
  259. ;;
  260. ;; (merge-lists l1 l2) takes two lists l1 and l2 and returns a
  261. ;; list with all elements from both alternating between elements in l1
  262. ;; and l2....consider it zipping the lists together.
  263. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  264. (defunc merge-lists (l1 l2)
  265. :input-contract (and (listp l1) (listp l2))
  266. :output-contract (listp (merge-lists l1 l2))
  267. (cond
  268. ((endp l1) l2)
  269. ((endp l2) l1)
  270. (t (cons (first l1)
  271. (cons (first l2)
  272. (merge-lists (rest l1) (rest l2)))))))
  273.  
  274. (check= (merge-lists '(a b c d) '(1 2 3 4 5))
  275. '(a 1 b 2 c 3 d 4 5))
  276. (check= (merge-lists '() '()) '())
  277. (check= (merge-lists '(1 2 3) '()) '(1 2 3))
  278. (check= (merge-lists '() '(4 5 6)) '(4 5 6))
  279. (check= (merge-lists '(1 3 5) '(2 4)) '(1 2 3 4 5))
  280. (check= (merge-lists '(3 5) '(4 6 7)) '(3 4 5 6 7))
  281. (check= (merge-lists '(t nil) '(nil t)) '(t nil nil t))
  282.  
  283. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  284. ;; flatten-list
  285. ;; flatten-list: List -> List (a flat list)
  286. ;;
  287. ;; (flatten-list l) takes an input list l and creates a new list
  288. ;; with all the same atomic elements (excluding nil) in l but the new list
  289. ;; has no sub-lists.
  290. ;; HINT: this may be a complex function for many of you. Let's pretend
  291. ;; (first l) is a list. What happens if I append (first l) to (rest l)??
  292. ;; Can I call flatten-list again on this new list? Am I guaranteed
  293. ;; to stop recursing?
  294. ;; When can I NOT call app?
  295. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  296. (defunc flatten-list (l)
  297. :input-contract (listp l)
  298. :output-contract (flat-listp (flatten-list l))
  299. (cond
  300. ((endp l) nil)
  301. ((listp (first l)) (app (flatten-list (first l))
  302. (flatten-list (rest l))))
  303. (t (cons (first l) (flatten-list (rest l))))))
  304.  
  305. (check= (flatten-list '((1 2 3) nil 4 (5 6))) '(1 2 3 4 5 6))
  306. ; Add additional tests.
  307. (check= (flatten-list '((1 2) ((4 5 6)) 7 8 (((9 10))))) '(1 2 4 5 6 7 8 9 10))
  308. (check= (flatten-list '()) '())
  309. (check= (flatten-list '(1 2 3 4 5)) '(1 2 3 4 5))
  310. (check= (flatten-list '(1 2 (3 (4)) 5 6)) '(1 2 3 4 5 6))
  311. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  312. ;; wrap-elements: List -> List
  313. ;;
  314. ;; (wrap-elements l) takes an input list l and creates a new list
  315. ;; with all elements of l put into list of size 1 (hence each element
  316. ;; of l is wrapped in a list in the returned list. See the check=
  317. ;; tests below for illustrative examples
  318. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  319. (defunc wrap-elements (l)
  320. :input-contract (listp l)
  321. :output-contract (listp (wrap-elements l))
  322. (cond
  323. ((endp l) nil)
  324. (t (cons (cons (first l) nil) (wrap-elements (rest l))))))
  325.  
  326. (check= (wrap-elements '(1 2 3)) '((1) (2) (3)))
  327. (check= (wrap-elements '(1 2 (3))) '((1) (2) ((3))))
  328.  
  329. ; Additional tests
  330. (check= (wrap-elements '()) '())
  331. (check= (wrap-elements '((1)(2)(3))) '(((1))((2))((3))))
  332. (check= (wrap-elements '(())) '((())))
  333.  
  334.  
  335. #|
  336. Part III: Discrete Math Fun
  337. Below are a set of functions that you might find useful later
  338. in the term. These help you do discrete arithmetic like you
  339. did in CS 1800.
  340. |#
  341.  
  342. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  343. ;; Define
  344. ;; rem-similar: Nat x Nat-{0} -> Nat
  345. ;;
  346. ;; (rem-similar x y) returns the remainder of the integer division of
  347. ;; x by y assuming that x and y are relatively the same size.
  348. ;; This is a helper method for (rem x y)
  349. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  350. (defunc rem-similar (x y)
  351. :input-contract (and (natp x)(posp y))
  352. :output-contract (natp (rem-similar x y))
  353. (cond
  354. ((< x y) x)
  355. (t (rem-similar (- x y) y))))
  356.  
  357. (check= (rem-similar 8000000004 2000000000) 4)
  358. ;; The check below would be extremely slow using this method of calculating
  359. ;; the remainder
  360. ;; (check= (rem-similar 800000 2))
  361. (check= (rem-similar 100 75) 25)
  362. (check= (rem-similar 1200 850) 350)
  363. (check= (rem-similar 3 5) 3)
  364. (check= (rem-similar 6 1) 0)
  365.  
  366. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  367. ; Define
  368. ; rem-smally: Nat x Nat-{0} -> Nat
  369. ;
  370. ; (rem-smally x y) returns the remainder of the integer division of
  371. ; x by y assuming that y is relatively small compared to x.
  372. ; This is a helper method for (rem x y)
  373. (defunc rem-smally (x y)
  374. :input-contract (and (natp x)(posp y))
  375. :output-contract (natp (rem-smally x y))
  376. (cond
  377. ((equal 1 y) 0)
  378. ((< x y) x)
  379. ((< (/ x (* y 10)) 1) (rem-similar x y))
  380. (t (rem-smally (rem-smally x (* y 10)) y))))
  381.  
  382. ;; The check below would be extremely slow using this method of calculating
  383. ;; the remainder
  384. ;;(check= (rem-smally 8000000004 2000000000) 4)
  385. (check= (rem-smally 800001 2) 1)
  386. (check= (rem-similar 100 75) 25)
  387. (check= (rem-similar 1200 850) 350)
  388. (check= (rem-similar 3 5) 3)
  389. (check= (rem-similar 6 1) 0)
  390. (check= (rem-smally 800001 4) 1)
  391.  
  392. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  393. ; GIVEN
  394. ; rem: Nat x Nat-{0} -> Nat
  395. ;
  396. ; (rem x y) returns the remainder of the integer division of x by y.
  397. ; There are two ways to calculate the remainder(both use subtraction).
  398. ; Think about what these two ways are.
  399. ; Note that for some numbers like x = 100000000 and y =11 one method is better.
  400. ; Thus we will make two definitions:
  401. ; For x and y being approximately the same size we use rem-similar
  402. ; since it is more efficient.
  403. ; For small values of y (and arbitrarily large x values), use rem-smally
  404. ; Fill in these function above. If you are curious, try calling
  405. ; (rem-smally 5000000000 4999999) and (rem-similar 5000000000 3)
  406. ; and see why we need 2 approaches.
  407. (defunc rem (x y)
  408. :input-contract (and (natp x)(posp y))
  409. :output-contract (natp (rem x y))
  410. (if (< y (/ x y))
  411. (rem-smally x y)
  412. (rem-similar x y)))
  413.  
  414. (check= (rem 2 4) 2)
  415. (check= (rem 4 2) 0)
  416. (check= (rem 16 1) 0)
  417. (check= (rem 1234567 10) 7)
  418. (check= (rem 123 48) 27)
  419.  
  420. ; Additional Checks
  421. (check= (rem 132123123123 2) 1)
  422. (check= (rem 0 12) 0)
  423. (check= (rem 12345 5) 0)
  424.  
  425.  
  426. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  427. ;; nat/: Nat x Nat-{0} -> Nat
  428. ;; (nat/ x y) takes a natural number x and a positive integer
  429. ;; y and returns x / y rounded down to the nearest natural number
  430. ;; HINT: If you want this function to work in logic mode later
  431. ;; in the term, how can you do division without using "/"?
  432. ;; (the function / returns a rational and ACL2s can't easily
  433. ;; prove the output is actually a natural number).
  434. ;; What is (nat/ 5 2)? What about (nat/ 7 2)? (nat/ 9 2)?
  435. ;; Do you notice a pattern.
  436. (defunc nat/ (x y)
  437. :input-contract (and (natp x)(posp y))
  438. :output-contract (natp (nat/ x y))
  439. (- (* x (unary-/ y))
  440. (* (rem x y) (unary-/ y))))
  441.  
  442. (check= (nat/ 16 3) 5)
  443. (check= (nat/ 16 2) 8)
  444.  
  445. ;; Additional tests
  446. (check= (nat/ 5 2) 2)
  447. (check= (nat/ 78 2) 39)
  448. (check= (nat/ 15 7) 2)
  449. (check= (nat/ 0 1) 0)
  450.  
  451. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  452. ;; GIVEN
  453. ;; abs: Rationalp -> Rationalp >= 0
  454. ;; (abs r) alculates the absolute value of a rational number r
  455. (defunc abs (r)
  456. :input-contract (rationalp r)
  457. :output-contract (and (rationalp (abs r))(>= (abs r) 0))
  458. (if (< r 0)
  459. (unary-- r)
  460. r))
  461.  
  462. (check= (abs -3/2) 3/2)
  463. (check= (abs 3/2) 3/2)
  464. (check= (abs -3456778/2) 3456778/2)
  465.  
  466.  
  467. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  468. ;; int/: Int x Int-{0} -> Int
  469. ;; (int/ x y) takes an integer x and a non-zero integer y
  470. ;; and returns x / y rounded down to the nearest integer value if
  471. ;; positive and rounded UP if the result is negative.
  472. ;; HINT: Do not re-invent the wheel here. Use previous functions.
  473. (defunc int/ (x y)
  474. :input-contract (and (integerp x) (and (integerp y) (not (equal y 0))))
  475. :output-contract (integerp (int/ x y))
  476. (cond
  477. ((and (posp x) (posp y)) (nat/ x y))
  478. ((not (or (posp x) (posp y))) (nat/ (abs x) (abs y)))
  479. (t (* -1 (nat/ (abs x) (abs y))))))
  480.  
  481. ;; Add additional tests after these
  482. (check= (int/ -5 -4) 1)
  483. (check= (int/ 5 -4) -1)
  484. (check= (int/ 5 -4) -1)
  485. (check= (int/ 5 4) 1)
  486.  
  487. ; Additional Checks
  488. (check= (int/ -5 2) -2)
  489. (check= (int/ -9 2) -4)
  490. (check= (int/ 10 -3) -3)
  491. (check= (int/ 10 3) 3)
  492.  
  493. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  494. ;; GIVEN
  495. ;; floor: Rational -> Integer
  496. ;;
  497. ;; (floor r) returns the closest integer less than rational r
  498. ;; (if r is an integer return r).
  499. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  500. (defunc floor (r)
  501. :input-contract (rationalp r)
  502. :output-contract (integerp (floor r))
  503. (let* ((absnum (abs (numerator r)))
  504. (posfloor (nat/ absnum (denominator r))))
  505. (cond ((integerp r) r)
  506. ((< (numerator r) 0) (- (unary-- posfloor) 1))
  507. (t posfloor))))
  508.  
  509.  
  510. (check= (floor 4/3) 1)
  511. (check= (floor 3/4) 0)
  512. (check= (floor 2) 2)
  513. (check= (floor -2) -2)
  514. (check= (floor -4/3) -2)
  515. (check= (floor 0) 0)
  516. (check= (floor 24/5) 4)
  517.  
  518.  
  519. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  520. ;; DEFINE
  521. ;; round: Rational -> Integer
  522. ;;
  523. ;; (round r) returns the closest integer to the rational
  524. ;; number r. For simplicity sake, any value X.Y should be rounded up
  525. ;; (the direction of positive infinity) for Y > 1/2
  526. ;; and rounded down for values of Y <= 1/2
  527. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  528. (defunc round (r)
  529. :input-contract (rationalp r)
  530. :output-contract (integerp (round r))
  531. ......
  532.  
  533. (check= (round 4/3) 1)
  534. (check= (round -4/3) -1)
  535. (check= (round 5/3) 2)
  536.  
  537. (check= (round -5/3) -2)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement