#lang racket ;;; =============================== ;;; CMPU-145, Spring 2019 ;;; Lab 9 Solutions ;;; =============================== (include "biased-prob-helper.scm") (header "Lab 9" "Solutions") ;;; ============================================================= (problem "1: BIASED-TOSSER") ;;; ============================================================= ;;; BIASED-TOSSER ;;; -------------------------------------- ;;; INPUT: A list of binary digits (zeroes and ones), representing ;;; some real number B in the interval between 0 and 1 ;;; OUTPUT: 1 or 0, randomly selected to simulate the ;;; tossing of a biased coin where the probability of HEADS (i.e., 1) ;;; is equal to B. ;;; -------------------------------------- ;;; Use (RANDOM 2) to simulate the repeated tossing of a fair coin. ;;; As long as the random coin tosses (0s or 1s) exactly match the ;;; contents of INPUT-LIST, keep tossing. ;;; NOTE: If INPUT-LIST is empty, it represents an infinitely long list of zeros ;;; As soon as the random coin toss deviates from the contents of INPUT-LIST, ;;; make the Heads/Tails determination, as follows: ;;; If tossed a 1, when INPUT-LIST showed a 0 (or is empty), return 0 for TAILS ;;; Otherwise, return 1 for HEADS. (define biased-tosser (lambda (INPUT-LIST) (cond ;; Case 1: INPUT-LIST is empty (i.e., all the rest of the ;; digits are zero) ((null? INPUT-LIST) ;; Since the fair coin would eventually come out with a 1, ;; which would not match the unending list of 0s, we would ;; eventually have to report TAILS. Save time, set it now. 0) ;; Case 2: Need to toss the fair coin at least one more time (#t (let (;; RND-DIGIT: A random toss of a coin (rnd-digit (random 2)) ;; list-DIGIT: The next digit in the bias fraction (list-digit (first INPUT-LIST))) (cond ;; Recursive Case: RND-DIGIT matches first digit in INPUT-LIST ((= rnd-digit list-digit) ;; So keep tossing using (REST INPUT-LIST) (biased-tosser (rest INPUT-LIST))) ;; Base Case 1: RND-DIGIT is a ZERO (and thus list-DIGIT = 1) ((zero? rnd-digit) ;; Thus, the number we have randomly selected is < B ;; So we tossed HEADS! 1) ;; Base Case 2: RND-DIGIT is a 1 (and list-DIGIT is 0) (#t ;; Tails! 0))))))) (tester '(biased-tosser '(1 0 1))) (tester '(biased-tosser '(1 0 1))) (tester '(biased-tosser '(1 0 1))) (tester '(biased-tosser '(1 0 1))) (tester '(biased-tosser '(1 0 1))) (tester '(biased-tosser '(1 0 1))) (tester '(biased-tosser '(1 0 1))) (tester '(biased-tosser '(1 0 1))) (tester '(biased-tosser '(1 0 1))) (tester '(biased-tosser '(1 0 1))) (tester '(biased-tosser '(1 0 1))) (tester '(biased-tosser '(1 0 1))) ;;; ============================================================= (problem "2: BIAS-5-8, BIAS-3-4, BIAS-1-8, IS-ONE?") ;;; ============================================================= ;;; The LISTs of binary digits for some common fractions (define list-half '(1)) (define list-three-quarters '(1 1)) (define list-five-eighths '(1 0 1)) (define list-almost-one-third '(0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1)) ;;; The following "generate" functions take NO inputs ;;; and generate an output that is either 0 or 1 with the ;;; desired bias. ;;; BIAS-5-8: bias = 5/8 (define bias-5-8 (lambda () (biased-tosser list-five-eighths))) ;;; BIAS-3-4: bias = 3/4 (define bias-3-4 (lambda () (biased-tosser list-three-quarters))) ;;; BIAS-1-3: bias = 1/3 (approx.) (define bias-1-3 (lambda () (biased-tosser list-almost-one-third))) ;;; IS-ONE? ;;; ----------------------------- ;;; INPUT: NUM, a number ;;; OUTPUT: #t if NUM = 1; #f otherwise. (define is-one? (lambda (num) (= num 1))) (tester '(bias-3-4)) (tester '(bias-3-4)) (tester '(bias-3-4)) (tester '(bias-3-4)) (tester '(bias-3-4)) (tester '(bias-3-4)) (tester '(bias-3-4)) (tester '(bias-3-4)) (tester '(bias-3-4)) (tester '(bias-3-4)) (tester '(bias-3-4)) (tester '(bias-3-4)) (tester '(bias-3-4)) ;;; ============================================================= (problem "3: Using GEN-AND-TEST to test BIASED-TOSSER") ;;; ============================================================= (tester '(gen-and-test 10000 bias-5-8 is-one?)) (tester '(gen-and-test 10000 bias-3-4 is-one?)) (tester '(gen-and-test 10000 bias-1-3 is-one?)) (newline) (define mystery '(1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0)) (define mystery-two '(0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1)) (tester '(gen-and-test 1000000 (lambda () (biased-tosser mystery)) is-one?)) (newline) (tester '(gen-and-test 1000000 (lambda () (biased-tosser mystery-two)) is-one?)) (newline) (tester '(gen-and-test 100000 (lambda () (biased-tosser list-half)) is-one?)) ;;; ============================================================= (problem "4: Expected Number of Tosses for Biased-Tosser") ;;; ============================================================= ;;; BIASED-COUNTER ;;; ------------------------------- ;;; INPUT: INPUT-LIST, a list of 1s and 0s representing a fraction in binary ;;; OUTPUT: The number of coin tosses (i.e., 1s and 0s) that were ;;; required to generate the first deviation from the sequence of ;;; 1s and 0s in INPUT-LIST. (define biased-counter (lambda (INPUT-LIST) ;;; Just call a helper function with a counter initialized to 0 (biased-counter-helper INPUT-LIST 0))) ;;; BIASED-COUNTER-HELPER ;;; ------------------------------- ;;; INPUTS: INPUT-LIST, as above ;;; CTR, a counter ;;; OUTPUT: As above. (define biased-counter-helper (lambda (INPUT-LIST ctr) (cond ;; Case 1: INPUT-LIST is empty ((null? INPUT-LIST) ;; So we don't need to toss our fair coin any more: return CTR ctr) ;; Case 2: INPUT-LIST non-empty: need to toss at least one more time (#t (let (;; RND-DIGIT: A random coin toss (rnd-digit (random 2)) ;; list-DIGIT: The next digit in the bias fraction (list-digit (first INPUT-LIST))) (cond ;; Recursive Case: RND-DIGIT matches list-DIGIT ((= rnd-digit list-digit) ;; So keep tossing using (REST INPUT-LIST) (or () if INPUT-LIST is empty) (biased-counter-helper (rest INPUT-LIST) (+ ctr 1))) ;; Base Case: RND-DIGIT does NOT match, (#t ;; So we're done... but need to return (+ CTR 1) ;; because we DID just flip the coin! (+ ctr 1)))))))) ;;; Average the output values returned by BIASED-COUNTER. (define expected-biased-counter-value (lambda (n INPUT-LIST) (let ((accum 0)) (for ((i n)) (set! accum (+ accum (biased-counter INPUT-LIST)))) (/ accum n 1.0)))) (tester '(estimate-biased-counter-exp-value 100000 list-three-quarters)) (tester '(estimate-biased-counter-exp-value 100000 list-five-eighths)) (tester '(estimate-biased-counter-exp-value 100000 list-almost-one-third)) (printf "The limit for the number of expected tosses approaches two.")