Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Nearly done with d release

  • Loading branch information...
commit 28ef43bdcd1b0ba5ccf18077a6dfaa8b0dc90ece 1 parent ff4df57
@marick authored
Showing with 823 additions and 122 deletions.
  1. +5 −0 scheduling/.gitignore
  2. +2 −0  scheduling/.rvmrc
  3. +7 −0 scheduling/Gemfile
  4. +26 −0 scheduling/Gemfile.lock
  5. +49 −0 scheduling/Rakefile
  6. +66 −0 scheduling/migrations/001_create.rb
  7. +40 −0 scheduling/ruby-fetching-example.rb
  8. +5 −20 solutions/arrows.clj
  9. +37 −0 solutions/function-monads.clj
  10. +17 −10 solutions/higher-order-functions.clj
  11. +8 −4 solutions/pieces/{higher-order-functions-1-6.clj → higher-order-functions-1-7.clj}
  12. +15 −0 solutions/pieces/higher-order-functions-8-9.clj
  13. +0 −15 solutions/pieces/higher-order-functions-9.clj
  14. +11 −14 solutions/pieces/higher-order-functions-a.clj
  15. +15 −6 solutions/pieces/higher-order-functions-b.clj
  16. +61 −0 solutions/scheduling.clj
  17. +24 −18 solutions/sequence-m.clj
  18. +107 −0 sources/function-monads.clj
  19. +87 −0 sources/scheduling.clj
  20. +18 −18 sources/sequence-m.clj
  21. +11 −17 test/solutions/t_higher_order_functions.clj
  22. +7 −0 test/solutions/ts_function_monads.clj
  23. +33 −0 test/solutions/ts_scheduling.clj
  24. +54 −0 test/solutions/ts_sequence_m.clj
  25. +88 −0 test/sources/t_scheduling.clj
  26. +30 −0 test/sources/t_sequence_m.clj
