#lang racket
;; This needs to be a relative (not absolute) path.
(require "../../refactored/common/tc-lib.rkt")
;; ___ _ _
;; / __\ |__ ___ ___| | __
;; / / | '_ \ / _ \/ __| |/ /
;; / /___| | | | __/ (__| <
;; \____/|_| |_|\___|\___|_|\_\
;;
;; _ _ _
;; ___| |__ ___ ___| | __ _____ ___ __ ___ ___| |_ ___
;; / __| '_ \ / _ \/ __| |/ /____ / _ \ \/ / '_ \ / _ \/ __| __/ __|
;; | (__| | | | __/ (__| <_____| __/> <| |_) | __/ (__| |_\__ \
;; \___|_| |_|\___|\___|_|\_\ \___/_/\_\ .__/ \___|\___|\__|___/
;; |_|
;;
;;
;; This script does the main work. It expects two arguments,
;; the path to the student's file. Output is to the screen.
;; There are some assignment specific stuff you have to specify
;; for each assignment.
;; ---- Assignment constants --------------------------------------
(define timeout 300) ;; in seconds
(define memory 500) ;; in megabytes
(define modules empty) ;(list "irisdata.rkt")) ; a list of teachpacks and files students can require
(define bonuses empty) ;'(bonus-fcn)) ; list of bonus questions
(define summary-line "Total missing")
(define debugging #f)
;; Pick the language level
(define language-level (list-ref '("htdp-beginner-reader.rkt" ;; 0
"htdp-beginner-abbr-reader.rkt" ;; 1
"htdp-intermediate-reader.rkt" ;; 2
"htdp-intermediate-lambda-reader.ss" ;; 3
"htdp-advanced-reader.rkt") ;; 4
3)) ; <------- pick a language
;; The collector to use. Note that the last option is a string -- use
;; it if you are copying a collector to this folder and modifying it
;; manually. The symbol collectors are all in the "common" folder where
;; tc-lib.rkt lives.
(define collector-file
(list-ref
(list 'common-collector-simple ;; 0 - failsafe version
'common-collector-ignore-stuff ;; 1 - probably what you want
'common-collector-count-things ;; 2 - fancy counts of functions
"collector-custom.rkt" ;; 3 - a copy of some collector in the current folder.
;; Observe that this is a string,
)
0))
;; Define structure functions. If students define structures in their code with
;; define-struct, you can put the structure functions here to get access to them.
;(get-fcns-from-eval)
;; ---- Function parameter checking ------------------------------------
;; These functions check if the student's test case use valid inputs.
;; They consume something like '(fcn input1 input2 ... inputn)
;; They produce true if the inputs are valid (ie satisfy the contract of fcn,
;; according to the question.)
;; NOTE: If you're using Beginning student, then structure functions
;; like posn? won't work in these functions. In this case, just use struct?
;; helper for checking valid
(define (nested-list? lst)
(cond
[(empty? lst) true]
[(and (list? lst) (list? (first lst)) (nested-list? (first lst))) (nested-list? (rest lst))]
[else (nested-list? (rest lst))]))
(define (nested-nums? lst)
(cond
[(empty? lst) true]
[(and (list? lst) (list? (first lst)) (nested-nums? (first lst))) (nested-nums? (rest lst))]
[(number? (first lst)) (nested-nums? (rest lst))]
[else false]))
;; Question 3a
(define (super-foldr/valid? fcn-app)
(and (= 4 (length fcn-app))
(equal? (first fcn-app) 'super-foldr)
(procedure? (second fcn-app))
(nested-list? (fourth fcn-app))))
;; Question 3b
(define (magnitudes/valid? fcn-app)
(and (= 2 (length fcn-app))
(equal? (first fcn-app) 'magnitudes)
(nested-nums? (second fcn-app))))
;; Question 3c
(define (super-filter/valid? fcn-app)
(and (= 3 (length fcn-app))
(equal? (first fcn-app) 'super-filter)
(procedure? (second fcn-app))
(nested-list? (third fcn-app))))
;; Add questions so the script knows about them. In the output,
;; the order will be the same as the order listed here.
(add-questions
(list (list 'super-foldr "Question 5a: super-foldr" super-foldr/valid? "Q5a: Tests/Cases")
(list 'magnitudes "Question 5b: magnitudes" magnitudes/valid? "Q5b: Tests/Cases")
(list 'super-filter "Question 5c: super-filter" super-filter/valid? "Q5c: Tests/Cases")
))
(set-black-highlighting-category-name "Q5: Tests/Highlighting")
;; ---- UTILITY ------------------------------------------------------------------
;; You can put the solutions and other helper functions you need here.
(define (has-pos lst)
(cond
[(empty? lst) false]
[(list? (first lst)) (or (has-pos (first lst)) (has-pos (rest lst)))]
[(positive? (first lst)) true]
[else (has-pos (rest lst))]))
(define (has-neg lst)
(cond
[(empty? lst) false]
[(list? (first lst)) (or (has-neg (first lst)) (has-neg (rest lst)))]
[(negative? (first lst)) true]
[else (has-neg (rest lst))]))
(define (at-least-one-doesnot? pred? lst)
(cond [(empty? lst) false]
[(list? (first lst)) (or (at-least-one-doesnot? pred? (first lst))
(at-least-one-doesnot? pred? (rest lst)))]
[(not (pred? (first lst))) true]
[else (at-least-one-doesnot? pred? (rest lst))]))
(define (at-least-one? pred? lst)
(cond [(empty? lst) false]
[(list? (first lst)) (or (at-least-one? pred? (first lst))
(at-least-one? pred? (rest lst)))]
[(pred? (first lst)) true]
[else (at-least-one? pred? (rest lst))]))
(define (nested-level>2? lst)
(cond [(empty? lst) false]
[(list? (first lst)) true]
[else (nested-level>2? (rest lst))]))
(define (one-in-nested? pred? lst ifnested)
(cond [(empty? lst) false]
[(list? (first lst)) (or (one-in-nested? pred? (first lst) true)
(one-in-nested? pred? (rest lst) ifnested))]
[(and (pred? (first lst)) ifnested) true]
[else (one-in-nested? pred? (rest lst) ifnested)]))
(define (one-in-nested-doesnot? pred? lst ifnested)
(cond [(empty? lst) false]
[(list? (first lst)) (or (one-in-nested-doesnot? pred? (first lst) true)
(one-in-nested-doesnot? pred? (rest lst) ifnested))]
[(and (not (pred? (first lst))) ifnested) true]
[else (one-in-nested-doesnot? pred? (rest lst) ifnested)]))
;; ---- HELPER FOR TEST CASES ------------------------------------------------------
;; helper for q5a
;; helper for q5b
;; helper for q5c
;; ---- TEST CASES ------------------------------------------------------------------
;; 5a
(add 'super-foldr
(list (make-tc "Missing test where the list is empty"
(lambda (f s lst) (empty? lst)))
(make-tc "Missing test where the list contains a nested list"
(lambda (f s lst) (nested-level>2? lst)))))
;; 5b
(add 'magnitudes
(list (make-tc "Missing test where the list is empty"
(lambda (lst) (empty? lst)))
(make-tc "Missing test where the list contans at least one positive number"
(lambda (lst) (has-pos lst)))
(make-tc "Missing test where the list contains at least one negative number"
(lambda (lst) (has-neg lst)))
(make-tc "Missing test where the list contains a nested list"
(lambda (lst) (nested-level>2? lst)))))
;; 5c
(add 'super-filter
(list (make-tc "Missing test where the list is empty"
(lambda (pred? lst) (empty? lst)))
(make-tc "Missing test where at least one element in the list does not satisfy the pred?"
(lambda (pred? lst) (at-least-one-doesnot? pred? lst)))
(make-tc "Missing test where at least one element in the list satisfies the pred?"
(lambda (pred? lst) (at-least-one? pred? lst)))
(make-tc "Missing test where at least one nested element in the list does not satisfy the pred?"
(lambda (pred? lst) (one-in-nested-doesnot? pred? lst false)))
(make-tc "Missing test where at least one nested element in the list satisfies the pred?"
(lambda (pred? lst) (one-in-nested? pred? lst false)))))
;;
;; ---------------------------------------------------------------- END ASSIGNMENT SPECIFIC SECTION
;; You shouldn't need to edit anything below this line.
;;
(run-checker timeout memory modules bonuses summary-line language-level debugging collector-file
(current-directory)
(path->string (this-expression-source-directory)))