#lang racket ;; Put your name here: ;; ********************************************************************** ;; This is the starter file for the CS251 Spring 2016 Take-Home Exam 1 ;; ********************************************************************** ;; ********************************************************************** ;; These helper functions are used throughout the exam ;; ********************************************************************** (define (forall? pred xs) (if (null? xs) #t (and (pred (car xs)) (forall? pred (cdr xs))))) (define (exists? pred xs) (if (null? xs) #f (or (pred (car xs)) (exists? pred (cdr xs))))) (define (find pred not-found xs) (if (null? xs) not-found (if (pred (car xs)) (car xs) (find pred not-found (cdr xs))))) (define (zip xs ys) (if (or (null? xs) (null? ys)) null (cons (cons (car xs) (car ys)) (zip (cdr xs) (cdr ys))))) (define (foldr-ternop ternop null-value xs) (if (null? xs) null-value (ternop (first xs) (rest xs) (foldr-ternop ternop null-value (rest xs))))) (define (genlist next done? seed) (if (done? seed) null (cons seed (genlist next done? (next seed))))) (define (iterate next done? finalize state) (if (done? state) (finalize state) (iterate next done? finalize (next state)))) (define (iterate-apply next done? finalize state) (if (apply done? state) (apply finalize state) (iterate-apply next done? finalize (apply next state)))) ;; ********************************************************************** ;; Problem 1: Conjunction Junction ;; ********************************************************************** (define (and-fun a b) (if a b #f)) (define (between x lo hi) (and (<= lo x) (<= x hi))) ;; [2016/03/01] first-positive? replaced bogus all-positive? (define (first-positive? nums) (and (not (null? nums)) (> (first nums) 0))) ;; [2016/03/01] commented out because has an (intentional) error prevenint it from loading ; (define (all-negative? nums) ; (foldr and #t (map (λ (n) (< n 0)) nums))) ;; ********************************************************************** ;; Problem 2: It's a Factor! ;; ********************************************************************** (define (least-divisor-rec num) (let ((limit (ceiling (sqrt num)))) (define (search-for-divisor candidate) (if (> candidate limit) num (if (divisible-by? num candidate) candidate (search-for-divisor (+ candidate 2))))) (if (divisible-by? num 2) 2 (search-for-divisor 3)))) (define (divisible-by? num divisor) (= (remainder num divisor) 0)) (define (factors-rec num) (let ((factor (least-divisor-rec num))) (if (= factor num) (list factor) (cons factor (factors-rec (quotient num factor)))))) ;; ---------------------------------------------------------------------- ;; Problem 2a: Put your definition of hamming? here ;(define (hamming? num) ; (and (integer? num) ; (> num 0) ; (or (= num 1) ; (forall? ; put expression 1 here ; ; put expression 2 here ; )) ;; ---------------------------------------------------------------------- ;; Problem 2b: Put your definition of least-divisor-find here ;(define (least-divisor-find num) ; (find ; put expression 1 here ; ; put expression 2 here ; ; put expresion 3 here ; )) ;; ---------------------------------------------------------------------- ;; Problem 2c: Put your definition of factors-genlist here ;(define (factors-genlist num) ; (map second ; (genlist ; put expression 1 here ; ; put expression 2 here ; (list num ; ; put expression 3 here ; )))) ;; ---------------------------------------------------------------------- ;; Problem 2d: Put your definition of factors-iterate-apply here ;(define (factors-iterate-apply num) ; (iterate-apply ; put expression 1 here ; ; put expression 2 here ; ; put expression 3 here ; (list num null))) ;; ********************************************************************** ;; Problem 3: Mysterious Composition ;; ********************************************************************** (define (mystery nums) (foldr max 0 (filter (λ (n) (> n 0)) (map (λ (pair) (* (car pair) (cdr pair))) ((λ (ns) (zip ns (rest ns))) (cons 0 nums)))))) ;; ---------------------------------------------------------------------- ;; Problem 3c: Put your definition of mystery-foldl here ; ;(define (mystery-foldl nums) ; (cdr (foldl ; put combiner expression here ; (cons 0 0) ; pair of (1) previous list value and (2) maximum so far ; nums))) ;; ---------------------------------------------------------------------- ;; Problem 3e: Here are the helper functions (define (id x) x) (define (o f g) (λ (x) (f (g x)))) (define (o-all fun-list) (foldr o id fun-list)) (define (flip2 binop) (λ (x y) (binop y x))) (define (curry2 binop) (λ (x) (λ (y) (binop x y)))) (define (curry3 ternop) (λ (x) (λ (y) (λ (z) (ternop x y z))))) (define (pair-dup x) (cons x x)) (define (pair-apply f g) (λ (pair) (cons (f (car pair)) (g (cdr pair))))) (define (unpair-apply binop) (λ (pair) (binop (car pair) (cdr pair)))) ; Put your definition of mystery-composed here ;(define mystery-composed ; (o-all (list ; ... ; ))) ;; ********************************************************************** ;; Problem 4: Folding ;; ********************************************************************** ;; ---------------------------------------------------------------------- ;; Problem 4b: Put your definition of unzip here ;(define (unzip pairs) ; (foldr ; put expression 1 here ; ; put expression 2 here ; pairs)) ;; ---------------------------------------------------------------------- ;; Problem 4c: Put your definition of subsets here ;(define (subsets set) ; (foldr ; put expression 1 here ; ; put expression 2 here ; set)) ;; ********************************************************************** ;; Problem 5:Down and Up Recursion ;; ********************************************************************** ;; ---------------------------------------------------------------------- ;; Problem 5a: Put your definition of down-and-up-helper here ;(define (down-and-up nums) ; (down-and-up-helper 0 nums)) ; ;(define (down-and-up-helper sumSoFar ns) ; (if (null? ns) ; ; put expression 1 here ; ; put expression 2 here ; )) ;; ---------------------------------------------------------------------- ;; Problem 5b: Put your definition of down-and-up-foldLR below: (define (foldLR combineL state combineR nullfun xs) (if (null? xs) (nullfun state) (let ((next-state (combineL (car xs) state))) (combineR (first xs) next-state (foldLR combineL next-state combineR nullfun (rest xs)))))) ;(define (down-and-up-foldLR nums) ; (foldLR ; put expression 1 here ; ; put expression 2 here ; ; put expression 3 here ; ; put expression 4 here ; nums)) ;; ---------------------------------------------------------------------- ;; Problem 5b: Put your definition of my-foldl, my-foldr, and my-foldr-ternop below (define (my-foldl combine state xs) (foldLR ; put expression 1 here ; put expression 2 here ; put expression 3 here ; put expression 4 here xs)) (define (my-foldr combine nullval xs) (foldLR ; put expression 1 here ; put expression 2 here ; put expression 3 here ; put expression 4 here xs)) (define (my-foldr-ternop ternop nullval xs) (foldLR ; put expression 1 here ; put expression 2 here ; put expression 3 here ; put expression 4 here xs)) ;; ********************************************************************** ;; Losing your Marbles ;; ********************************************************************** ;; ---------------------------------------------------------------------- ;; Define your marbles function here: ;; ------------------------------------------------------------