#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 ;; nat?: any->bool (define (nat? x) (and (integer? x) (>= x 0))) ;;bin-string? str takes a list of chars (define (bin-string? str) (cond [(empty? str) true] [(or (char=? #\0 (first str)) (char=? #\1 (first str))) (bin-string? (rest str))] [else false])) ;; list-num? : list -> bool (define (list-num? lst) (cond [(empty? lst) true] [(number? (first lst)) true] [else (list-num? (rest lst))])) ;; list-string? : list -> bool (define (list-string? lst) (andmap string? lst)) ;; list-int? : list -> bool (define (list-int? lst) (andmap integer? lst)) ;; Question 3a (define (parity/valid? fcn-app) (and (= 2 (length fcn-app)) (equal? (first fcn-app) 'parity) (and (string? (second fcn-app)) (bin-string? (string->list (second fcn-app)))))) ;; Question 3b (define (replace-word/valid? fcn-app) (and (= 4 (length fcn-app)) (equal? (first fcn-app) 'replace-word) (string? (second fcn-app)) (string? (third fcn-app)) (and (list? (fourth fcn-app)) (list-string? (fourth fcn-app))))) ;; Question 3c (define (all-factors/valid? fcn-app) (and (= 2 (length fcn-app)) (equal? (first fcn-app) 'all-factors) (nat? (second fcn-app)))) ;; Question 3d (define (mean-relative/valid? fcn-app) (and (= 2 (length fcn-app)) (equal? (first fcn-app) 'mean-relative) (and (list? (second fcn-app)) (list-int? (second 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 'parity "Question 2a: parity" parity/valid? "Q2a: Tests/Cases") (list 'replace-word "Question 2b: replace-word" replace-word/valid? "Q2b: Tests/Cases") (list 'all-factors "Question 2c: all-factors" all-factors/valid? "Q2c: Tests/Cases") (list 'mean-relative "Question 2d: mean-relative" mean-relative/valid? "Q2d: Tests/Cases") )) (set-black-highlighting-category-name "Q2: Tests/Highlighting") ;; ---- UTILITY ------------------------------------------------------------------ ;; You can put the solutions and other helper functions you need here. (define (parity str) (cond [(even? (foldr (lambda (frst rror) (cond [(char=? #\0 frst) rror] [else (add1 rror)])) 0 (string->list str))) 'even] [else 'odd])) (define (replace-word old new los) (map (lambda (frst) (cond [(string=? frst old) new] [else frst])) los)) (define (all-factors n) (cond [(zero? n) empty] [else (filter (lambda (i) (zero? (remainder n i))) (build-list (sub1 n) add1))])) (define (mean-relative lon) (cond [(empty? lon) empty] [else (local [(define mean (/ (foldr + 0 lon) (length lon)))] (map (lambda (n) (cond [(= n mean) 'mean] [(< n mean) 'below-mean] [else 'above-mean])) lon))])) ;; ---- HELPER FOR TEST CASES ------------------------------------------------------ ;; helper for q5a ;; helper for q5b ;; helper for q5c ;; ---- TEST CASES ------------------------------------------------------------------ ;; 2a (add 'parity (list (make-tc "Missing test where there's an even amount of 1's" (lambda (str) (equal? (parity str) 'even))) (make-tc "Missing test where there's an odd amount of 1's" (lambda (str) (equal? (parity str) 'odd))))) ;; 2b (add 'replace-word (list (make-tc "Missing test that contains the string to be replaced" (lambda (w1 w2 lst) (cons? (member w1 lst)))) (make-tc "Missing test that replaces the string multiple times" (lambda (w1 w2 lst) (and (cons? (member w1 lst)) (cons? (member w1 (rest (member w1 lst))))))))) ;; 2c (add 'all-factors (list (make-tc "Missing test where n is zero" (lambda (n) (zero? n))) (make-tc "Missing test where n is one" (lambda (n) (= 1 n))) (make-tc "Missing test where n is composite" (lambda (n) (and (> n 1) (> (length (all-factors n)) 1)))) (make-tc "Missing test where n is prime" (lambda (n) (and (> n 1) (= (length (all-factors n)) 1)))))) ;; 2d (add 'mean-relative (list (make-tc "Missing test that contains a 'below-mean" (lambda (lst) (cons? (member 'below-mean (mean-relative lst))))) (make-tc "Missing test that contains a 'mean" (lambda (lst) (cons? (member 'mean (mean-relative lst))))) (make-tc "Missing test that contains an 'above-mean" (lambda (lst) (cons? (member 'above-mean (mean-relative lst))))))) ;; ;; ---------------------------------------------------------------- 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)))