View
5 scheduling/.gitignore
@@ -0,0 +1,5 @@
+.bundle
+.jhw-cache
+spec/*.js
+src/coffee/*.js
+TAGS
View
2  scheduling/.rvmrc
@@ -0,0 +1,2 @@
+rvm_install_on_use_flag=1
+rvm --create use ruby-1.9.3
View
7 scheduling/Gemfile
@@ -0,0 +1,7 @@
+source :rubygems
+
+gem "sequel"
+gem "pg"
+gem "json"
+gem "shoulda"
+
View
26 scheduling/Gemfile.lock
@@ -0,0 +1,26 @@
+GEM
+ remote: http://rubygems.org/
+ specs:
+ activesupport (3.2.8)
+ i18n (~> 0.6)
+ multi_json (~> 1.0)
+ i18n (0.6.0)
+ json (1.7.4)
+ multi_json (1.3.6)
+ pg (0.14.0)
+ sequel (3.38.0)
+ shoulda (3.1.1)
+ shoulda-context (~> 1.0)
+ shoulda-matchers (~> 1.2)
+ shoulda-context (1.0.0)
+ shoulda-matchers (1.2.0)
+ activesupport (>= 3.0.0)
+
+PLATFORMS
+ ruby
+
+DEPENDENCIES
+ json
+ pg
+ sequel
+ shoulda
View
49 scheduling/Rakefile
@@ -0,0 +1,49 @@
+require 'rake'
+
+require 'rubygems'
+require 'sequel'
+require 'sequel/extensions/migration'
+
+DB = Sequel.postgres("fpoo", :host => 'localhost')
+
+
+desc "migrate from FROM to TO (both are optional)"
+task :migrate do
+ migrate(i_or_nil('TO'), i_or_nil('FROM'))
+end
+
+desc "show current migration version"
+task :migration_version do
+ puts Sequel::Migrator.get_current_migration_version(DB)
+end
+
+desc "make current migration version TO without actually running the migrations"
+task :set_migration_version do
+ Sequel::Migrator.set_current_migration_version(DB, i('TO'))
+ system('rake migration_version')
+end
+
+def migrate(to=nil, from = nil)
+ puts "Migrate from #{from.inspect} to #{to.inspect}."
+ Sequel::Migrator.apply(DB, 'migrations', to, from)
+end
+
+def i(name)
+ i_with_nil(name) do
+ STDERR.puts("#{name} must be given.")
+ exit 1
+ end
+end
+
+def i_or_nil(name)
+ i_with_nil(name) do
+ nil
+ end
+end
+
+def i_with_nil(name)
+ value = ENV[name]
+ return yield if value.nil?
+ value.to_i
+end
+
View
66 scheduling/migrations/001_create.rb
@@ -0,0 +1,66 @@
+require 'pp'
+
+class Creation < Sequel::Migration
+
+ def up
+ puts "==== Creating tables"
+ DB.create_table :course_templates do
+ primary_key :id
+ String :name
+ int :limit
+ String :description
+ end
+
+ zigging = DB[:course_templates].insert(:name => "Zigging", :limit => 4, :description => "About zigging")
+ zagging = DB[:course_templates].insert(:name => "Zagging", :limit => 2, :description => "About zagging")
+
+ pp DB[:course_templates].all
+
+ DB.create_table :courses do
+ primary_key :id
+ foreign_key :course_template_id, :course_templates
+ bool :morning
+ end
+
+ zig_morning = DB[:courses].insert(:course_template_id => zigging, :morning => true)
+ zig_afternoon = DB[:courses].insert(:course_template_id => zigging, :morning => false)
+ zag_morning = DB[:courses].insert(:course_template_id => zagging, :morning => true)
+ zag_afternoon = DB[:courses].insert(:course_template_id => zagging, :morning => false)
+
+ pp DB[:courses].all
+
+ DB.create_table :registrants do
+ primary_key :id
+ String :name
+ end
+
+ dawn = DB[:registrants].insert(:name => "Dawn")
+ paul = DB[:registrants].insert(:name => "Paul")
+ sophie = DB[:registrants].insert(:name => "Sophie")
+
+ pp DB[:registrants].all
+
+ DB.create_table :signups do
+ primary_key :id
+ foreign_key :registrant_id, :registrants
+ foreign_key :course_id, :courses
+ end
+
+ DB[:signups].insert(:registrant_id => dawn, :course_id => zig_afternoon)
+ DB[:signups].insert(:registrant_id => paul, :course_id => zig_afternoon)
+ DB[:signups].insert(:registrant_id => sophie, :course_id => zag_morning)
+ DB[:signups].insert(:registrant_id => paul, :course_id => zag_afternoon)
+
+ pp DB[:signups].all
+
+ end
+
+
+ def down
+ puts "==== Dropping all tables"
+ DB.drop_table :course_templates
+ DB.drop_table :courses
+ DB.drop_table :registrants
+ DB.drop_table :signups
+ end
+end
View
40 scheduling/ruby-fetching-example.rb
@@ -0,0 +1,40 @@
+require 'rubygems'
+require 'sequel'
+require 'pp'
+require 'shoulda'
+require 'set'
+
+DB = Sequel.connect('postgres://postgres@localhost/fpoo')
+
+class FetchingExample < Test::Unit::TestCase
+
+ should "be able to fetch a map of courses" do
+ registration_counts = DB[:courses].
+ left_join(:signups, :signups__course_id => :courses__id).
+ group(:courses__id).
+ select(:courses__id.as(:course_id)).
+ select_more{count(:signups__id).as(:registered)}
+
+ courses = DB[:courses].
+ join(registration_counts, :course_id => :courses__id).
+ join(:course_templates, :course_templates__id => :courses__course_template_id).
+ select(:course_templates__name.as("course-name"),
+ :courses__morning.as("morning?"),
+ :limit,
+ :registered)
+
+ # puts courses.sql
+ pp courses.all
+
+ actual = Set.new(courses.all)
+
+ assert_equal(Set.new([
+ {:"course-name" => "Zigging", :morning? => true, :limit => 4, :registered => 0},
+ {:"course-name" => "Zigging", :morning? => false, :limit => 4, :registered => 2},
+ {:"course-name" => "Zagging", :morning? => true, :limit => 2, :registered => 1},
+ {:"course-name" => "Zagging", :morning? => false, :limit => 2, :registered => 1}]),
+ actual)
+ end
+
+end
+
View
25 solutions/arrows.clj
@@ -8,26 +8,11 @@
;;; Exercise 3
-;; It doesn't work because (-> [1 2 3 4] (partial map inc)) is the
-;; equivalent to this form:
-;;
-;; (partial [1 2 3 4] map inc)
-;;
-;; Interestingly, this doesn't blow up because (1) `partial` doesn't check that
-;; its first argument is a callable and (2) even if it did, vectors are callables.
-;;
-;; To solve the problem, you need an extra set of parentheses to produce a
-;; space for the vector to go:
-
- (-> [1 2 3 4]
- ( (partial map inc) ))
-
-;;; Exercise 4
-
-;; Again, an extra pair of parentheses is needed to "protect" the `fn` from `->`:
-
-(-> [1 2 3 4]
- ( (fn [sequence] (map inc sequence)) ))
+;; An extra pair of parentheses is needed to "protect" the `fn` from `->`:
+
+(-> 3
+ ((fn [n] (* 2 n)))
+ inc)
;;; Exercise 5
View
37 solutions/function-monads.clj
@@ -0,0 +1,37 @@
+(use 'clojure.algo.monads)
+
+
+(use '[clojure.pprint :only [cl-format]])
+
+(def verbose-charging-monad-alternate-inc
+ (monad [m-result
+ (fn [result]
+ (cl-format true "Freezing ~A.~%" result)
+ (fn [charge]
+ (cl-format true "Unfrozen calculation gets charge ~A.~%" charge)
+ (cl-format true "... The frozen calculation result was ~A.~%" result)
+ {:charge (inc charge), :result result})) ;; <<== change
+
+ m-bind
+ (fn [monadic-value continuation]
+ (cl-format true "Making a decision.~%")
+ (fn [charge]
+ (let [enclosed-map (monadic-value charge)
+ binding-value (:result enclosed-map)]
+ (cl-format true "Calling continuation with ~A~%" binding-value)
+ (cl-format true "... The charge to increment is ~A~%", charge)
+ ( (continuation binding-value) charge))))])) ;; <<== change
+
+(println "==========")
+(println "Defining run-and-charge.")
+
+(def run-and-charge-and-speak
+ (with-monad verbose-charging-monad-alternate-inc
+ (let [frozen-step m-result]
+ (domonad [a (frozen-step 8)
+ b (frozen-step (+ a 88))]
+ (+ a b)))))
+
+(println "-----------")
+(println "Running run-and-charge.")
+
View
27 solutions/higher-order-functions.clj
@@ -8,12 +8,16 @@
;;; 2
+(def separate (juxt filter remove))
+
+;;; 3
+
; x ;;; produces an error
; (myfun) ;;; produces 3.
;; By substitution, x is replaced by 3 inside the body of the let.
-;;; 3
+;;; 4
(def myfun
( (fn [x]
@@ -21,7 +25,7 @@
3))
-;;; 4
+;;; 5
(def make-sender
(fn [target-finder]
@@ -32,22 +36,25 @@
(def send-to (make-sender class-from-instance))
(def send-super (make-sender superclass-from-instance))
-;;; 5
+;;; 6
(def my-atom (atom 0))
(swap! my-atom (fn [anything] 33))
-(swap! my-atom (constantly 34))
-
-;;; 6
+;;; 7
(def always
(fn [value]
(fn [& anything] value)))
+(swap! my-atom (always 8))
+;; or
-;;; 7
+(swap! my-atom (constantly 8))
+
+
+;;; 8
(def check-sum
(fn [sequence]
@@ -55,14 +62,14 @@
(range 1 (inc (count sequence)))
sequence))))
-;;; 8
+;;; 9
(def isbn?
(fn [candidate]
(zero? (rem (check-sum (reversed-digits candidate)) 11))))
-;;; 9
+;;; 10
(def check-sum
(fn [sequence]
@@ -77,7 +84,7 @@
(zero? (rem (check-sum (reversed-digits candidate)) 10))))
-;;; 10
+;;; 11
(def number-checker
(fn [digit-function divisor]
View
12 solutions/pieces/higher-order-functions-1-6.clj → solutions/pieces/higher-order-functions-1-7.clj
@@ -8,12 +8,16 @@
;;; 2
+(def separate (juxt filter remove))
+
+;;; 3
+
; x ;;; produces an error
; (myfun) ;;; produces 3.
;; By substitution, x is replaced by 3 inside the body of the let.
-;;; 3
+;;; 4
(def myfun
( (fn [x]
@@ -21,7 +25,7 @@
3))
-;;; 4
+;;; 5
(def make-sender
(fn [target-finder]
@@ -32,12 +36,12 @@
(def send-to (make-sender class-from-instance))
(def send-super (make-sender superclass-from-instance))
-;;; 5
+;;; 6
(def my-atom (atom 0))
(swap! my-atom (fn [anything] 33))
-;;; 6
+;;; 7
(def always
(fn [value]
View
15 solutions/pieces/higher-order-functions-8-9.clj
@@ -0,0 +1,15 @@
+
+;;; 8
+
+(def check-sum
+ (fn [sequence]
+ (apply + (map *
+ (range 1 (inc (count sequence)))
+ sequence))))
+
+;;; 9
+
+(def isbn?
+ (fn [candidate]
+ (zero? (rem (check-sum (reversed-digits candidate)) 11))))
+
View
15 solutions/pieces/higher-order-functions-9.clj
@@ -1,15 +0,0 @@
-
-;;; 9
-
-(def check-sum
- (fn [sequence]
- (apply + (map (fn [position digit]
- (* digit (if (odd? position) 1 3)))
- (range 1 (inc (count sequence)))
- sequence))))
-
-
-(def upc?
- (fn [candidate]
- (zero? (rem (check-sum (reversed-digits candidate)) 10))))
-
View
25 solutions/pieces/higher-order-functions-a.clj
@@ -1,18 +1,15 @@
;;; 10
-(def number-checker
- (fn [digit-function divisor]
- (fn [candidate]
- (let [digits (reversed-digits candidate)
- check-sum (apply +
- (map digit-function
- (range 1 (inc (count digits)))
- digits))]
- (zero? (rem check-sum divisor))))))
+(def check-sum
+ (fn [sequence]
+ (apply + (map (fn [position digit]
+ (* digit (if (odd? position) 1 3)))
+ (range 1 (inc (count sequence)))
+ sequence))))
+
+
+(def upc?
+ (fn [candidate]
+ (zero? (rem (check-sum (reversed-digits candidate)) 10))))
-(def isbn? (number-checker * 11))
-(def upc? (number-checker
- (fn [position digit] (* digit (if (odd? position) 1 3)))
- 10))
-
View
21 solutions/pieces/higher-order-functions-b.clj
@@ -1,9 +1,18 @@
;;; 11
-(def lift
- (fn [function-to-compose-with-another]
- (fn [function-whose-return-value-should-be-changed]
- (fn [& args]
- (function-to-compose-with-another
- (apply function-whose-return-value-should-be-changed args))))))
+(def number-checker
+ (fn [digit-function divisor]
+ (fn [candidate]
+ (let [digits (reversed-digits candidate)
+ check-sum (apply +
+ (map digit-function
+ (range 1 (inc (count digits)))
+ digits))]
+ (zero? (rem check-sum divisor))))))
+
+(def isbn? (number-checker * 11))
+(def upc? (number-checker
+ (fn [position digit] (* digit (if (odd? position) 1 3)))
+ 10))
+
View
61 solutions/scheduling.clj
@@ -0,0 +1,61 @@
+;;; Exercise 1
+
+(def remove-full
+ (fn [courses]
+ (remove (fn [course]
+ (zero? (:spaces-left course)))
+ courses)))
+
+;;; Exercise 2
+
+(def remove-unbookable
+ (fn [courses instructor-count]
+ (let [registrants?
+ (fn [course] (not (zero? (:registered course))))
+
+ with-registrants (filter registrants? courses)
+ without-registrants (remove registrants? courses)]
+
+ (prn "++++++++++++++++++++")
+ (clojure.pprint/pprint with-registrants)
+ (clojure.pprint/pprint without-registrants)
+ (if (< (count with-registrants) instructor-count)
+ courses
+ with-registrants))))
+
+;;; Exercise 3
+
+(use 'clojure.set)
+
+(def add-back-already-in
+ (fn [courses original-courses]
+ (prn "================")
+ (clojure.pprint/pprint courses)
+ (clojure.pprint/pprint original-courses)
+ (clojure.pprint/pprint (filter :already-in? original-courses))
+
+ (union (set courses)
+ (set (filter :already-in? original-courses)))))
+
+;;; Exercise 4
+
+;;; I have two solutions, one using `=`, one using a set.
+
+(def asserty-add-back-already-in-1
+ (fn [courses original-courses]
+ (let [keys (map set (map keys (concat courses original-courses)))]
+ (assert (apply = keys)))
+ (add-back-already-in courses original-courses)))
+
+;;; Notice that I use (map set (map keys ...)) instead of
+;;; (map (fn [course] (set (keys course))) ...)
+;;;
+;;; That might seem excessively inefficient---two list traversals instead of one. In fact,
+;;; though, as you'll see in the chapter on Laziness, it really gets compiled into a single
+;;; list traversal.
+
+(def asserty-add-back-already-in-2
+ (fn [courses original-courses]
+ (let [keys (map set (map keys (concat courses original-courses)))]
+ (assert (= 1 (count (set keys)))))
+ (add-back-already-in courses original-courses)))
View
42 solutions/sequence-m.clj
@@ -1,42 +1,48 @@
;;; Exercise 1
(def multiples
- (fn [n] (range (* n 2) 100 n)))
+ (fn [n] (range (* n 2) 101 n)))
;;; Exercise 2
(use 'clojure.algo.monads)
-(with-monad sequence-m
- (domonad [i (range 2 11) ; You only need to try up to the square root of 100.
- nonprimes (multiples i)]
- nonprimes))
+
+(def nonprimes
+ (with-monad sequence-m
+ (domonad [i (range 2 11) ; You only need to try up to the square root of 100.
+ nonprimes (multiples i)]
+ nonprimes)))
;;; Exercise 3
-(def nonprimes
- (set (with-monad sequence-m
- (domonad [i (range 2 11)
- nonprimes (multiples i)]
- nonprimes))))
-(pprint (remove nonprimes (range 2 100)))
+(def primes
+ (remove (set nonprimes) (range 2 101)))
+(prn "Behold! Primes:")
+(prn primes)
;;; Exercise 4
-(def monadifier list)
+(def combined-monadifier list)
-(def decider
+(def combined-decider
(fn [monadic-value continuation]
(let [maybe-ified-continuation
(fn [binding-value]
(if (nil? binding-value)
- (monadifier binding-value)
+ (combined-monadifier binding-value)
(continuation binding-value)))]
- (apply concat (map maybe-ified-continuation monadic-value)))))
+ (mapcat maybe-ified-continuation monadic-value))))
+
+(defmonad combined-monad
+ [m-result combined-monadifier
+ m-bind combined-decider])
-(defmonad maybe-sequence-monad
- [m-result monadifier
- m-bind decider])
+(prn
+ (with-monad combined-monad
+ (domonad [a [1 nil 3]
+ b [-1 1]]
+ (* a b))))
View
107 sources/function-monads.clj
@@ -0,0 +1,107 @@
+(use 'clojure.algo.monads)
+
+(def function-monad
+ (monad [m-result
+ (fn [binding-value]
+ (fn [] binding-value))
+
+ m-bind
+ (fn [monadic-value continuation]
+ (let [binding-value (monadic-value)]
+ (continuation binding-value)))]))
+
+(def calculation
+ (with-monad function-monad
+ (let [frozen-step m-result]
+ (domonad [a (frozen-step 8)
+ b (frozen-step (+ a 88))]
+ (+ a b)))))
+
+
+;;;; Charging monad
+
+(def charging-monad
+ (monad [m-result
+ (fn [result]
+ (fn [charge]
+ {:charge charge, :result result}))
+
+ m-bind
+ (fn [monadic-value continuation]
+ (fn [charge]
+ (let [enclosed-map (monadic-value charge)
+ binding-value (:result enclosed-map)]
+ ( (continuation binding-value)
+ (inc charge)))))]))
+
+(def run-and-charge
+ (with-monad charging-monad
+ (let [frozen-step m-result]
+ (domonad [a (frozen-step 8)
+ b (frozen-step (+ a 88))]
+ (+ a b)))))
+
+
+
+
+(use '[clojure.pprint :only [cl-format]])
+
+(def verbose-charging-monad
+ (monad [m-result
+ (fn [result]
+ (cl-format true "Freezing ~A.~%" result)
+ (fn [charge]
+ (cl-format true "Unfrozen calculation gets charge ~A.~%" charge)
+ (cl-format true "... The frozen calculation result was ~A.~%" result)
+ {:charge charge, :result result}))
+
+ m-bind
+ (fn [monadic-value continuation]
+ (cl-format true "Making a decision.~%")
+ (fn [charge]
+ (let [enclosed-map (monadic-value charge)
+ binding-value (:result enclosed-map)]
+ (cl-format true "Calling continuation with ~A~%" binding-value)
+ (cl-format true "... The charge to increment is ~A~%", charge)
+ ( (continuation binding-value)
+ (inc charge)))))]))
+
+(println "==========")
+(println "Defining run-and-charge.")
+
+(def run-and-charge-and-speak
+ (with-monad verbose-charging-monad
+ (let [frozen-step m-result]
+ (domonad [a (frozen-step 8)
+ b (frozen-step (+ a 88))]
+ (+ a b)))))
+
+(println "-----------")
+(println "Running run-and-charge.")
+
+;;; State monad
+
+(def state-monad
+ (monad [m-result
+ (fn [result]
+ (fn [state]
+ {:state state, :result result}))
+
+ m-bind
+ (fn [monadic-value continuation]
+ (fn [state]
+ (let [enclosed-map (monadic-value state)
+ binding-value (:result enclosed-map)
+ new-state (:state enclosed-map)]
+ ( (continuation binding-value) new-state))))]))
+
+(def get-state
+ (fn []
+ (fn [state]
+ {:state state, :result state})))
+
+
+(def assign-state
+ (fn [new-state]
+ (fn [state]
+ {:state new-state, :result state})))
View
87 sources/scheduling.clj
@@ -0,0 +1,87 @@
+(def answer-annotations
+ (fn [courses registrants-courses]
+ (let [checking-set (set registrants-courses)]
+ (map (fn [course]
+ (assoc course
+ :spaces-left (- (:limit course)
+ (:registered course))
+ :already-in? (contains? checking-set
+ (:course-name course))))
+ courses))))
+
+(def domain-annotations
+ (fn [courses]
+ (map (fn [course]
+ (assoc course
+ :empty? (zero? (:registered course))
+ :full? (zero? (:spaces-left course))))
+ courses)))
+
+(def note-unavailability
+ (fn [courses instructor-count]
+ (let [out-of-instructors?
+ (= instructor-count
+ (count (filter (fn [course] (not (:empty? course)))
+ courses)))]
+ (map (fn [course]
+ (assoc course
+ :unavailable? (or (:full? course)
+ (and out-of-instructors?
+ (:empty? course)))))
+ courses))))
+
+(def annotate
+ (fn [courses registrants-courses instructor-count]
+ (note-unavailability (domain-annotations
+ (answer-annotations courses registrants-courses))
+ instructor-count)))
+
+(def annotate
+ (fn [courses registrants-courses instructor-count]
+ (let [answers (answer-annotations courses registrants-courses)
+ domain (domain-annotations answers)]
+ note-unavailability domain instructor-count)))
+
+(def annotate
+ (fn [courses registrants-courses instructor-count]
+ (-> courses
+ (answer-annotations registrants-courses)
+ domain-annotations
+ (note-unavailability instructor-count))))
+
+
+
+
+(def separate
+ (fn [pred sequence]
+ [(filter pred sequence) (remove pred sequence)]))
+
+
+(def visible-courses
+ (fn [courses]
+ (let [[guaranteed possibles] (separate :already-in? courses)]
+ (concat guaranteed (remove :unavailable? possibles)))))
+
+(def final-shape
+ (fn [courses]
+ (let [desired-keys [:course-name :morning? :registered :spaces-left :already-in?]]
+ (map (fn [course]
+ (select-keys course desired-keys))
+ courses))))
+
+
+
+(def half-day-solution
+ (fn [courses registrants-courses instructor-count]
+ (-> courses
+ (annotate registrants-courses instructor-count)
+ visible-courses
+ ((fn [courses] (sort-by :course-name courses)))
+ final-shape)))
+
+(def solution
+ (fn [courses registrants-courses instructor-count]
+ (map (fn [courses]
+ (half-day-solution courses registrants-courses instructor-count))
+ (separate :morning? courses))))
+
View
36 sources/sequence-m.clj
@@ -1,25 +1,25 @@
(use 'clojure.algo.monads)
-(def decider
+(def sequence-monad-decider
(fn [step-value continuation]
- (apply concat
- (map continuation step-value))))
+ (mapcat continuation step-value)))
-(def monadifier list)
+(def sequence-monad-monadifier list)
-(def nested-loop-monad
- (monad [m-result monadifier
- m-bind decider ]))
+(def sequence-monad
+ (monad [m-result sequence-monad-monadifier
+ m-bind sequence-monad-decider]))
-(with-monad nested-loop-monad
- (domonad [a [1 2]
- b [10, 100]
- c [-1 1]]
- (* a b c)))
+(prn
+ (with-monad sequence-monad
+ (domonad [a [1 2]
+ b [10, 100]
+ c [-1 1]]
+ (* a b c))))
-
-(with-monad nested-loop-monad
- (domonad [a (list 1 2 3)
- b (list (- a) a)
- c (list (+ a b) (- a b))]
- (* a b c)))
+(prn
+ (with-monad sequence-monad
+ (domonad [a (list 1 2 3)
+ b (list (- a) a)
+ c (list (+ a b) (- a b))]
+ (* a b c))))
View
28 test/solutions/t_higher_order_functions.clj
@@ -5,7 +5,7 @@
(load-file "solutions/without-klass.clj")
-(load-file "solutions/pieces/higher-order-functions-1-6.clj")
+(load-file "solutions/pieces/higher-order-functions-1-7.clj")
;;; 1
@@ -13,7 +13,11 @@
variant1 => [3 4 5]
variant2 => [3 4 5])
-;;; 2
+;;; 2
+
+(fact (separate odd? [1 2 3 4 5]) => [ [1 3 5] [2 4]])
+
+;;; 3
(def myfun-from-book
(let [x 3]
@@ -21,11 +25,11 @@
(fact (myfun-from-book) => 3)
-;;; 3
+;;; 4
(fact (myfun) => 3)
-;;; 4
+;;; 5
(def point (send-to Point :new 1 2))
(def a (send-to Anything :new))
@@ -42,21 +46,21 @@
(fact ( (always 1) 8 8 8) => 1)
(load-file "sources/higher-order-functions.clj")
-(load-file "solutions/pieces/higher-order-functions-7-8.clj")
+(load-file "solutions/pieces/higher-order-functions-8-9.clj")
(fact
(isbn? "0131774115") => truthy
(isbn? "0977716614") => falsey
(isbn? "1934356190") => truthy)
-(load-file "solutions/pieces/higher-order-functions-9.clj")
+(load-file "solutions/pieces/higher-order-functions-a.clj")
(fact
(upc? "074182265830") => truthy
(upc? "731124100023") => truthy
(upc? "722252601404") => falsey)
-(load-file "solutions/pieces/higher-order-functions-a.clj")
+(load-file "solutions/pieces/higher-order-functions-b.clj")
(fact
(isbn? "0131774115") => truthy
@@ -66,13 +70,3 @@
(upc? "731124100023") => truthy
(upc? "722252601404") => falsey)
-(load-file "solutions/pieces/higher-order-functions-b.clj")
-
-(def complement* (lift not))
-(def negativize (lift -))
-(def triplize (lift (partial * 3)))
-
-(fact
- ( (complement* even?) 2) => falsey
- ( (negativize +) 1 2 3) => -6
- ( (triplize -) 0 1 2) => -9)
View
7 test/solutions/ts_function_monads.clj
@@ -0,0 +1,7 @@
+(ns solutions.ts-function-monads
+ (:use midje.sweet))
+
+
+(load-file "solutions/function-monads.clj")
+
+(fact (run-and-charge-and-speak 3) => {:charge 4, :result 104})
View
33 test/solutions/ts_scheduling.clj
@@ -0,0 +1,33 @@
+(ns solutions.ts-scheduling
+ (:use midje.sweet)
+ (:import java.util.Date))
+
+(load-file "solutions/scheduling.clj")
+
+(fact "courses which are full can be removed"
+ (remove-full [{:spaces-left 0} {:spaces-left 2}])
+ => [{:spaces-left 2}])
+
+(facts "courses with no registrants"
+ (let [courses [{:registered 1} {:registered 0}]]
+ (fact "will be removed if instructors are used up"
+ (remove-unbookable courses 1) => [{:registered 1}])
+ (fact "will be retained if instructors are not"
+ (remove-unbookable courses 2) => courses)))
+
+(facts ":already-in? courses can be forced into the set"
+ (add-back-already-in [:existing] [{:already-in? true}]) => #{:existing {:already-in? true}}
+ (add-back-already-in [:existing] [{:already-in? false}]) => #{:existing}
+ (add-back-already-in [{:already-in? true}] [{:already-in? true}]) => #{ {:already-in? true} })
+
+(facts "assertions on add-back-already-in data"
+ (asserty-add-back-already-in-1 [{:already-in? true}] [{:already-in? false}])
+ => #{ {:already-in? true}}
+ (asserty-add-back-already-in-1 [{:already-in? true}] [{:already-in? false :foo 1}])
+ => (throws java.lang.AssertionError)
+
+ (asserty-add-back-already-in-2 [{:already-in? true}] [{:already-in? false}])
+ => #{ {:already-in? true}}
+ (asserty-add-back-already-in-2 [{:already-in? true}] [{:already-in? true :foo 1}])
+ => (throws java.lang.AssertionError))
+
View
54 test/solutions/ts_sequence_m.clj
@@ -0,0 +1,54 @@
+(ns solutions.ts-sequence-m
+ (:use midje.sweet))
+
+(load-file "solutions/sequence-m.clj")
+
+;; Exercise 1
+
+(fact
+ (multiples 2)
+ => [4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40 42 44 46 48 50 52 54
+ 56 58 60 62 64 66 68 70 72 74 76 78 80 82 84 86 88 90 92 94 96 98 100]
+(multiples 3)
+ => [6 9 12 15 18 21 24 27 30 33 36 39 42 45 48 51 54 57 60 63 66 69 72 75 78 81
+ 84 87 90 93 96 99])
+
+;; Exercise 2
+
+(fact
+ ((set nonprimes) 4) => truthy
+ ((set nonprimes) 5) => falsey
+ ((set nonprimes) 100) => truthy)
+
+;; Exercise 3
+
+(fact
+ primes => [2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97])
+
+
+;; Exercise 4
+
+(fact
+ (with-monad combined-monad
+ (domonad [a [1 2 3]
+ b [-1 1]]
+ (* a b)))
+ => [-1 1 -2 2 -3 3])
+
+(fact
+ (with-monad combined-monad
+ (domonad [a [1 nil 3]
+ b [-1 1]]
+ (* a b)))
+ => [-1 1 nil -3 3])
+
+(fact
+ (with-monad combined-monad
+ (domonad [a [1 nil 3]
+ b [-1 1]]
+ (* a b)))
+ =>
+ (with-monad (maybe-t sequence-m)
+ (domonad [a [1 nil 3]
+ b [-1 1]]
+ (* a b))))
View
88 test/sources/t_scheduling.clj
@@ -0,0 +1,88 @@
+(ns sources.t-scheduling
+ (:use midje.sweet)
+ (:import java.util.Date))
+
+(load-file "sources/scheduling.clj")
+
+(fact "it is silly that I keep having to define `separate` wherever I go"
+ (separate odd? [1 2 3 4 5]) => [ [1 3 5] [2 4] ])
+
+(fact "basic annotations"
+ (answer-annotations [{:limit 4, :registered 3}] [])
+ => [{:limit 4, :registered 3, :spaces-left 1, :already-in? false}]
+
+ (answer-annotations [{:course-name "zigging" :limit 4, :registered 3}
+ {:course-name "zagging" :limit 1, :registered 1}]
+ ["zagging"])
+ => [{:course-name "zigging" :limit 4, :registered 3, :spaces-left 1, :already-in? false}
+ {:course-name "zagging" :limit 1, :registered 1, :spaces-left 0, :already-in? true}])
+
+(fact "some domain annotations"
+ (domain-annotations [{:registered 1, :spaces-left 1},
+ {:registered 0, :spaces-left 1},
+ {:registered 1, :spaces-left 0}])
+ => [{:registered 1, :spaces-left 1, :full? false, :empty? false},
+ {:registered 0, :spaces-left 1, :full? false, :empty? true},
+ {:registered 1, :spaces-left 0, :full? true, :empty? false}])
+
+
+(fact "note-unavailability"
+ (fact "with available instructors"
+ (note-unavailability [{:full? true, :empty? false}
+ {:full? false, :empty? true}
+ {:full? false, :empty? false}]
+ 3)
+ => [{:full? true, :empty? false, :unavailable? true}
+ {:full? false, :empty? true, :unavailable? false}
+ {:full? false, :empty? false, :unavailable? false}])
+ (fact "without available instructors"
+ (note-unavailability [{:full? true, :empty? false}
+ {:full? false, :empty? true}
+ {:full? false, :empty? false}]
+ 2)
+ => [{:full? true, :empty? false, :unavailable? true}
+ {:full? false, :empty? true, :unavailable? true}
+ {:full? false, :empty? false, :unavailable? false}]))
+
+(fact "end-to-end annotate"
+ (annotate [{:course-name "Zipping", :morning? true, :limit 5, :registered 3}] [] 8)
+ => [{:course-name "Zipping", :morning? true, :limit 5, :registered 3,
+ :empty? false, :full? false, :spaces-left 2, :already-in? false, :unavailable? false}])
+
+(fact "available courses use already-in? and unavailable?"
+ (visible-courses [{:already-in? true, :unavailable? true}
+ {:already-in? true, :unavailable? false}
+ {:already-in? false, :unavailable? true}
+ {:already-in? false, :unavailable? false}])
+ => [{:already-in? true, :unavailable? true}
+ {:already-in? true, :unavailable? false}
+ {:already-in? false, :unavailable? false}])
+
+(fact "final shape removes keys"
+ (let [desired {:course-name "Zigging",
+ :morning? true,
+ :registered 3,
+ :spaces-left 2,
+ :already-in? true}]
+ (final-shape [(assoc desired :extraneous :stuff)]) => [desired]))
+
+(fact "the solution sorts and whatnot"
+ (solution [{:course-name "AM1", :morning? true, :limit 5, :registered 3}
+ {:course-name "AM2", :morning? true, :limit 5, :registered 2}
+ {:course-name "AM3", :morning? true, :limit 5, :registered 5}
+ {:course-name "AM4", :morning? true, :limit 5, :registered 0}
+
+ {:course-name "PM1", :morning? false, :limit 4, :registered 4}
+ {:course-name "PM2", :morning? false, :limit 4, :registered 0}
+ {:course-name "PM3", :morning? false, :limit 4, :registered 2}]
+ ["AM3"]
+ 3)
+ => [ [{:course-name "AM1", :morning? true, :registered 3, :spaces-left 2, :already-in? false}
+ {:course-name "AM2", :morning? true, :registered 2, :spaces-left 3, :already-in? false}
+ {:course-name "AM3", :morning? true, :registered 5, :spaces-left 0, :already-in? true}]
+
+ [{:course-name "PM2", :morning? false, :registered 0, :spaces-left 4, :already-in? false}
+ {:course-name "PM3", :morning? false, :registered 2, :spaces-left 2, :already-in? false}]])
+
+
+(group-by odd? (range 10))
View
30 test/sources/t_sequence_m.clj
@@ -0,0 +1,30 @@
+(ns sources.t-sequence-m
+ (:use midje.sweet))
+
+(load-file "sources/sequence-m.clj")
+
+(fact
+ (with-monad sequence-monad
+ (domonad [a [1 2]
+ b [10, 100]
+ c [-1 1]]
+ (* a b c)))
+ =>
+ (with-monad sequence-m
+ (domonad [a [1 2]
+ b [10, 100]
+ c [-1 1]]
+ (* a b c))))
+
+(fact
+ (with-monad sequence-monad
+ (domonad [a (list 1 2 3)
+ b (list (- a) a)
+ c (list (+ a b) (- a b))]
+ (* a b c)))
+ =>
+ (with-monad sequence-m
+ (domonad [a (list 1 2 3)
+ b (list (- a) a)
+ c (list (+ a b) (- a b))]
+ (* a b c))))
Please sign in to comment.
Something went wrong with that request. Please try again.