├── .gitignore ├── ComparativeAnalysis ├── GossipingBusDriversJava │ ├── src │ │ └── gossipingBusDrivers │ │ │ ├── Driver.java │ │ │ ├── Route.java │ │ │ ├── Rumor.java │ │ │ ├── Simulation.java │ │ │ └── Stop.java │ └── test │ │ └── gossipingBusDrivers │ │ └── GossipTest.java ├── bowling │ ├── .gitignore │ ├── .nrepl-port │ ├── README.md │ ├── project.clj │ ├── spec │ │ └── bowling │ │ │ └── core_spec.clj │ └── src │ │ └── bowling │ │ └── core.clj ├── gossiping-bus-drivers-clojure │ ├── .gitignore │ ├── .nrepl-port │ ├── README.md │ ├── project.clj │ ├── spec │ │ └── gossiping_bus_drivers_clojure │ │ │ └── core_spec.clj │ └── src │ │ └── gossiping_bus_drivers_clojure │ │ └── core.clj ├── prime-factors │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ │ └── prime_factors │ │ │ └── core_spec.clj │ └── src │ │ └── prime_factors │ │ └── core.clj └── word-wrap │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── word_wrap │ │ └── core_spec.clj │ └── src │ └── word_wrap │ └── core.clj ├── Concurrency └── telco-simulator │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── telco_simulator │ │ └── core_spec.clj │ └── src │ └── telco_simulator │ └── core.clj ├── LICENSE ├── Laziness └── lazy-fib │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── lazy_fib │ │ └── core_spec.clj │ └── src │ └── lazy_fib │ └── core.clj ├── README.md ├── RecursionAndIteration ├── iterative-fib │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ │ └── iterative_fib │ │ │ └── core_spec.clj │ └── src │ │ └── iterative_fib │ │ └── core.clj └── recursive-fib │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── recursive_fib │ │ └── core_spec.clj │ └── src │ └── recursive_fib │ └── core.clj ├── Statefulness ├── p.java └── stm │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── stm │ │ └── core_spec.clj │ └── src │ └── stm │ └── core.clj ├── abstract-factory └── abstract-factory-example │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── abstract_factory_example │ │ └── core_spec.clj │ └── src │ └── abstract_factory_example │ ├── circle.clj │ ├── main.clj │ ├── shape.clj │ ├── shape_factory.clj │ ├── shape_factory_implementation.clj │ └── square.clj ├── abstract-server └── switch-light │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── switch_light │ │ └── core_spec.clj │ └── src │ └── switch_light │ └── core.clj ├── adapter └── turn-on-light │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── turn_on_light │ │ └── turn_on_spec.clj │ └── src │ └── turn_on_light │ ├── engage_switch.clj │ ├── switchable.clj │ ├── variable_light.clj │ └── variable_light_adapter.clj ├── command ├── command.cpp ├── command.o └── command │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── command │ │ └── core_spec.clj │ └── src │ └── command │ ├── add_room_command.clj │ ├── core.clj │ └── undoable_command.clj ├── composite-decorator ├── composite-shape │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ │ └── composite_example │ │ │ └── core_spec.clj │ └── src │ │ └── composite_example │ │ ├── circle.clj │ │ ├── composite_shape.clj │ │ ├── journaled_shape.clj │ │ ├── shape.clj │ │ └── square.clj ├── composite-switchable │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ │ └── composite_example │ │ │ └── core_spec.clj │ └── src │ │ └── composite_example │ │ ├── composite_switchable.clj │ │ ├── core.clj │ │ ├── light.clj │ │ ├── switchable.clj │ │ └── variable_light.clj └── compositeJava │ └── src │ └── composite │ ├── CompositeSwitchable.java │ └── Switchable.java ├── dip └── video-store │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── video_store │ │ ├── constructors_spec.clj │ │ ├── integration_specs.clj │ │ ├── quick_check.clj │ │ ├── statement_formatter_spec.clj │ │ └── statement_policy_spec.clj │ └── src │ └── video_store │ ├── buy_two_get_one_free_policy.clj │ ├── constructors.clj │ ├── html_statement_formatter.clj │ ├── normal_statement_policy.clj │ ├── order_processing.clj │ ├── statement_formatter.clj │ ├── statement_policy.clj │ └── text_statement_formatter.clj ├── functional-payroll ├── .gitignore ├── README.md ├── project.clj ├── spec │ └── functional_payroll │ │ └── core_spec.clj └── src │ └── functional_payroll │ ├── payroll.clj │ ├── payroll_implementation.clj │ └── payroll_interface.clj ├── gui └── turtle-graphics │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── turtle_graphics │ │ ├── core_spec.clj │ │ └── turtle_spec.clj │ └── src │ └── turtle_graphics │ ├── core.clj │ ├── turtle.clj │ ├── turtle_commands.clj │ └── turtle_script.clj ├── immutability ├── simple ├── simple.c ├── turnstile └── turnstile.c ├── lsp ├── lsp-stuff │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ │ └── lsp_stuff │ │ │ └── core_spec.clj │ └── src │ │ └── lsp_stuff │ │ └── core.clj └── rect-square │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── rect_square │ │ └── core_spec.clj │ └── src │ └── rect_square │ └── core.clj ├── ocp └── copy │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── copy │ │ └── core_spec.clj │ └── src │ └── copy │ └── core.clj ├── persitentData └── sieve │ ├── src │ └── sieve │ │ └── Sieve.java │ └── test │ └── sieve │ └── SieveTest.java ├── srp └── parse-order │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── parse_order │ │ └── core_spec.clj │ └── src │ └── parse_order │ └── core.clj ├── tests └── factors │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── factors │ │ └── core_spec.clj │ └── src │ └── factors │ └── core.clj ├── visitor └── shape-visitor │ ├── .gitignore │ ├── README.md │ ├── project.clj │ ├── spec │ └── visitor_example │ │ └── core_spec.clj │ └── src │ └── visitor_example │ ├── circle.clj │ ├── json_shape_visitor.clj │ ├── json_shape_visitor_implementation.clj │ ├── main.clj │ ├── shape.clj │ └── square.clj └── wator ├── .gitignore ├── README.md ├── project.clj ├── spec └── wator │ └── core_spec.clj └── src ├── wator ├── animal.clj ├── cell.clj ├── config.clj ├── fish.clj ├── fish_imp.clj ├── shark.clj ├── water.clj ├── water_imp.clj ├── world.clj └── world_imp.clj └── wator_gui └── main.clj /.gitignore: -------------------------------------------------------------------------------- 1 | **/.idea/ 2 | *.iml 3 | 4 | 5 | -------------------------------------------------------------------------------- /ComparativeAnalysis/GossipingBusDriversJava/src/gossipingBusDrivers/Driver.java: -------------------------------------------------------------------------------- 1 | package gossipingBusDrivers; 2 | 3 | import java.util.Arrays; 4 | import java.util.HashSet; 5 | import java.util.Set; 6 | 7 | public class Driver { 8 | private String name; 9 | private Route route; 10 | private int stopNumber = 0; 11 | private Set rumors; 12 | 13 | public Driver(String name, Route theRoute, Rumor... theRumors) { 14 | this.name = name; 15 | route = theRoute; 16 | rumors = new HashSet<>(Arrays.asList(theRumors)); 17 | route.stopAt(this, stopNumber); 18 | } 19 | 20 | public Stop getStop() { 21 | return route.get(stopNumber); 22 | } 23 | 24 | public void drive() { 25 | route.leave(this, stopNumber); 26 | stopNumber = route.getNextStop(stopNumber); 27 | route.stopAt(this, stopNumber); 28 | } 29 | 30 | public Set getRumors() { 31 | return rumors; 32 | } 33 | 34 | public void addRumors(Set newRumors) { 35 | rumors.addAll(newRumors); 36 | } 37 | 38 | public String toString() { 39 | return String.format("Driver: %s at %s with rumors %s", name, getStop(),makeRumorsString()); 40 | } 41 | 42 | private String makeRumorsString() { 43 | String rumorString = "["; 44 | for (Rumor r : rumors) { 45 | rumorString += r.toString(); 46 | rumorString += " "; 47 | } 48 | return rumorString + "]"; 49 | } 50 | } 51 | -------------------------------------------------------------------------------- /ComparativeAnalysis/GossipingBusDriversJava/src/gossipingBusDrivers/Route.java: -------------------------------------------------------------------------------- 1 | package gossipingBusDrivers; 2 | 3 | public class Route { 4 | private Stop[] stops; 5 | 6 | public Route(Stop ...stops) { 7 | this.stops = stops; 8 | } 9 | 10 | public Stop get(int stopNumber) { 11 | return stops[stopNumber]; 12 | } 13 | 14 | public int getNextStop(int stopNumber) { 15 | return (stopNumber + 1) % stops.length; 16 | } 17 | 18 | public void stopAt(Driver driver, int stopNumber) { 19 | stops[stopNumber].addDriver(driver); 20 | } 21 | 22 | public void leave(Driver driver, int stopNumber) { 23 | stops[stopNumber].removeDriver(driver); 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /ComparativeAnalysis/GossipingBusDriversJava/src/gossipingBusDrivers/Rumor.java: -------------------------------------------------------------------------------- 1 | package gossipingBusDrivers; 2 | 3 | public class Rumor { 4 | private String name; 5 | 6 | public Rumor(String name) { 7 | this.name = name; 8 | } 9 | 10 | public String toString() { 11 | return name; 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /ComparativeAnalysis/GossipingBusDriversJava/src/gossipingBusDrivers/Simulation.java: -------------------------------------------------------------------------------- 1 | package gossipingBusDrivers; 2 | 3 | import java.util.HashSet; 4 | import java.util.Set; 5 | 6 | public class Simulation { 7 | public static int driveTillEqual(Driver... drivers) { 8 | int time; 9 | for (time = 0; notAllRumors(drivers) && time < 480; time++) 10 | driveAndGossip(drivers); 11 | return time; 12 | } 13 | 14 | private static void driveAndGossip(Driver[] drivers) { 15 | Set stops = new HashSet<>(); 16 | for (Driver d : drivers) { 17 | d.drive(); 18 | stops.add(d.getStop()); 19 | } 20 | for (Stop stop : stops) 21 | stop.gossip(); 22 | } 23 | 24 | private static void printStatus(Driver[] drivers) { 25 | for (Driver d : drivers) 26 | System.out.println(d); 27 | } 28 | 29 | private static boolean notAllRumors(Driver[] drivers) { 30 | Set rumors = new HashSet<>(); 31 | for (Driver d : drivers) 32 | rumors.addAll(d.getRumors()); 33 | 34 | for (Driver d : drivers) { 35 | if (!d.getRumors().equals(rumors)) 36 | return true; 37 | } 38 | return false; 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /ComparativeAnalysis/GossipingBusDriversJava/src/gossipingBusDrivers/Stop.java: -------------------------------------------------------------------------------- 1 | package gossipingBusDrivers; 2 | 3 | import java.util.ArrayList; 4 | import java.util.HashSet; 5 | import java.util.List; 6 | import java.util.Set; 7 | 8 | public class Stop { 9 | private String name; 10 | private List drivers = new ArrayList<>(); 11 | 12 | public Stop(String name) { 13 | this.name = name; 14 | } 15 | 16 | public String toString() { 17 | return name; 18 | } 19 | 20 | public List getDrivers() { 21 | return drivers; 22 | } 23 | 24 | public void addDriver(Driver driver) { 25 | drivers.add(driver); 26 | } 27 | 28 | public void removeDriver(Driver driver) { 29 | drivers.remove(driver); 30 | } 31 | 32 | public void gossip() { 33 | Set rumorsAtStop = new HashSet<>(); 34 | for (Driver d : drivers) 35 | rumorsAtStop.addAll(d.getRumors()); 36 | for (Driver d : drivers) 37 | d.addRumors(rumorsAtStop); 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /ComparativeAnalysis/GossipingBusDriversJava/test/gossipingBusDrivers/GossipTest.java: -------------------------------------------------------------------------------- 1 | package gossipingBusDrivers; 2 | 3 | import org.junit.Before; 4 | import org.junit.Test; 5 | 6 | import static org.hamcrest.MatcherAssert.assertThat; 7 | import static org.hamcrest.collection.IsEmptyCollection.empty; 8 | import static org.hamcrest.collection. 9 | IsIterableContainingInAnyOrder.containsInAnyOrder; 10 | import static org.junit.Assert.assertEquals; 11 | 12 | public class GossipTest { 13 | private Stop stop1; 14 | private Stop stop2; 15 | private Stop stop3; 16 | private Route route1; 17 | private Route route2; 18 | private Rumor rumor1; 19 | private Rumor rumor2; 20 | private Rumor rumor3; 21 | private Driver driver1; 22 | private Driver driver2; 23 | 24 | @Before 25 | public void setUp() { 26 | stop1 = new Stop("stop1"); 27 | stop2 = new Stop("stop2"); 28 | stop3 = new Stop("stop3"); 29 | route1 = new Route(stop1, stop2); 30 | route2 = new Route(stop1, stop2, stop3); 31 | rumor1 = new Rumor("Rumor1"); 32 | rumor2 = new Rumor("Rumor2"); 33 | rumor3 = new Rumor("Rumor3"); 34 | driver1 = new Driver("Driver1", route1, rumor1); 35 | driver2 = new Driver("Driver2", route2, rumor2, rumor3); 36 | } 37 | 38 | @Test 39 | public void driverStartsAtFirstStopInRoute() throws Exception { 40 | assertEquals(stop1, driver1.getStop()); 41 | } 42 | 43 | @Test 44 | public void driverDrivesToNextStop() throws Exception { 45 | driver1.drive(); 46 | assertEquals(stop2, driver1.getStop()); 47 | } 48 | 49 | @Test 50 | public void driverReturnsToStartAfterLastStop() throws Exception { 51 | driver1.drive(); 52 | driver1.drive(); 53 | assertEquals(stop1, driver1.getStop()); 54 | } 55 | 56 | @Test 57 | public void firstStopHasDriversAtStart() throws Exception { 58 | assertThat(stop1.getDrivers(), containsInAnyOrder(driver1, driver2)); 59 | assertThat(stop2.getDrivers(), empty()); 60 | } 61 | 62 | @Test 63 | public void multipleDriversEnterAndLeaveStops() throws Exception { 64 | assertThat(stop1.getDrivers(), containsInAnyOrder(driver1, driver2)); 65 | assertThat(stop2.getDrivers(), empty()); 66 | assertThat(stop3.getDrivers(), empty()); 67 | driver1.drive(); 68 | driver2.drive(); 69 | assertThat(stop1.getDrivers(), empty()); 70 | assertThat(stop2.getDrivers(), containsInAnyOrder(driver1, driver2)); 71 | assertThat(stop3.getDrivers(), empty()); 72 | driver1.drive(); 73 | driver2.drive(); 74 | assertThat(stop1.getDrivers(), containsInAnyOrder(driver1)); 75 | assertThat(stop2.getDrivers(), empty()); 76 | assertThat(stop3.getDrivers(), containsInAnyOrder(driver2)); 77 | driver1.drive(); 78 | driver2.drive(); 79 | assertThat(stop1.getDrivers(), containsInAnyOrder(driver2)); 80 | assertThat(stop2.getDrivers(), containsInAnyOrder(driver1)); 81 | assertThat(stop3.getDrivers(), empty()); 82 | } 83 | 84 | @Test 85 | public void driversHaveRumorsAtStart() throws Exception { 86 | assertThat(driver1.getRumors(), containsInAnyOrder(rumor1)); 87 | assertThat(driver2.getRumors(), containsInAnyOrder(rumor2, rumor3)); 88 | } 89 | 90 | @Test 91 | public void noDriversGossipAtEmptyStop() throws Exception { 92 | stop2.gossip(); 93 | assertThat(driver1.getRumors(), containsInAnyOrder(rumor1)); 94 | assertThat(driver2.getRumors(), containsInAnyOrder(rumor2, rumor3)); 95 | } 96 | 97 | @Test 98 | public void driversGossipAtStop() throws Exception { 99 | stop1.gossip(); 100 | assertThat(driver1.getRumors(), containsInAnyOrder(rumor1, rumor2, rumor3)); 101 | assertThat(driver2.getRumors(), containsInAnyOrder(rumor1, rumor2, rumor3)); 102 | } 103 | 104 | @Test 105 | public void gossipIsNotDuplicated() throws Exception { 106 | stop1.gossip(); 107 | stop1.gossip(); 108 | assertThat(driver1.getRumors(), containsInAnyOrder(rumor1, rumor2, rumor3)); 109 | assertThat(driver2.getRumors(), containsInAnyOrder(rumor1, rumor2, rumor3)); 110 | } 111 | 112 | @Test 113 | public void driveTillEqualTest() throws Exception { 114 | assertEquals(1, Simulation.driveTillEqual(driver1, driver2)); 115 | } 116 | 117 | @Test 118 | public void acceptanceTest1() throws Exception { 119 | Stop s1 = new Stop("s1"); 120 | Stop s2 = new Stop("s2"); 121 | Stop s3 = new Stop("s3"); 122 | Stop s4 = new Stop("s4"); 123 | Stop s5 = new Stop("s5"); 124 | Route r1 = new Route(s3, s1, s2, s3); 125 | Route r2 = new Route(s3, s2, s3, s1); 126 | Route r3 = new Route(s4, s2, s3, s4, s5); 127 | Driver d1 = new Driver("d1", r1, new Rumor("1")); 128 | Driver d2 = new Driver("d2", r2, new Rumor("2")); 129 | Driver d3 = new Driver("d3", r3, new Rumor("3")); 130 | assertEquals(6, Simulation.driveTillEqual(d1, d2, d3)); 131 | } 132 | 133 | @Test 134 | public void acceptanceTest2() throws Exception { 135 | Stop s1 = new Stop("s1"); 136 | Stop s2 = new Stop("s2"); 137 | Stop s5 = new Stop("s5"); 138 | Stop s8 = new Stop("s8"); 139 | Route r1 = new Route(s2, s1, s2); 140 | Route r2 = new Route(s5, s2, s8); 141 | Driver d1 = new Driver("d1", r1, new Rumor("1")); 142 | Driver d2 = new Driver("d2", r2, new Rumor("2")); 143 | assertEquals(480, Simulation.driveTillEqual(d1, d2)); 144 | } 145 | } 146 | -------------------------------------------------------------------------------- /ComparativeAnalysis/bowling/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /ComparativeAnalysis/bowling/.nrepl-port: -------------------------------------------------------------------------------- 1 | 60138 -------------------------------------------------------------------------------- /ComparativeAnalysis/bowling/README.md: -------------------------------------------------------------------------------- 1 | # bowling 2 | -------------------------------------------------------------------------------- /ComparativeAnalysis/bowling/project.clj: -------------------------------------------------------------------------------- 1 | (defproject bowling "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main bowling.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /ComparativeAnalysis/bowling/spec/bowling/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns bowling.core-spec 2 | (:require [speclj.core :refer :all] 3 | [bowling.core :refer :all])) 4 | 5 | (describe "The Bowling Game" 6 | (it "scores a gutter game" 7 | (should= 0 (score (repeat 20 0)))) 8 | 9 | (it "scores all ones" 10 | (should= 20 (score (repeat 20 1)))) 11 | 12 | (it "scores one spare" 13 | (should= 24 (score (concat [5 5 7] (repeat 17 0))))) 14 | 15 | (it "one strike" 16 | (should= 20 (score (concat [10 2 3] (repeat 16 0))))) 17 | 18 | (it "perfect game" 19 | (should= 300 (score (repeat 12 10)))) 20 | ) 21 | -------------------------------------------------------------------------------- /ComparativeAnalysis/bowling/src/bowling/core.clj: -------------------------------------------------------------------------------- 1 | (ns bowling.core) 2 | 3 | (defn to-frames [rolls] 4 | (loop [remaining-rolls rolls 5 | frames []] 6 | (cond 7 | (empty? remaining-rolls) 8 | frames 9 | 10 | (= 10 (first remaining-rolls)) 11 | (recur (rest remaining-rolls) 12 | (conj frames (take 3 remaining-rolls))) 13 | 14 | (= 10 (reduce + (take 2 remaining-rolls))) 15 | (recur (drop 2 remaining-rolls) 16 | (conj frames (take 3 remaining-rolls))) 17 | :else 18 | (recur (drop 2 remaining-rolls) 19 | (conj frames (take 2 remaining-rolls)))))) 20 | 21 | (defn add-frames [score frame] 22 | (+ score (reduce + frame))) 23 | 24 | (defn score [rolls] 25 | (reduce add-frames 0 (take 10 (to-frames rolls)))) 26 | -------------------------------------------------------------------------------- /ComparativeAnalysis/gossiping-bus-drivers-clojure/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /ComparativeAnalysis/gossiping-bus-drivers-clojure/.nrepl-port: -------------------------------------------------------------------------------- 1 | 49759 -------------------------------------------------------------------------------- /ComparativeAnalysis/gossiping-bus-drivers-clojure/README.md: -------------------------------------------------------------------------------- 1 | # gossiping-bus-drivers-clojure 2 | -------------------------------------------------------------------------------- /ComparativeAnalysis/gossiping-bus-drivers-clojure/project.clj: -------------------------------------------------------------------------------- 1 | (defproject gossiping-bus-drivers-clojure "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main gossiping-bus-drivers-clojure.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /ComparativeAnalysis/gossiping-bus-drivers-clojure/spec/gossiping_bus_drivers_clojure/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns gossiping-bus-drivers-clojure.core-spec 2 | (:require [speclj.core :refer :all] 3 | [gossiping-bus-drivers-clojure.core :refer :all])) 4 | 5 | (describe "gossiping bus drivers" 6 | (it "drives one bus at one stop" 7 | (let [driver (make-driver "d1" [:s1] #{:r1}) 8 | world [driver] 9 | new-world (drive world)] 10 | (should= 1 (count new-world)) 11 | (should= :s1 (-> new-world first :route first)))) 12 | 13 | (it "drives one bus at two stops" 14 | (let [driver (make-driver "d1" [:s1 :s2] #{:r1}) 15 | world [driver] 16 | new-world (drive world)] 17 | (should= 1 (count new-world)) 18 | (should= :s2 (-> new-world first :route first)))) 19 | 20 | (it "drives two busses at some stops" 21 | (let [d1 (make-driver "d1" [:s1 :s2] #{:r1}) 22 | d2 (make-driver "d2" [:s1 :s3 :s2] #{:r2}) 23 | world [d1 d2] 24 | new-1 (drive world) 25 | new-2 (drive new-1)] 26 | (should= 2 (count new-1)) 27 | (should= :s2 (-> new-1 first :route first)) 28 | (should= :s3 (-> new-1 second :route first)) 29 | (should= 2 (count new-2)) 30 | (should= :s1 (-> new-2 first :route first)) 31 | (should= :s2 (-> new-2 second :route first)))) 32 | 33 | (it "gets stops" 34 | (let [drivers #{{:name "d1" :route [:s1]} 35 | {:name "d2" :route [:s1]} 36 | {:name "d3" :route [:s2]}}] 37 | (should= {:s1 [{:name "d1" :route [:s1]} 38 | {:name "d2" :route [:s1]}] 39 | :s2 [{:name "d3", :route [:s2]}]} 40 | (get-stops drivers))) 41 | ) 42 | 43 | (it "merges rumors" 44 | (should= [{:name "d1" :rumors #{:r2 :r1}} 45 | {:name "d2" :rumors #{:r2 :r1}}] 46 | (merge-rumors [{:name "d1" :rumors #{:r1}} 47 | {:name "d2" :rumors #{:r2}}]))) 48 | 49 | 50 | (it "shares gossip when drivers are at same stop" 51 | (let [d1 (make-driver "d1" [:s1 :s2] #{:r1}) 52 | d2 (make-driver "d2" [:s1 :s2] #{:r2}) 53 | world [d1 d2] 54 | new-world (drive world)] 55 | (should= 2 (count new-world)) 56 | (should= #{:r1 :r2} (-> new-world first :rumors)) 57 | (should= #{:r1 :r2} (-> new-world second :rumors)))) 58 | 59 | (it "passes acceptance test 1" 60 | (let [world [(make-driver "d1" [3 1 2 3] #{1}) 61 | (make-driver "d2" [3 2 3 1] #{2}) 62 | (make-driver "d3" [4 2 3 4 5] #{3})]] 63 | (should= 6 (drive-till-all-rumors-spread world)))) 64 | 65 | (it "passes acceptance test 2" 66 | (let [world [(make-driver "d1" [2 1 2] #{1}) 67 | (make-driver "d2" [5 2 8] #{2})]] 68 | (should= :never (drive-till-all-rumors-spread world)))) 69 | ) 70 | 71 | -------------------------------------------------------------------------------- /ComparativeAnalysis/gossiping-bus-drivers-clojure/src/gossiping_bus_drivers_clojure/core.clj: -------------------------------------------------------------------------------- 1 | (ns gossiping-bus-drivers-clojure.core 2 | (:require [clojure.set :as set])) 3 | 4 | (defn make-driver [name route rumors] 5 | (assoc {} :name name :route (cycle route) :rumors rumors)) 6 | 7 | (defn move-driver [driver] 8 | (update driver :route rest)) 9 | 10 | (defn move-drivers [world] 11 | (map move-driver world)) 12 | 13 | (defn get-stops [world] 14 | (loop [world world 15 | stops {}] 16 | (if (empty? world) 17 | stops 18 | (let [driver (first world) 19 | stop (first (:route driver)) 20 | stops (update stops stop conj driver)] 21 | (recur (rest world) stops))))) 22 | 23 | (defn merge-rumors [drivers] 24 | (let [rumors (map :rumors drivers) 25 | all-rumors (apply set/union rumors)] 26 | (map #(assoc % :rumors all-rumors) drivers))) 27 | 28 | (defn spread-rumors [world] 29 | (let [stops-with-drivers (get-stops world) 30 | drivers-by-stop (vals stops-with-drivers)] 31 | (flatten (map merge-rumors drivers-by-stop)))) 32 | 33 | (defn drive [world] 34 | (-> world move-drivers spread-rumors)) 35 | 36 | (defn drive-till-all-rumors-spread [world] 37 | (loop [world (drive world) 38 | time 1] 39 | (cond 40 | (> time 480) :never 41 | (apply = (map :rumors world)) time 42 | :else (recur (drive world) (inc time))))) -------------------------------------------------------------------------------- /ComparativeAnalysis/prime-factors/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /ComparativeAnalysis/prime-factors/README.md: -------------------------------------------------------------------------------- 1 | # prime-factors 2 | -------------------------------------------------------------------------------- /ComparativeAnalysis/prime-factors/project.clj: -------------------------------------------------------------------------------- 1 | (defproject prime-factors "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main prime-factors.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /ComparativeAnalysis/prime-factors/spec/prime_factors/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns prime-factors.core-spec 2 | (:require [speclj.core :refer :all] 3 | [prime-factors.core :refer :all])) 4 | 5 | (describe "prime factors" 6 | (it "computes prime factors of integers" 7 | (should= [] (prime-factors-of 0)) 8 | (should= [] (prime-factors-of 1)) 9 | (should= [2] (prime-factors-of 2)) 10 | (should= [3] (prime-factors-of 3)) 11 | (should= [2 2] (prime-factors-of 4)) 12 | (should= [5] (prime-factors-of 5)) 13 | (should= [2 3] (prime-factors-of 6)) 14 | (should= [7] (prime-factors-of 7)) 15 | (should= [2 2 2] (prime-factors-of 8)) 16 | (should= [3 3] (prime-factors-of 9)) 17 | (should= [2 2 3 3 5 7 11 11 13] (prime-factors-of (* 2 2 3 3 5 7 11 11 13))) 18 | ) 19 | ) 20 | -------------------------------------------------------------------------------- /ComparativeAnalysis/prime-factors/src/prime_factors/core.clj: -------------------------------------------------------------------------------- 1 | (ns prime-factors.core) 2 | 3 | (defn prime-factors-of [n] 4 | (loop [n n divisor 2 factors []] 5 | (if (> n 1) 6 | (if (zero? (rem n divisor)) 7 | (recur (quot n divisor) divisor (conj factors divisor)) 8 | (recur n (inc divisor) factors)) 9 | factors))) 10 | 11 | -------------------------------------------------------------------------------- /ComparativeAnalysis/word-wrap/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /ComparativeAnalysis/word-wrap/README.md: -------------------------------------------------------------------------------- 1 | # word-wrap 2 | -------------------------------------------------------------------------------- /ComparativeAnalysis/word-wrap/project.clj: -------------------------------------------------------------------------------- 1 | (defproject word-wrap "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main word-wrap.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /ComparativeAnalysis/word-wrap/spec/word_wrap/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns word-wrap.core-spec 2 | (:require [speclj.core :refer :all] 3 | [word-wrap.core :refer :all])) 4 | 5 | (describe "word wrap" 6 | (it "wraps nothing" 7 | (should= "" (wrap "" 2))) 8 | 9 | (it "wraps a single character" 10 | (should= "x" (wrap "x" 2))) 11 | 12 | (it "cuts a long word" 13 | (should= "x\nx" (wrap "xx" 1))) 14 | 15 | (it "cuts many long words" 16 | (should= "x\nx\nx" (wrap "xxx" 1))) 17 | 18 | (it "cuts before a space" 19 | (should= "x\nx" (wrap "x x" 1))) 20 | 21 | (it "cuts at a space" 22 | (should= "x\nx" (wrap "x x" 2))) 23 | 24 | (it "cuts at a space to preserve a word" 25 | (should= "x\nxx" (wrap "x xx" 3))) 26 | ) -------------------------------------------------------------------------------- /ComparativeAnalysis/word-wrap/src/word_wrap/core.clj: -------------------------------------------------------------------------------- 1 | (ns word-wrap.core) 2 | 3 | (defn wrap [s w] 4 | (if (<= (count s) w) 5 | s 6 | (let [cut-at (.lastIndexOf s " " w) 7 | cut-at (if (neg? cut-at) w cut-at)] 8 | (str (.trim (subs s 0 cut-at)) "\n" (wrap (.trim (subs s cut-at)) w))))) -------------------------------------------------------------------------------- /Concurrency/telco-simulator/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /Concurrency/telco-simulator/README.md: -------------------------------------------------------------------------------- 1 | # telco-simulator 2 | -------------------------------------------------------------------------------- /Concurrency/telco-simulator/project.clj: -------------------------------------------------------------------------------- 1 | (defproject telco-simulator "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main telco-simulator.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /Concurrency/telco-simulator/spec/telco_simulator/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns telco-simulator.core-spec 2 | (:require [speclj.core :refer :all] 3 | [telco-simulator.core :refer :all])) 4 | 5 | (describe "telco" 6 | (it "should make and receive call" 7 | (let [caller (make-user-agent "Bob") 8 | callee (make-user-agent "Alice") 9 | telco (make-telco-agent "telco")] 10 | (reset! log []) 11 | (send caller transition :call [telco caller callee]) 12 | (Thread/sleep 100) 13 | (prn @log) 14 | (should= :idle (:state @caller)) 15 | (should= :idle (:state @callee)) 16 | (should= :idle (:state @telco)) 17 | )) 18 | 19 | (it "should race" 20 | (let [caller (make-user-agent "Bob") 21 | callee (make-user-agent "Alice") 22 | telco1 (make-telco-agent "telco1") 23 | telco2 (make-telco-agent "telco2")] 24 | (reset! log []) 25 | (send caller transition :call [telco1 caller callee]) 26 | (Thread/sleep 5) 27 | (send callee transition :call [telco2 callee caller]) 28 | (Thread/sleep 100) 29 | (prn @log) 30 | (should= :idle (:state @caller)) 31 | (should= :idle (:state @callee)) 32 | (should= :idle (:state @telco1)) 33 | (should= :idle (:state @telco2)))) 34 | ) -------------------------------------------------------------------------------- /Concurrency/telco-simulator/src/telco_simulator/core.clj: -------------------------------------------------------------------------------- 1 | (ns telco-simulator.core) 2 | 3 | (def log (atom [])) 4 | 5 | (declare transition) 6 | 7 | (defn caller-off-hook [sm-agent [telco caller callee :as call-data]] 8 | (swap! log conj (str (:name @caller) " goes off hook.")) 9 | (send-off telco transition :caller-off-hook call-data)) 10 | 11 | (defn dial [sm-agent [telco caller callee :as call-data]] 12 | (swap! log conj (str (:name @caller) " dials")) 13 | (send-off telco transition :dial call-data)) 14 | 15 | (defn callee-off-hook [sm-agent [telco caller callee :as call-data]] 16 | (swap! log conj (str (:name @callee) " goes off hook")) 17 | (send-off telco transition :callee-off-hook call-data)) 18 | 19 | (defn talk [sm-agent [telco caller callee :as call-data]] 20 | (swap! log conj (str (:name sm-agent) " talks.")) 21 | (Thread/sleep 10) 22 | (swap! log conj (str (:name sm-agent) " hangs up.")) 23 | (send-off telco transition :hangup call-data)) 24 | 25 | (defn dialtone [sm-agent [telco caller callee :as call-data]] 26 | (Thread/sleep 10) 27 | (swap! log conj (str "dialtone to " (:name @caller))) 28 | (send-off caller transition :dialtone call-data)) 29 | 30 | (defn ring [sm-agent [telco caller callee :as call-data]] 31 | (swap! log conj (str "telco rings " (:name @callee))) 32 | (send callee transition :ring call-data) 33 | (send-off caller transition :ringback call-data)) 34 | 35 | (defn connect [sm-agent [telco caller callee :as call-data]] 36 | (swap! log conj "telco connects") 37 | (send-off caller transition :connected call-data) 38 | (send-off callee transition :connected call-data)) 39 | 40 | (defn disconnect [sm-agent [telco caller callee :as call-data]] 41 | (swap! log conj "disconnect") 42 | (send-off callee transition :disconnect call-data) 43 | (send-off caller transition :disconnect call-data)) 44 | 45 | (def user-sm 46 | {:idle {:call [:calling caller-off-hook] 47 | :ring [:waiting-for-connection callee-off-hook] 48 | :disconnect [:idle nil]} 49 | :calling {:dialtone [:dialing dial]} 50 | :dialing {:ringback [:waiting-for-connection nil]} 51 | :waiting-for-connection {:connected [:talking talk]} 52 | :talking {:disconnect [:idle nil]}}) 53 | 54 | (def telco-sm 55 | {:idle {:caller-off-hook [:waiting-for-dial dialtone] 56 | :hangup [:idle nil]} 57 | :waiting-for-dial {:dial [:waiting-for-answer ring]} 58 | :waiting-for-answer {:callee-off-hook [:waiting-for-hangup connect]} 59 | :waiting-for-hangup {:hangup [:idle disconnect]}}) 60 | 61 | (defn make-user-agent [name] 62 | (agent {:state :idle :name name :machine user-sm})) 63 | 64 | (defn make-telco-agent [name] 65 | (agent {:state :idle :name name :machine telco-sm})) 66 | 67 | (defn transition [machine-agent event event-data] 68 | (swap! log conj (str (:name machine-agent) "<-" event)) 69 | (let [state (:state machine-agent) 70 | sm (:machine machine-agent) 71 | result (get-in sm [state event])] 72 | (if (nil? result) 73 | (do 74 | (swap! log conj "TILT!") 75 | machine-agent) 76 | (do 77 | (when (second result) ((second result) machine-agent event-data)) 78 | (assoc machine-agent :state (first result)))))) 79 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 Robert C. Martin (Uncle Bob) 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /Laziness/lazy-fib/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /Laziness/lazy-fib/README.md: -------------------------------------------------------------------------------- 1 | # lazy-fib 2 | -------------------------------------------------------------------------------- /Laziness/lazy-fib/project.clj: -------------------------------------------------------------------------------- 1 | (defproject lazy-fib "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main lazy-fib.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /Laziness/lazy-fib/spec/lazy_fib/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns lazy-fib.core-spec 2 | (:require [speclj.core :refer :all] 3 | [lazy-fib.core :refer :all])) 4 | 5 | (describe "lazy-fib" 6 | (it "works" 7 | (should= [1 1 2 3 5 8] (take 6 (lazy-fibs))))) 8 | -------------------------------------------------------------------------------- /Laziness/lazy-fib/src/lazy_fib/core.clj: -------------------------------------------------------------------------------- 1 | (ns lazy-fib.core) 2 | 3 | (declare fib) 4 | 5 | (defn fib-w [n] 6 | (cond 7 | (< n 1) nil 8 | (<= n 2) 1N 9 | :else (+ (fib (dec n)) (fib (- n 2))))) 10 | 11 | (def fib (memoize fib-w)) 12 | 13 | (defn lazy-fibs [] 14 | (map fib (rest (range))) 15 | ) 16 | 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | These are the code examples for the book Functional Design. 2 | 3 | -------------------------------------------------------------------------------- /RecursionAndIteration/iterative-fib/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /RecursionAndIteration/iterative-fib/README.md: -------------------------------------------------------------------------------- 1 | # iterative-fib 2 | -------------------------------------------------------------------------------- /RecursionAndIteration/iterative-fib/project.clj: -------------------------------------------------------------------------------- 1 | (defproject iterative-fib "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main iterative-fib.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /RecursionAndIteration/iterative-fib/spec/iterative_fib/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns iterative-fib.core-spec 2 | (:require [speclj.core :refer :all] 3 | [iterative-fib.core :refer :all])) 4 | 5 | (describe "fib" 6 | (it "works" 7 | (should= [1] (fibs 1)) 8 | (should= [1 1] (fibs 2)) 9 | (should= [1 1 2] (fibs 3)) 10 | (should= [1 1 2 3 5 8] (fibs 6)) 11 | ) 12 | 13 | ) 14 | -------------------------------------------------------------------------------- /RecursionAndIteration/iterative-fib/src/iterative_fib/core.clj: -------------------------------------------------------------------------------- 1 | (ns iterative-fib.core) 2 | 3 | (defn fibs-work [n i fs] 4 | (if (= i n) 5 | fs 6 | (recur n (inc i) (conj fs (apply + (take-last 2 fs)))))) 7 | 8 | (defn fibs [n] 9 | (cond 10 | (< n 1) [] 11 | (= n 1) [1] 12 | :else (fibs-work n 2 [1 1]) 13 | ) 14 | ) 15 | -------------------------------------------------------------------------------- /RecursionAndIteration/recursive-fib/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /RecursionAndIteration/recursive-fib/README.md: -------------------------------------------------------------------------------- 1 | # recursive-fib 2 | -------------------------------------------------------------------------------- /RecursionAndIteration/recursive-fib/project.clj: -------------------------------------------------------------------------------- 1 | (defproject recursive-fib "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main recursive-fib.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /RecursionAndIteration/recursive-fib/spec/recursive_fib/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns recursive-fib.core-spec 2 | (:require [speclj.core :refer :all] 3 | [recursive-fib.core :refer :all])) 4 | 5 | (describe "recursive-fib" 6 | (it "works" 7 | (should= nil (fib 0)) 8 | (should= 1 (fib 1)) 9 | (should= 1 (fib 2)) 10 | (should= 2 (fib 3)) 11 | (should= 3 (fib 4)) 12 | (should= 5 (fib 5)) 13 | (should= [1 1 2 3 5 8 13] (fibs 7)) 14 | (should= nil (fib 0)) 15 | (should= 1 (ifib 1)) 16 | (should= 1 (ifib 2)) 17 | (should= 2 (ifib 3)) 18 | (should= 3 (ifib 4)) 19 | (should= 5 (ifib 5)) 20 | )) 21 | -------------------------------------------------------------------------------- /RecursionAndIteration/recursive-fib/src/recursive_fib/core.clj: -------------------------------------------------------------------------------- 1 | (ns recursive-fib.core) 2 | 3 | (declare fib) 4 | 5 | (defn fib-w [n] 6 | (cond 7 | (< n 1) nil 8 | (<= n 2) 1 9 | :else (+ (fib (dec n)) (fib (- n 2))))) 10 | 11 | (def fib (memoize fib-w)) 12 | 13 | (defn fibs [n] 14 | (map fib (range 1 (inc n)))) 15 | 16 | (defn ifib 17 | ([n a b] 18 | (if (= 0 n) 19 | b 20 | (recur (dec n) b (+ a b)))) 21 | 22 | ([n] 23 | (cond 24 | (< n 1) nil 25 | (<= n 2) 1 26 | :else (ifib (- n 2) 1 1))) 27 | ) -------------------------------------------------------------------------------- /Statefulness/p.java: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/unclebob/FunctionalDesign/e2b99727e3bd7d52aecb41412dcbfc22522acadd/Statefulness/p.java -------------------------------------------------------------------------------- /Statefulness/stm/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /Statefulness/stm/README.md: -------------------------------------------------------------------------------- 1 | # stm 2 | -------------------------------------------------------------------------------- /Statefulness/stm/project.clj: -------------------------------------------------------------------------------- 1 | (defproject stm "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main stm.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /Statefulness/stm/spec/stm/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns stm.core-spec 2 | (:require [speclj.core :refer :all] 3 | [stm.core :refer :all])) 4 | 5 | (describe "stm" 6 | (it "counts properly" 7 | (reset! counter 0) 8 | (let [ta (future (increment 20 "a")) 9 | tx (future (increment 20 "x")) 10 | done [@ta @tx] ] 11 | (should= 40 @counter)))) 12 | -------------------------------------------------------------------------------- /Statefulness/stm/src/stm/core.clj: -------------------------------------------------------------------------------- 1 | (ns stm.core) 2 | 3 | (def counter (atom 0)) 4 | 5 | (defn add-one [x] 6 | (let [y (inc x)] 7 | (print (str "(" x ")")) 8 | y)) 9 | 10 | (defn increment [n id] 11 | (dotimes [_ n] 12 | (print id) 13 | (swap! counter add-one))) 14 | 15 | (defn -main [] 16 | (let [ta (future (increment 10 "a")) 17 | tx (future (increment 10 "x")) 18 | _ @ta 19 | _ @tx] 20 | (println "\nCounter is: " @counter))) 21 | -------------------------------------------------------------------------------- /abstract-factory/abstract-factory-example/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /abstract-factory/abstract-factory-example/README.md: -------------------------------------------------------------------------------- 1 | # abstract-factory-example 2 | -------------------------------------------------------------------------------- /abstract-factory/abstract-factory-example/project.clj: -------------------------------------------------------------------------------- 1 | (defproject abstract-factory-example "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main abstract-factory-example.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /abstract-factory/abstract-factory-example/spec/abstract_factory_example/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns abstract-factory-example.core-spec 2 | (:require [speclj.core :refer :all] 3 | [abstract-factory-example 4 | [shape :as shape] 5 | [shape-factory :as factory] 6 | [main :as main]])) 7 | 8 | (describe "Shape Factory" 9 | (before-all (main/init)) 10 | (it "creates a square" 11 | (let [square (factory/make 12 | @main/shape-factory 13 | :square 14 | [100 100] 10)] 15 | (should= "Square top-left: [100,100] side: 10" 16 | (shape/to-string square)))) 17 | 18 | (it "creates a circle" 19 | (let [circle (factory/make 20 | @main/shape-factory 21 | :circle 22 | [100 100] 10)] 23 | (should= "Circle center: [100,100] radius: 10" 24 | (shape/to-string circle))))) 25 | 26 | -------------------------------------------------------------------------------- /abstract-factory/abstract-factory-example/src/abstract_factory_example/circle.clj: -------------------------------------------------------------------------------- 1 | (ns abstract-factory-example.circle 2 | (:require 3 | [abstract-factory-example.shape :as shape])) 4 | 5 | (defn make [center radius] 6 | {::shape/type ::circle 7 | ::center center 8 | ::radius radius}) 9 | 10 | (defmethod shape/to-string ::circle [circle] 11 | (let [[x y] (::center circle) 12 | radius (::radius circle)] 13 | (format "Circle center: [%s,%s] radius: %s" x y radius))) 14 | 15 | -------------------------------------------------------------------------------- /abstract-factory/abstract-factory-example/src/abstract_factory_example/main.clj: -------------------------------------------------------------------------------- 1 | (ns abstract-factory-example.main 2 | (:require [abstract-factory-example 3 | [shape-factory-implementation :as imp]])) 4 | 5 | (def shape-factory (atom nil)) 6 | 7 | (defn init[] 8 | (reset! shape-factory (imp/make))) 9 | -------------------------------------------------------------------------------- /abstract-factory/abstract-factory-example/src/abstract_factory_example/shape.clj: -------------------------------------------------------------------------------- 1 | (ns abstract-factory-example.shape) 2 | 3 | (defmulti to-string ::type) 4 | 5 | -------------------------------------------------------------------------------- /abstract-factory/abstract-factory-example/src/abstract_factory_example/shape_factory.clj: -------------------------------------------------------------------------------- 1 | (ns abstract-factory-example.shape-factory) 2 | 3 | (defmulti make (fn [factory type & args] (::type factory))) 4 | -------------------------------------------------------------------------------- /abstract-factory/abstract-factory-example/src/abstract_factory_example/shape_factory_implementation.clj: -------------------------------------------------------------------------------- 1 | (ns abstract-factory-example.shape-factory-implementation 2 | (:require [abstract-factory-example 3 | [shape-factory :as factory] 4 | [square :as square] 5 | [circle :as circle]])) 6 | 7 | (defn make [] 8 | {::factory/type ::implementation}) 9 | 10 | (defmethod factory/make ::implementation 11 | [factory type & args] 12 | (condp = type 13 | :square (apply square/make args) 14 | :circle (apply circle/make args)) 15 | ) 16 | 17 | -------------------------------------------------------------------------------- /abstract-factory/abstract-factory-example/src/abstract_factory_example/square.clj: -------------------------------------------------------------------------------- 1 | (ns abstract-factory-example.square 2 | (:require [abstract-factory-example.shape :as shape])) 3 | 4 | (defn make [top-left side] 5 | {::shape/type ::square 6 | ::top-left top-left 7 | ::side side}) 8 | 9 | (defmethod shape/to-string ::square [square] 10 | (let [[x y] (::top-left square) 11 | side (::side square)] 12 | (format "Square top-left: [%s,%s] side: %s" x y side))) 13 | -------------------------------------------------------------------------------- /abstract-server/switch-light/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /abstract-server/switch-light/README.md: -------------------------------------------------------------------------------- 1 | # switch-light 2 | -------------------------------------------------------------------------------- /abstract-server/switch-light/project.clj: -------------------------------------------------------------------------------- 1 | (defproject switch-light "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main switch-light.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /abstract-server/switch-light/spec/switch_light/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns switch-light.core-spec 2 | (:require [speclj.core :refer :all] 3 | [switch-light.core :refer :all])) 4 | 5 | (describe "switch/light" 6 | (with-stubs) 7 | (it "turns light on and off" 8 | (with-redefs [turn-on-light (stub :turn-on-light) 9 | turn-off-light (stub :turn-off-light)] 10 | (engage-switch {:type :light}) 11 | (should-have-invoked :turn-on-light) 12 | (should-have-invoked :turn-off-light)))) 13 | -------------------------------------------------------------------------------- /abstract-server/switch-light/src/switch_light/core.clj: -------------------------------------------------------------------------------- 1 | (ns switch-light.core) 2 | 3 | (defn turn-on-light [] 4 | ;turn on the bloody light! 5 | ) 6 | 7 | (defn turn-off-light [] 8 | ;Criminy! just turn it off! 9 | ) 10 | 11 | (defmulti turn-on :type) 12 | (defmulti turn-off :type) 13 | 14 | (defmethod turn-on :light [switchable] 15 | (turn-on-light)) 16 | 17 | (defmethod turn-off :light [switchable] 18 | (turn-off-light)) 19 | 20 | (defn engage-switch [switchable] 21 | ;Some other stuff... 22 | (turn-on switchable) 23 | ;Some more other stuff... 24 | (turn-off switchable)) 25 | 26 | 27 | -------------------------------------------------------------------------------- /adapter/turn-on-light/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /adapter/turn-on-light/README.md: -------------------------------------------------------------------------------- 1 | # turn-on-light 2 | -------------------------------------------------------------------------------- /adapter/turn-on-light/project.clj: -------------------------------------------------------------------------------- 1 | (defproject turn-on-light "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main turn-on-light.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /adapter/turn-on-light/spec/turn_on_light/turn_on_spec.clj: -------------------------------------------------------------------------------- 1 | (ns turn-on-light.turn-on-spec 2 | (:require [speclj.core :refer :all] 3 | [turn-on-light.engage-switch :refer :all] 4 | [turn-on-light.variable-light :as v-l] 5 | [turn-on-light.variable-light-adapter :as v-l-adapter])) 6 | 7 | (describe "Adapter" 8 | (with-stubs) 9 | (it "turns light on and off" 10 | (with-redefs [v-l/turn-on-light (stub :turn-on-light)] 11 | (engage-switch (v-l-adapter/make-adapter 5 90)) 12 | (should-have-invoked :turn-on-light {:times 1 :with [90]}) 13 | (should-have-invoked :turn-on-light {:times 1 :with [5]})))) 14 | 15 | 16 | -------------------------------------------------------------------------------- /adapter/turn-on-light/src/turn_on_light/engage_switch.clj: -------------------------------------------------------------------------------- 1 | (ns turn-on-light.engage-switch 2 | (:require [turn-on-light.switchable :as s])) 3 | 4 | (defn engage-switch [switchable] 5 | ;Some other stuff... 6 | (s/turn-on switchable) 7 | ;Some more other stuff... 8 | (s/turn-off switchable)) -------------------------------------------------------------------------------- /adapter/turn-on-light/src/turn_on_light/switchable.clj: -------------------------------------------------------------------------------- 1 | (ns turn-on-light.switchable) 2 | 3 | (defmulti turn-on :type) 4 | (defmulti turn-off :type) -------------------------------------------------------------------------------- /adapter/turn-on-light/src/turn_on_light/variable_light.clj: -------------------------------------------------------------------------------- 1 | (ns turn-on-light.variable-light) 2 | 3 | (defn turn-on-light [intensity] 4 | ;Turn it on with intensity. 5 | ) -------------------------------------------------------------------------------- /adapter/turn-on-light/src/turn_on_light/variable_light_adapter.clj: -------------------------------------------------------------------------------- 1 | (ns turn-on-light.variable-light-adapter 2 | (:require [turn-on-light.switchable :as s] 3 | [turn-on-light.variable-light :as v-l])) 4 | 5 | (defn make-adapter [min-intensity max-intensity] 6 | {:type :variable-light 7 | :min-intensity min-intensity 8 | :max-intensity max-intensity}) 9 | 10 | (defmethod s/turn-on :variable-light [variable-light] 11 | (v-l/turn-on-light (:max-intensity variable-light))) 12 | 13 | (defmethod s/turn-off :variable-light [variable-light] 14 | (v-l/turn-on-light (:min-intensity variable-light))) -------------------------------------------------------------------------------- /command/command.cpp: -------------------------------------------------------------------------------- 1 | class Room {}; 2 | 3 | class Command { 4 | public: 5 | virtual void execute() = 0; 6 | }; 7 | 8 | class UndoableCommand : public Command { 9 | public: 10 | virtual void undo() = 0; 11 | }; 12 | 13 | class CommandWithArgument : public Command { 14 | public: 15 | CommandWithArgument(int argument) 16 | :argument(argument) 17 | {} 18 | 19 | virtual void execute() 20 | {theFunctionToExecute(argument);} 21 | 22 | private: 23 | int argument; 24 | 25 | void theFunctionToExecute(int argument) 26 | { 27 | //do something with that argument! 28 | } 29 | }; 30 | 31 | class AddRoomCommand : public UndoableCommand { 32 | public: 33 | virtual void execute() { 34 | // manage canvas events to add room. 35 | // record what was done in theAddedRoom. 36 | } 37 | 38 | virtual void undo() { 39 | // remove theAddedRoom from the canvas. 40 | } 41 | 42 | private: 43 | Room* theAddedRoom; 44 | }; 45 | -------------------------------------------------------------------------------- /command/command.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/unclebob/FunctionalDesign/e2b99727e3bd7d52aecb41412dcbfc22522acadd/command/command.o -------------------------------------------------------------------------------- /command/command/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /command/command/README.md: -------------------------------------------------------------------------------- 1 | # command 2 | -------------------------------------------------------------------------------- /command/command/project.clj: -------------------------------------------------------------------------------- 1 | (defproject command "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main command.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /command/command/spec/command/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns command.core-spec 2 | (:require [speclj.core :refer :all] 3 | [command.core :refer :all] 4 | [command.add-room-command :as ar])) 5 | 6 | (describe "command" 7 | (with-stubs) 8 | (it "executes the command" 9 | (with-redefs [ar/add-room (stub :add-room {:return :a-room}) 10 | ar/delete-room (stub :delete-room)] 11 | (gui-app [:add-room-action :undo-action]) 12 | (should-have-invoked :add-room) 13 | (should-have-invoked :delete-room {:with [:a-room]})))) 14 | -------------------------------------------------------------------------------- /command/command/src/command/add_room_command.clj: -------------------------------------------------------------------------------- 1 | (ns command.add-room-command 2 | (:require [command.undoable-command :as uc])) 3 | 4 | (defn add-room [] 5 | ;stuff that adds rooms to the canvas 6 | ;and returns the added room 7 | ) 8 | 9 | (defn delete-room [room] 10 | ;stuff that deletes the specified room from the canvas 11 | ) 12 | 13 | (defn make-add-room-command [] 14 | {:type :add-room-command}) 15 | 16 | (defmethod uc/execute :add-room-command [command] 17 | (assoc (make-add-room-command) :the-added-room (add-room))) 18 | 19 | (defmethod uc/undo :add-room-command [command] 20 | (delete-room (:the-added-room command))) -------------------------------------------------------------------------------- /command/command/src/command/core.clj: -------------------------------------------------------------------------------- 1 | (ns command.core 2 | (:require [command.undoable-command :as uc] 3 | [command.add-room-command :as ar])) 4 | 5 | (defn gui-app [actions] 6 | (loop [actions actions 7 | undo-list (list)] 8 | (if (empty? actions) 9 | :DONE 10 | (condp = (first actions) 11 | :add-room-action 12 | (let [executed-command (uc/execute (ar/make-add-room-command))] 13 | (recur (rest actions) 14 | (conj undo-list executed-command))) 15 | 16 | :undo-action 17 | (let [command-to-undo (first undo-list)] 18 | (uc/undo command-to-undo) 19 | (recur (rest actions) 20 | (rest undo-list))) 21 | :TILT)))) 22 | -------------------------------------------------------------------------------- /command/command/src/command/undoable_command.clj: -------------------------------------------------------------------------------- 1 | (ns command.undoable-command) 2 | 3 | (defmulti execute :type) 4 | (defmulti undo :type) 5 | -------------------------------------------------------------------------------- /composite-decorator/composite-shape/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /composite-decorator/composite-shape/README.md: -------------------------------------------------------------------------------- 1 | # composite-shape 2 | -------------------------------------------------------------------------------- /composite-decorator/composite-shape/project.clj: -------------------------------------------------------------------------------- 1 | (defproject composite-shape "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main composite-shape.core 7 | :dependencies [[org.clojure/clojure "1.11.1"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | 10 | :plugins [[speclj "3.3.2"]] 11 | :test-paths ["spec"]) 12 | -------------------------------------------------------------------------------- /composite-decorator/composite-shape/spec/composite_example/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns composite-example.core-spec 2 | (:require [speclj.core :refer :all] 3 | [composite-example 4 | [square :as square] 5 | [shape :as shape] 6 | [circle :as circle] 7 | [composite-shape :as cs] 8 | [journaled-shape :as js]])) 9 | 10 | (describe "square" 11 | (it "translates" 12 | (let [s (square/make-square [3 4] 1) 13 | translated-square (shape/translate s 1 1)] 14 | (should= [4 5] (::square/top-left translated-square)) 15 | (should= 1 (::square/side translated-square)))) 16 | 17 | (it "scales" 18 | (let [s (square/make-square [1 2] 2) 19 | scaled-square (shape/scale s 5)] 20 | (should= [1 2] (::square/top-left scaled-square)) 21 | (should= 10 (::square/side scaled-square))))) 22 | 23 | (describe "circle" 24 | (it "translates" 25 | (let [c (circle/make-circle [3 4] 10) 26 | translated-circle (shape/translate c 2 3)] 27 | (should= [5 7] (::circle/center translated-circle)) 28 | (should= 10 (::circle/radius translated-circle)))) 29 | 30 | (it "scales" 31 | (let [c (circle/make-circle [1 2] 2) 32 | scaled-circle (shape/scale c 5)] 33 | (should= [1 2] (::circle/center scaled-circle)) 34 | (should= 10 (::circle/radius scaled-circle))))) 35 | 36 | (describe "composite shape" 37 | (it "translates" 38 | (let [cs (-> (cs/make) 39 | (cs/add (square/make-square [0 0] 1)) 40 | (cs/add (circle/make-circle [10 10] 10))) 41 | translated-cs (shape/translate cs 3 4)] 42 | (should= #{{::shape/type ::square/square 43 | ::square/top-left [3 4] 44 | ::square/side 1} 45 | {::shape/type ::circle/circle 46 | ::circle/center [13 14] 47 | ::circle/radius 10}} 48 | (set (::cs/shapes translated-cs))))) 49 | 50 | (it "scales" 51 | (let [cs (-> (cs/make) 52 | (cs/add (square/make-square [0 0] 1)) 53 | (cs/add (circle/make-circle [10 10] 10))) 54 | scaled-cs (shape/scale cs 12)] 55 | (should= #{{::shape/type ::square/square 56 | ::square/top-left [0 0] 57 | ::square/side 12} 58 | {::shape/type ::circle/circle 59 | ::circle/center [10 10] 60 | ::circle/radius 120}} 61 | (set (::cs/shapes scaled-cs)))))) 62 | 63 | (describe "journaled shape decorator" 64 | (it "journals scale and translate operations" 65 | (let [jsd (-> (js/make (square/make-square [0 0] 1)) 66 | (shape/translate 2 3) 67 | (shape/scale 5))] 68 | (should= [[:translate 2 3] [:scale 5]] 69 | (::js/journal jsd)) 70 | (should= {::shape/type ::square/square 71 | ::square/top-left [2 3] 72 | ::square/side 5} 73 | (::js/shape jsd))))) 74 | -------------------------------------------------------------------------------- /composite-decorator/composite-shape/src/composite_example/circle.clj: -------------------------------------------------------------------------------- 1 | (ns composite-example.circle 2 | (:require [clojure.spec.alpha :as s] 3 | [composite-example.shape :as shape])) 4 | 5 | (s/def ::center (s/tuple number? number?)) 6 | (s/def ::radius number?) 7 | (s/def ::circle (s/keys :req [::shape/type 8 | ::radius 9 | ::center])) 10 | 11 | (defn make-circle [center radius] 12 | {:post [(s/valid? ::circle %)]} 13 | {::shape/type ::circle 14 | ::center center 15 | ::radius radius}) 16 | 17 | (defmethod shape/translate ::circle [circle dx dy] 18 | {:pre [(s/valid? ::circle circle) 19 | (number? dx) (number? dy)] 20 | :post [(s/valid? ::circle %)]} 21 | (let [[x y] (::center circle)] 22 | (assoc circle ::center [(+ x dx) (+ y dy)]))) 23 | 24 | (defmethod shape/scale ::circle [circle factor] 25 | {:pre [(s/valid? ::circle circle) 26 | (number? factor)] 27 | :post [(s/valid? ::circle %)]} 28 | (let [radius (::radius circle)] 29 | (assoc circle ::radius (* radius factor)))) -------------------------------------------------------------------------------- /composite-decorator/composite-shape/src/composite_example/composite_shape.clj: -------------------------------------------------------------------------------- 1 | (ns composite-example.composite-shape 2 | (:require [clojure.spec.alpha :as s] 3 | [composite-example.shape :as shape])) 4 | 5 | (s/def ::shapes (s/coll-of ::shape/shape-type)) 6 | (s/def ::composite-shape (s/keys :req [::shape/type 7 | ::shapes])) 8 | 9 | (defn make [] 10 | {:post [(s/valid? ::composite-shape %)]} 11 | {::shape/type ::composite-shape 12 | ::shapes []}) 13 | 14 | (defn add [cs shape] 15 | {:pre [(s/valid? ::composite-shape cs) 16 | (s/valid? ::shape/shape-type shape)] 17 | :post [(s/valid? ::composite-shape %)]} 18 | (update cs ::shapes conj shape)) 19 | 20 | (defmethod shape/translate ::composite-shape [cs dx dy] 21 | {:pre [(s/valid? ::composite-shape cs) 22 | (number? dx) (number? dy)] 23 | :post [(s/valid? ::composite-shape %)]} 24 | (let [translated-shapes (map #(shape/translate % dx dy) (::shapes cs))] 25 | (assoc cs ::shapes translated-shapes))) 26 | 27 | (defmethod shape/scale ::composite-shape [cs factor] 28 | {:pre [(s/valid? ::composite-shape cs) 29 | (number? factor)] 30 | :post [(s/valid? ::composite-shape %)]} 31 | (let [scaled-shapes (map #(shape/scale % factor) (::shapes cs))] 32 | (assoc cs ::shapes scaled-shapes))) 33 | -------------------------------------------------------------------------------- /composite-decorator/composite-shape/src/composite_example/journaled_shape.clj: -------------------------------------------------------------------------------- 1 | (ns composite-example.journaled-shape 2 | (:require [composite-example.shape :as shape] 3 | [clojure.spec.alpha :as s])) 4 | 5 | (s/def ::journal-entry (s/or 6 | :translate (s/tuple #{:translate} number? number?) 7 | :scale (s/tuple #{:scale} number?))) 8 | (s/def ::journal (s/coll-of ::journal-entry)) 9 | (s/def ::shape ::shape/shape-type) 10 | (s/def ::journaled-shape (s/and 11 | (s/keys :req [::shape/type 12 | ::journal 13 | ::shape]) 14 | #(= ::journaled-shape (::shape/type %)))) 15 | 16 | (defn make [shape] 17 | {:post [(s/valid? ::journaled-shape %)]} 18 | {::shape/type ::journaled-shape 19 | ::journal [] 20 | ::shape shape}) 21 | 22 | (defmethod shape/translate ::journaled-shape [js dx dy] 23 | {:pre [(s/valid? ::journaled-shape js) 24 | (number? dx) (number? dy)] 25 | :post [(s/valid? ::journaled-shape %)]} 26 | (-> js (update ::journal conj [:translate dx dy]) 27 | (assoc ::shape (shape/translate (::shape js) dx dy))) 28 | ) 29 | 30 | (defmethod shape/scale ::journaled-shape [js factor] 31 | {:pre [(s/valid? ::journaled-shape js) 32 | (number? factor)] 33 | :post [(s/valid? ::journaled-shape %)]} 34 | (-> js (update ::journal conj [:scale factor]) 35 | (assoc ::shape (shape/scale (::shape js) factor)))) 36 | -------------------------------------------------------------------------------- /composite-decorator/composite-shape/src/composite_example/shape.clj: -------------------------------------------------------------------------------- 1 | (ns composite-example.shape 2 | (:require [clojure.spec.alpha :as s])) 3 | 4 | (s/def ::type keyword?) 5 | (s/def ::shape-type (s/keys :req [::type])) 6 | 7 | (defmulti translate (fn [shape dx dy] (::type shape))) 8 | (defmulti scale (fn [shape factor] (::type shape))) -------------------------------------------------------------------------------- /composite-decorator/composite-shape/src/composite_example/square.clj: -------------------------------------------------------------------------------- 1 | (ns composite-example.square 2 | (:require [clojure.spec.alpha :as s] 3 | [composite-example.shape :as shape])) 4 | 5 | (s/def ::top-left (s/tuple number? number?)) 6 | (s/def ::side number?) 7 | (s/def ::square (s/keys :req [::shape/type 8 | ::side 9 | ::top-left])) 10 | 11 | (defn make-square [top-left side] 12 | {:post [(s/valid? ::square %)]} 13 | {::shape/type ::square 14 | ::top-left top-left 15 | ::side side}) 16 | 17 | (defmethod shape/translate ::square [square dx dy] 18 | {:pre [(s/valid? ::square square) 19 | (number? dx) (number? dy)] 20 | :post [(s/assert ::square %)]} 21 | (let [[x y] (::top-left square)] 22 | (assoc square ::top-left [(+ x dx) (+ y dy)]))) 23 | 24 | (defmethod shape/scale ::square [square factor] 25 | {:pre [(s/valid? ::square square) 26 | (number? factor)] 27 | :post [(s/valid? ::square %)]} 28 | (let [side (::side square)] 29 | (assoc square ::side (* side factor)))) -------------------------------------------------------------------------------- /composite-decorator/composite-switchable/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /composite-decorator/composite-switchable/README.md: -------------------------------------------------------------------------------- 1 | # composite-switchable 2 | -------------------------------------------------------------------------------- /composite-decorator/composite-switchable/project.clj: -------------------------------------------------------------------------------- 1 | (defproject composite-switchable "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main composite-switchable.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /composite-decorator/composite-switchable/spec/composite_example/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns composite-example.core-spec 2 | (:require [speclj.core :refer :all] 3 | [composite-example 4 | [light :as l] 5 | [variable-light :as v] 6 | [switchable :as s] 7 | [composite-switchable :as cs]])) 8 | 9 | (describe "composite-switchable" 10 | (with-stubs) 11 | (it "turns all on" 12 | (with-redefs [l/turn-on-light (stub :turn-on-light) 13 | v/set-light-intensity (stub :set-light-intensity)] 14 | (let [group (-> (cs/make-composite-switchable) 15 | (cs/add (l/make-light)) 16 | (cs/add (v/make-variable-light)))] 17 | (s/turn-on group) 18 | (should-have-invoked :turn-on-light) 19 | (should-have-invoked :set-light-intensity {:with [100]}))))) 20 | -------------------------------------------------------------------------------- /composite-decorator/composite-switchable/src/composite_example/composite_switchable.clj: -------------------------------------------------------------------------------- 1 | (ns composite-example.composite-switchable 2 | (:require [composite-example.switchable :as s])) 3 | 4 | (defn make-composite-switchable [] 5 | {:type :composite-switchable 6 | :switchables []}) 7 | 8 | (defn add [composite-switchable switchable] 9 | (update composite-switchable :switchables conj switchable)) 10 | 11 | (defmethod s/turn-on :composite-switchable [c-switchable] 12 | (doseq [s-able (:switchables c-switchable)] 13 | (s/turn-on s-able))) 14 | 15 | (defmethod s/turn-off :composite-switchable [c-switchable] 16 | (doseq [s-able (:switchables c-switchable)] 17 | (s/turn-off s-able))) 18 | -------------------------------------------------------------------------------- /composite-decorator/composite-switchable/src/composite_example/core.clj: -------------------------------------------------------------------------------- 1 | (ns composite-switchable.core) 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /composite-decorator/composite-switchable/src/composite_example/light.clj: -------------------------------------------------------------------------------- 1 | (ns composite-example.light 2 | (:require [composite-example.switchable :as s])) 3 | 4 | (defn make-light [] {:type :light}) 5 | 6 | (defn turn-on-light []) 7 | (defn turn-off-light []) 8 | 9 | (defmethod s/turn-on :light [switchable] 10 | (turn-on-light)) 11 | 12 | (defmethod s/turn-off :light [switchable] 13 | (turn-off-light)) -------------------------------------------------------------------------------- /composite-decorator/composite-switchable/src/composite_example/switchable.clj: -------------------------------------------------------------------------------- 1 | (ns composite-example.switchable) 2 | 3 | (defmulti turn-on :type) 4 | (defmulti turn-off :type) -------------------------------------------------------------------------------- /composite-decorator/composite-switchable/src/composite_example/variable_light.clj: -------------------------------------------------------------------------------- 1 | (ns composite-example.variable-light 2 | (:require [composite-example.switchable :as s])) 3 | 4 | (defn make-variable-light [] {:type :variable-light}) 5 | 6 | (defn set-light-intensity [intensity]) 7 | 8 | (defmethod s/turn-on :variable-light [switchable] 9 | (set-light-intensity 100)) 10 | 11 | (defmethod s/turn-off :variable-light [switchable] 12 | (set-light-intensity 0)) 13 | -------------------------------------------------------------------------------- /composite-decorator/compositeJava/src/composite/CompositeSwitchable.java: -------------------------------------------------------------------------------- 1 | package composite; 2 | 3 | import java.util.ArrayList; 4 | import java.util.List; 5 | 6 | public class CompositeSwitchable implements Switchable { 7 | private List switchables = new ArrayList<>(); 8 | 9 | public void addSwitchable(Switchable s) { 10 | switchables.add(s): 11 | } 12 | 13 | public void turnOn() { 14 | for (var s : switchables) 15 | s.turnOn(); 16 | } 17 | 18 | public void turnOff() { 19 | for (var s : switchables) 20 | s.turnOff(); 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /composite-decorator/compositeJava/src/composite/Switchable.java: -------------------------------------------------------------------------------- 1 | package composite; 2 | 3 | public interface Switchable { 4 | public void turnOn(); 5 | public void turnOff(); 6 | } 7 | -------------------------------------------------------------------------------- /dip/video-store/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /dip/video-store/README.md: -------------------------------------------------------------------------------- 1 | # video-store 2 | -------------------------------------------------------------------------------- /dip/video-store/project.clj: -------------------------------------------------------------------------------- 1 | (defproject video-store "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main video-store.core 7 | :dependencies [[org.clojure/clojure "1.11.1"] 8 | [org.clojure/test.check "1.1.1"]] 9 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 10 | :plugins [[speclj "3.3.2"]] 11 | :test-paths ["spec"]) 12 | -------------------------------------------------------------------------------- /dip/video-store/spec/video_store/constructors_spec.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.constructors-spec 2 | (:require [speclj.core :refer :all] 3 | [video-store.constructors :refer :all :as constructors] 4 | [clojure.spec.alpha :as s])) 5 | 6 | (describe "constructors" 7 | (it "creates valid customer" 8 | (should-be-nil 9 | (s/explain-data 10 | ::constructors/customer 11 | (make-customer "CUSTOMER")))) 12 | 13 | (it "creates valid movie" 14 | (should-be-nil 15 | (s/explain-data 16 | ::constructors/movie 17 | (make-movie "title" :regular)))) 18 | 19 | (it "creates valid rental" 20 | (should-be-nil 21 | (s/explain-data 22 | ::constructors/rental 23 | (make-rental (make-movie "title" :new-release) 24 | 32)))) 25 | 26 | (it "creates valid rental orders" 27 | (should-be-nil 28 | (s/explain-data 29 | ::constructors/rental-order 30 | (make-rental-order 31 | (make-customer "CUSTOMER") 32 | [(make-rental 33 | (make-movie "title" :regular) 3)]))))) 34 | -------------------------------------------------------------------------------- /dip/video-store/spec/video_store/integration_specs.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.integration-specs 2 | (:require [speclj.core :refer :all] 3 | [video-store.constructors :refer :all] 4 | [video-store.text-statement_formatter :refer :all] 5 | [video-store.normal-statement-policy :refer :all] 6 | [video-store.order-processing :refer :all])) 7 | 8 | (declare rental-order) 9 | 10 | (describe "Integration Tests" 11 | (with rental-order (make-rental-order 12 | (make-customer "Fred") 13 | [(make-rental 14 | (make-movie "Plan 9 from Outer Space" :regular) 15 | 1) 16 | (make-rental 17 | (make-movie "8 1/2", :regular) 18 | 2) 19 | (make-rental 20 | (make-movie "Eraserhead" :regular) 21 | 3)])) 22 | (it "formats a text statement" 23 | (should= (str "Rental Record for Fred\n" 24 | "\tPlan 9 from Outer Space\t2.0\n" 25 | "\t8 1/2\t2.0\n" 26 | "\tEraserhead\t3.5\n" 27 | "You owed 7.5\n" 28 | "You earned 3 frequent renter points\n") 29 | (process-order 30 | (make-normal-policy) 31 | (make-text-formatter) 32 | @rental-order)))) -------------------------------------------------------------------------------- /dip/video-store/spec/video_store/quick_check.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.quick-check 2 | (:require [speclj.core :refer :all] 3 | [video-store.constructors :refer :all :as constructors] 4 | [video-store.normal-statement-policy :refer :all] 5 | [video-store.buy-two-get-one-free-policy :refer :all] 6 | [video-store.statement-policy :refer :all :as policy] 7 | [clojure.test.check :as tc] 8 | [clojure.test.check.generators :as gen] 9 | [clojure.test.check.properties :as prop] 10 | [clojure.spec.alpha :as s])) 11 | 12 | (def gen-customer-name (gen/such-that not-empty gen/string-alphanumeric)) 13 | 14 | (def gen-customer 15 | (gen/fmap (fn [name] {:name name}) gen-customer-name)) 16 | 17 | (def gen-days (gen/elements (range 1 100))) 18 | 19 | (def gen-movie-type (gen/elements [:regular :childrens :new-release])) 20 | 21 | (def gen-movie 22 | (gen/fmap (fn [[title type]] {:title title :type type}) 23 | (gen/tuple gen/string-alphanumeric gen-movie-type))) 24 | 25 | (def gen-rental 26 | (gen/fmap (fn [[movie days]] {:movie movie :days days}) 27 | (gen/tuple gen-movie gen-days))) 28 | 29 | (def gen-rentals (gen/such-that not-empty (gen/vector gen-rental))) 30 | 31 | (def gen-rental-order 32 | (gen/fmap (fn [[customer rentals]] {:customer customer :rentals rentals}) 33 | (gen/tuple gen-customer gen-rentals))) 34 | 35 | (declare rental-order normal b2g1f) 36 | 37 | (describe "Quick check statement policy" 38 | (with normal (make-normal-policy)) 39 | (with b2g1f (make-buy-two-get-one-free-policy)) 40 | 41 | (it "generates valid rental orders" 42 | (should-be 43 | :result 44 | (tc/quick-check 45 | 100 46 | (prop/for-all 47 | [rental-order gen-rental-order] 48 | (nil? 49 | (s/explain-data 50 | ::constructors/rental-order 51 | rental-order)))))) 52 | 53 | (it "produces valid statement data" 54 | (should-be 55 | :result 56 | (tc/quick-check 57 | 100 58 | (prop/for-all 59 | [rental-order gen-rental-order] 60 | (nil? 61 | (s/explain-data 62 | ::policy/statement-data 63 | (make-statement-data @normal rental-order))))))) 64 | 65 | (it "statement data totals are consistent under normal policy" 66 | (should-be 67 | :result 68 | (tc/quick-check 69 | 100 70 | (prop/for-all 71 | [rental-order gen-rental-order] 72 | (let [statement-data (make-statement-data @normal rental-order) 73 | prices (map :price (:movies statement-data)) 74 | owed (:owed statement-data)] 75 | (= owed (reduce + prices))))))) 76 | 77 | (it "statement data totals are consistent under buy-two-get-one-free policy" 78 | (should-be 79 | :result 80 | (tc/quick-check 81 | 100 82 | (prop/for-all 83 | [rental-order gen-rental-order] 84 | (let [statement-data (make-statement-data @b2g1f rental-order) 85 | prices (map :price (:movies statement-data)) 86 | owed (:owed statement-data)] 87 | (if (> (count prices) 2) 88 | (= owed (reduce + (drop 1 (sort prices)))) 89 | (= owed (reduce + prices))))))))) 90 | 91 | 92 | 93 | -------------------------------------------------------------------------------- /dip/video-store/spec/video_store/statement_formatter_spec.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.statement-formatter-spec 2 | (:require [speclj.core :refer :all] 3 | [video-store.statement-formatter :refer :all] 4 | [video-store.text-statement_formatter :refer :all] 5 | [video-store.html-statement-formatter :refer :all])) 6 | 7 | (declare statement-data) 8 | 9 | (describe "Rental Statement Format" 10 | (with statement-data {:customer-name "CUSTOMER" 11 | :movies [{:title "MOVIE" 12 | :price 9.9}] 13 | :owed 100.0 14 | :points 99}) 15 | (it "Formats a text rental statement" 16 | (should= (str "Rental Record for CUSTOMER\n" 17 | "\tMOVIE\t9.9\n" 18 | "You owed 100.0\n" 19 | "You earned 99 frequent renter points\n") 20 | (format-rental-statement 21 | (make-text-formatter) 22 | @statement-data 23 | ))) 24 | 25 | (it "Formats an html rental statement" 26 | (should= (str "

Rental Record for CUSTOMER

" 27 | "" 28 | "" 29 | "
MOVIE9.9
" 30 | "You owed 100.0
" 31 | "You earned 99 frequent renter points") 32 | (format-rental-statement 33 | (make-html-formatter) 34 | @statement-data)))) -------------------------------------------------------------------------------- /dip/video-store/spec/video_store/statement_policy_spec.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.statement-policy-spec 2 | (:require [speclj.core :refer :all] 3 | [video-store.constructors :refer :all] 4 | [video-store.statement-policy :refer :all :as policy] 5 | [video-store.normal-statement-policy :refer :all] 6 | [video-store.buy-two-get-one-free-policy :refer :all] 7 | [clojure.spec.alpha :as s])) 8 | 9 | (declare customer normal-policy formatter) 10 | (declare new-release-1 new-release-2 childrens) 11 | (declare regular-1 regular-2 regular-3) 12 | 13 | (describe "Rental Statement Calculation" 14 | (with customer (make-customer "CUSTOMER")) 15 | (with normal-policy (make-normal-policy)) 16 | (with new-release-1 (make-movie "new release 1" :new-release)) 17 | (with new-release-2 (make-movie "new release 2" :new-release)) 18 | (with childrens (make-movie "childrens" :childrens)) 19 | (with regular-1 (make-movie "regular 1" :regular)) 20 | (with regular-2 (make-movie "regular 2" :regular)) 21 | (with regular-3 (make-movie "regular 3" :regular)) 22 | (context "normal policy" 23 | (it "makes statement for a single new release" 24 | (let [statement-data (make-statement-data 25 | @normal-policy 26 | (make-rental-order 27 | @customer 28 | [(make-rental @new-release-1 3)]))] 29 | (should-be-nil (s/explain-data ::policy/statement-data statement-data)) 30 | (should= {:customer-name "CUSTOMER" 31 | :movies [{:title "new release 1" 32 | :price 9.0}] 33 | :owed 9.0 34 | :points 2} 35 | statement-data))) 36 | 37 | (it "makes statement for two new releases" 38 | (should= {:customer-name "CUSTOMER", 39 | :movies [{:title "new release 1", :price 9.0} 40 | {:title "new release 2", :price 9.0}], 41 | :owed 18.0, 42 | :points 4} 43 | (make-statement-data 44 | @normal-policy 45 | (make-rental-order 46 | @customer 47 | [(make-rental @new-release-1 3) 48 | (make-rental @new-release-2 3)])))) 49 | 50 | (it "makes statement for one childrens movie" 51 | (should= {:customer-name "CUSTOMER", 52 | :movies [{:title "childrens", :price 1.5}], 53 | :owed 1.5, 54 | :points 1} 55 | (make-statement-data 56 | @normal-policy 57 | (make-rental-order 58 | @customer 59 | [(make-rental @childrens 3)])))) 60 | 61 | (it "makes statement for several regular movies" 62 | (should= {:customer-name "CUSTOMER", 63 | :movies [{:title "regular 1", :price 2.0} 64 | {:title "regular 2", :price 2.0} 65 | {:title "regular 3", :price 3.5}], 66 | :owed 7.5, 67 | :points 3} 68 | (make-statement-data 69 | @normal-policy 70 | (make-rental-order 71 | @customer 72 | [(make-rental @regular-1 1) 73 | (make-rental @regular-2 2) 74 | (make-rental @regular-3 3)]))))) 75 | 76 | (context "Buy two get one free policy" 77 | (it "makes statement for several regular movies" 78 | (should= {:customer-name "CUSTOMER", 79 | :movies [{:title "regular 1", :price 2.0} 80 | {:title "regular 2", :price 2.0} 81 | {:title "new release 1", :price 3.0}], 82 | :owed 5.0, 83 | :points 3} 84 | (make-statement-data 85 | (make-buy-two-get-one-free-policy) 86 | (make-rental-order 87 | @customer 88 | [(make-rental @regular-1 1) 89 | (make-rental @regular-2 1) 90 | (make-rental @new-release-1 1)])))))) -------------------------------------------------------------------------------- /dip/video-store/src/video_store/buy_two_get_one_free_policy.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.buy-two-get-one-free-policy 2 | (:require [video-store.statement-policy :refer :all] 3 | [video-store.normal-statement-policy :as normal])) 4 | 5 | (derive ::buy-two-get-one-free ::normal/normal) 6 | 7 | (defn make-buy-two-get-one-free-policy [] {:type ::buy-two-get-one-free}) 8 | 9 | (defmethod total-amount ::buy-two-get-one-free [policy rentals] 10 | (let [amounts (map #(determine-amount policy %) rentals)] 11 | (if (> (count amounts) 2) 12 | (reduce + (drop 1 (sort amounts))) 13 | (reduce + amounts)))) 14 | -------------------------------------------------------------------------------- /dip/video-store/src/video_store/constructors.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.constructors 2 | (:require [clojure.spec.alpha :as s])) 3 | 4 | (s/def ::name string?) 5 | (s/def ::customer (s/keys :req-un [name])) 6 | (s/def ::title string?) 7 | (s/def ::type #{:regular :childrens :new-release}) 8 | (s/def ::movie (s/keys :req-un [::title ::type])) 9 | (s/def ::days pos-int?) 10 | (s/def ::rental (s/keys :req-un [::days ::movie])) 11 | (s/def ::rentals (s/coll-of ::rental)) 12 | (s/def ::rental-order (s/keys :req-un [::customer ::rentals])) 13 | 14 | (defn make-customer [name] 15 | {:name name}) 16 | 17 | (defn make-movie [title type] 18 | {:title title 19 | :type type}) 20 | 21 | (defn make-rental [movie days] 22 | {:movie movie 23 | :days days}) 24 | 25 | (defn make-rental-order [customer rentals] 26 | {:customer customer 27 | :rentals rentals}) 28 | -------------------------------------------------------------------------------- /dip/video-store/src/video_store/html_statement_formatter.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.html-statement-formatter 2 | (:require [video-store.statement-formatter :refer :all])) 3 | 4 | (defn make-html-formatter [] {:type ::html}) 5 | 6 | (defmethod format-rental-statement ::html [_formatter statement-data] 7 | (let [customer-name (:customer-name statement-data) 8 | movies (:movies statement-data) 9 | owed (:owed statement-data) 10 | points (:points statement-data)] 11 | (str 12 | (format "

Rental Record for %s

" customer-name) 13 | "" 14 | (apply str 15 | (for [movie movies] 16 | (format "" 17 | (:title movie) (:price movie)))) 18 | "
%s%.1f
" 19 | (format "You owed %.1f
" owed) 20 | (format "You earned %d frequent renter points" points)))) -------------------------------------------------------------------------------- /dip/video-store/src/video_store/normal_statement_policy.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.normal-statement-policy 2 | (:require [video-store.statement-policy :refer :all])) 3 | 4 | (defn make-normal-policy [] {:type ::normal}) 5 | 6 | (defmethod determine-amount [::normal :regular] [_policy rental] 7 | (let [days (:days rental)] 8 | (if (> days 2) 9 | (+ 2.0 (* (- days 2) 1.5)) 10 | 2.0))) 11 | 12 | (defmethod determine-amount [::normal :childrens] [_policy rental] 13 | (let [days (:days rental)] 14 | (if (> days 3) 15 | (+ 1.5 (* (- days 3) 1.5)) 16 | 1.5))) 17 | 18 | (defmethod determine-amount [::normal :new-release] [_policy rental] 19 | (* 3.0 (:days rental))) 20 | 21 | (defmethod determine-points [::normal :regular] [_policy _rental] 22 | 1) 23 | 24 | (defmethod determine-points [::normal :new-release] [_policy rental] 25 | (if (> (:days rental) 1) 2 1)) 26 | 27 | (defmethod determine-points [::normal :childrens] [_policy _rental] 28 | 1) 29 | 30 | (defmethod total-amount ::normal [policy rentals] 31 | (reduce + (map #(determine-amount policy %) rentals))) 32 | 33 | (defmethod total-points ::normal [policy rentals] 34 | (reduce + (map #(determine-points policy %) rentals))) 35 | 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /dip/video-store/src/video_store/order_processing.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.order-processing 2 | (:require [video-store.statement-formatter :refer :all] 3 | [video-store.statement-policy :refer :all])) 4 | 5 | (defn process-order [policy formatter order] 6 | (->> order 7 | (make-statement-data policy) 8 | (format-rental-statement formatter))) -------------------------------------------------------------------------------- /dip/video-store/src/video_store/statement_formatter.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.statement-formatter) 2 | 3 | (defmulti format-rental-statement (fn [formatter _statement-data] 4 | (:type formatter))) 5 | 6 | -------------------------------------------------------------------------------- /dip/video-store/src/video_store/statement_policy.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.statement-policy 2 | (:require [clojure.spec.alpha :as s])) 3 | 4 | (s/def ::customer-name string?) 5 | (s/def ::title string?) 6 | (s/def ::price pos?) 7 | (s/def ::movie (s/keys :req-un [::title ::price])) 8 | (s/def ::movies (s/coll-of ::movie)) 9 | (s/def ::owed pos?) 10 | (s/def ::points pos-int?) 11 | (s/def ::statement-data (s/keys :req-un [::customer-name 12 | ::movies 13 | ::owed 14 | ::points])) 15 | 16 | (defn- policy-movie-dispatch [policy rental] 17 | [(:type policy) (-> rental :movie :type)]) 18 | 19 | (defmulti determine-amount policy-movie-dispatch) 20 | (defmulti determine-points policy-movie-dispatch) 21 | (defmulti total-amount (fn [policy _rentals] (:type policy))) 22 | (defmulti total-points (fn [policy _rentals] (:type policy))) 23 | 24 | (defn make-statement-data [policy rental-order] 25 | (let [{:keys [name]} (:customer rental-order) 26 | {:keys [rentals]} rental-order] 27 | {:customer-name name 28 | :movies (for [rental rentals] 29 | {:title (:title (:movie rental)) 30 | :price (determine-amount policy rental)}) 31 | :owed (total-amount policy rentals) 32 | :points (total-points policy rentals)})) 33 | 34 | 35 | -------------------------------------------------------------------------------- /dip/video-store/src/video_store/text_statement_formatter.clj: -------------------------------------------------------------------------------- 1 | (ns video-store.text-statement_formatter 2 | (:require [video-store.statement-formatter :refer :all])) 3 | 4 | (defn make-text-formatter [] {:type ::text}) 5 | 6 | (defmethod format-rental-statement ::text [_formatter statement-data] 7 | (let [customer-name (:customer-name statement-data) 8 | movies (:movies statement-data) 9 | owed (:owed statement-data) 10 | points (:points statement-data)] 11 | (str 12 | (format "Rental Record for %s\n" customer-name) 13 | (apply str 14 | (for [movie movies] 15 | (format "\t%s\t%.1f\n" (:title movie) (:price movie)))) 16 | (format "You owed %.1f\n" owed) 17 | (format "You earned %d frequent renter points\n" points)))) -------------------------------------------------------------------------------- /functional-payroll/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /functional-payroll/README.md: -------------------------------------------------------------------------------- 1 | # functional-payroll 2 | -------------------------------------------------------------------------------- /functional-payroll/project.clj: -------------------------------------------------------------------------------- 1 | (defproject functional-payroll "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main functional-payroll.core 7 | :dependencies [[org.clojure/clojure "1.9.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /functional-payroll/spec/functional_payroll/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns functional-payroll.core-spec 2 | (:require [speclj.core :refer :all] 3 | [functional-payroll.payroll :refer :all] 4 | [functional-payroll.payroll-implementation] 5 | [functional-payroll.payroll-interface :as i] 6 | [clojure.spec.alpha :as s]) 7 | (:import (java.text SimpleDateFormat))) 8 | 9 | (defn parse-date [date-string] 10 | (let [sdf (SimpleDateFormat. "MMM dd yyyy")] 11 | (.parse sdf date-string))) 12 | 13 | (describe "payroll" 14 | (it "pays no one if no one is ready" 15 | (let [employees [] 16 | db {:employees employees} 17 | today (parse-date "Nov 14 2022")] 18 | (should (s/valid? ::i/db db)) 19 | (let [paycheck-directives (payroll today db)] 20 | (should (s/valid? ::i/paycheck-directives paycheck-directives)) 21 | (should= [] paycheck-directives)))) 22 | 23 | (it "pays one salaried employee at end of month by mail" 24 | (let [employees [{:id "emp1" 25 | :schedule :monthly 26 | :pay-class [:salaried 5000] 27 | :disposition [:mail "name" "home"]}] 28 | db {:employees employees} 29 | today (parse-date "Nov 30 2021")] 30 | (should (s/valid? ::i/db db)) 31 | (let [paycheck-directives (payroll today db)] 32 | (should (s/valid? ::i/paycheck-directives paycheck-directives)) 33 | (should= [{:type :mail 34 | :id "emp1" 35 | :name "name" 36 | :address "home" 37 | :amount 5000}] 38 | paycheck-directives)))) 39 | 40 | (it "pays one hourly employee on Friday by Direct Deposit" 41 | (let [employees [{:id "empid" 42 | :schedule :weekly 43 | :pay-class [:hourly 15] 44 | :disposition [:deposit "routing" "account"]}] 45 | time-cards {"empid" [["Nov 12 2022" 80/10]]} 46 | db {:employees employees :time-cards time-cards} 47 | friday (parse-date "Nov 18 2022")] 48 | (should (s/valid? ::i/db db)) 49 | (let [paycheck-directives (payroll friday db)] 50 | (should (s/valid? ::i/paycheck-directives paycheck-directives)) 51 | (should= [{:type :deposit 52 | :id "empid" 53 | :routing "routing" 54 | :account "account" 55 | :amount 120}] 56 | paycheck-directives)))) 57 | 58 | (it "pays one commissioned employee on an even Friday by Paymaster" 59 | (let [employees [{:id "empid" 60 | :schedule :biweekly 61 | :pay-class [:commissioned 100 5/100] 62 | :disposition [:paymaster "paymaster"]}] 63 | sales-receipts {"empid" [["Nov 12 2022" 15000]]} 64 | db {:employees employees :sales-receipts sales-receipts} 65 | friday (parse-date "Nov 18 2022")] 66 | (should (s/valid? ::i/db db)) 67 | (let [paycheck-directives (payroll friday db)] 68 | (should (s/valid? ::i/paycheck-directives paycheck-directives)) 69 | (should= [{:type :paymaster 70 | :id "empid" 71 | :paymaster "paymaster" 72 | :amount 850}] 73 | (payroll friday db))))) 74 | 75 | ) 76 | 77 | -------------------------------------------------------------------------------- /functional-payroll/src/functional_payroll/payroll.clj: -------------------------------------------------------------------------------- 1 | (ns functional-payroll.payroll 2 | (:require [functional-payroll.payroll-interface :refer :all])) 3 | 4 | (defn create-paycheck-directives [ids payments dispositions] 5 | (map #(assoc {} :id %1 :amount %2 :disposition %3) 6 | ids payments dispositions)) 7 | 8 | (defn get-employees-to-be-paid-today [today employees] 9 | (filter #(is-today-payday % today) employees)) 10 | 11 | (defn send-paychecks [ids payments dispositions] 12 | (for [paycheck-directive (create-paycheck-directives ids payments dispositions)] 13 | (dispose paycheck-directive))) 14 | 15 | (defn get-paycheck-amounts [employees] 16 | (map calc-pay employees)) 17 | 18 | (defn get-dispositions [employees] 19 | (map :disposition employees)) 20 | 21 | (defn get-ids [employees] 22 | (map :id employees)) 23 | 24 | (defn- build-employee [db employee] 25 | (assoc employee :db db)) 26 | 27 | (defn get-employees [db] 28 | (map (partial build-employee db) (:employees db))) 29 | 30 | (defn payroll [today db] 31 | (let [employees (get-employees db) 32 | employees-to-pay (get-employees-to-be-paid-today today employees) 33 | amounts (get-paycheck-amounts employees-to-pay) 34 | ids (get-ids employees) 35 | dispositions (get-dispositions employees-to-pay)] 36 | (send-paychecks ids amounts dispositions))) 37 | 38 | -------------------------------------------------------------------------------- /functional-payroll/src/functional_payroll/payroll_implementation.clj: -------------------------------------------------------------------------------- 1 | (ns functional-payroll.payroll-implementation 2 | (:require [functional-payroll.payroll-interface :refer [is-today-payday 3 | calc-pay 4 | dispose]])) 5 | 6 | (defn- is-last-day-of-month [date] 7 | true) 8 | 9 | (defmethod is-today-payday :monthly [employee today] 10 | (is-last-day-of-month today)) 11 | 12 | (defn- is-friday [date] 13 | true) 14 | 15 | (defmethod is-today-payday :weekly [employee today] 16 | (is-friday today)) 17 | 18 | (defn- is-even-friday [today] 19 | true) 20 | 21 | (defmethod is-today-payday :biweekly [employee today] 22 | (is-even-friday today)) 23 | 24 | (defn- get-salary [employee] 25 | (second (:pay-class employee))) 26 | 27 | (defmethod calc-pay :salaried [employee] 28 | (get-salary employee)) 29 | 30 | (defmethod calc-pay :hourly [employee] 31 | (let [db (:db employee) 32 | time-cards (:time-cards db) 33 | my-time-cards (get time-cards (:id employee)) 34 | [_ hourly-rate] (:pay-class employee) 35 | hours (map second my-time-cards) 36 | total-hours (reduce + hours)] 37 | (* total-hours hourly-rate))) 38 | 39 | (defmethod calc-pay :commissioned [employee] 40 | (let [db (:db employee) 41 | sales-receipts (:sales-receipts db) 42 | my-sales-receipts (get sales-receipts (:id employee)) 43 | [_ base-pay commission-rate] (:pay-class employee) 44 | sales (map second my-sales-receipts) 45 | total-sales (reduce + sales)] 46 | (+ (* total-sales commission-rate) base-pay))) 47 | 48 | (defmethod dispose :mail [{:keys [id amount disposition]}] 49 | {:type :mail 50 | :id id 51 | :name (nth disposition 1) 52 | :address (nth disposition 2) 53 | :amount amount}) 54 | 55 | (defmethod dispose :deposit [{:keys [id amount disposition]}] 56 | {:type :deposit 57 | :id id 58 | :routing (nth disposition 1) 59 | :account (nth disposition 2) 60 | :amount amount}) 61 | 62 | (defmethod dispose :paymaster [{:keys [id amount disposition]}] 63 | {:type :paymaster 64 | :id id 65 | :amount amount 66 | :paymaster (nth disposition 1)} 67 | ) 68 | 69 | -------------------------------------------------------------------------------- /functional-payroll/src/functional_payroll/payroll_interface.clj: -------------------------------------------------------------------------------- 1 | (ns functional-payroll.payroll-interface 2 | (:require [clojure.spec.alpha :as s])) 3 | 4 | (defn- get-pay-class [employee] 5 | (first (:pay-class employee))) 6 | 7 | (defn- get-disposition [paycheck-directive] 8 | (first (:disposition paycheck-directive))) 9 | 10 | (defmulti is-today-payday :schedule) 11 | (defmulti calc-pay get-pay-class) 12 | (defmulti dispose get-disposition) 13 | 14 | (s/def ::id string?) 15 | (s/def ::schedule #{:monthly :weekly :biweekly}) 16 | (s/def ::salaried-pay-class (s/tuple #(= % :salaried) pos?)) 17 | (s/def ::hourly-pay-class (s/tuple #(= % :hourly) pos?)) 18 | (s/def ::commissioned-pay-class (s/tuple #(= % :commissioned) pos? pos?)) 19 | (s/def ::pay-class (s/or :salaried ::salaried-pay-class 20 | :hourly ::hourly-pay-class 21 | :commissioned ::commissioned-pay-class)) 22 | 23 | (s/def ::mail-disposition (s/tuple #(= % :mail) string? string?)) 24 | (s/def ::deposit-disposition (s/tuple #(= % :deposit) string? string?)) 25 | (s/def ::paymaster-disposition (s/tuple #(= % :paymaster) string?)) 26 | (s/def ::disposition (s/or :mail ::mail-disposition 27 | :deposit ::deposit-disposition 28 | :paymaster ::paymaster-disposition)) 29 | 30 | (s/def ::employee (s/keys :req-un [::id ::schedule ::pay-class ::disposition])) 31 | (s/def ::employees (s/coll-of ::employee)) 32 | 33 | (s/def ::date string?) 34 | (s/def ::time-card (s/tuple ::date pos?)) 35 | (s/def ::time-cards (s/map-of ::id (s/coll-of ::time-card))) 36 | 37 | (s/def ::sales-receipt (s/tuple ::date pos?)) 38 | (s/def ::sales-receipts (s/map-of ::id (s/coll-of ::sales-receipt))) 39 | 40 | (s/def ::db (s/keys :req-un [::employees] 41 | :opt-un [::time-cards ::sales-receipts])) 42 | 43 | (s/def ::amount pos?) 44 | (s/def ::name string?) 45 | (s/def ::address string?) 46 | (s/def ::mail-directive (s/and #(= (:type %) :mail) 47 | (s/keys :req-un [::id ::name ::address ::amount]))) 48 | 49 | (s/def ::routing string?) 50 | (s/def ::account string?) 51 | (s/def ::deposit-directive (s/and #(= (:type %) :deposit) 52 | (s/keys :req-un [::id ::routing ::account ::amount]))) 53 | 54 | (s/def ::paymaster string?) 55 | (s/def ::paymaster-directive (s/and #(= (:type %) :paymaster) 56 | (s/keys :req-un [::id ::paymaster ::amount]))) 57 | 58 | (s/def ::paycheck-directive (s/or :mail ::mail-directive 59 | :deposit ::deposit-directive 60 | :paymaster ::paymaster-directive)) 61 | 62 | (s/def ::paycheck-directives (s/coll-of ::paycheck-directive)) 63 | 64 | 65 | 66 | -------------------------------------------------------------------------------- /gui/turtle-graphics/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /gui/turtle-graphics/README.md: -------------------------------------------------------------------------------- 1 | # turtle-graphics 2 | 3 | A simple graphics tool loosely based on LOGO turtle graphics. 4 | -------------------------------------------------------------------------------- /gui/turtle-graphics/project.clj: -------------------------------------------------------------------------------- 1 | (defproject Turtle "0.1.0-SNAPSHOT" 2 | :description "Turtle Graphics Processor" 3 | :main turtle-graphics.core 4 | :dependencies [[org.clojure/clojure "1.11.1"] 5 | [quil "4.0.0-SNAPSHOT"] 6 | [org.clojure/core.async "1.6.673"] 7 | [org.clojure/tools.namespace "1.3.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /gui/turtle-graphics/spec/turtle_graphics/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns turtle-graphics.core-spec 2 | (:require [speclj.core :refer :all])) 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /gui/turtle-graphics/spec/turtle_graphics/turtle_spec.clj: -------------------------------------------------------------------------------- 1 | (ns turtle-graphics.turtle-spec 2 | (:require [speclj.core :refer :all] 3 | [turtle-graphics.turtle :as t])) 4 | 5 | (declare turtle) 6 | 7 | (defn heading [turtle heading] 8 | (assoc turtle :heading heading)) 9 | 10 | (defn velocity [turtle velocity] 11 | (assoc turtle :velocity velocity)) 12 | 13 | (defn position [turtle position] 14 | (assoc turtle :position position)) 15 | 16 | (defn distance [turtle distance] 17 | (assoc turtle :distance distance)) 18 | 19 | (defn omega [turtle omega] 20 | (assoc turtle :omega omega)) 21 | 22 | (defn angle [turtle angle] 23 | (assoc turtle :angle angle)) 24 | 25 | (defn state [turtle state] 26 | (assoc turtle :state state)) 27 | 28 | 29 | (describe "Turtle Update" 30 | (with turtle (-> (t/make) (position [1.0 1.0]) (heading 1.0))) 31 | (context "position update" 32 | (it "holds position when there's no velocity" 33 | (let [turtle (-> @turtle (velocity 0.0) (state :idle)) 34 | new-turtle (t/update-turtle turtle)] 35 | (should= turtle new-turtle))) 36 | 37 | (it "steps by velocity when distance is far" 38 | (let [turtle (-> @turtle 39 | (heading 0.0) 40 | (velocity 5.0) 41 | (distance 100.0) 42 | (state :busy) 43 | ) 44 | {:keys [position state velocity distance]} (t/update-turtle turtle)] 45 | (should= [6.0 1.0] position) 46 | (should= 5.0 velocity) 47 | (should= 95.0 distance) 48 | (should= :busy state))) 49 | 50 | (it "steps back by velocity when distance is far" 51 | (let [turtle (-> @turtle 52 | (heading 0.0) 53 | (velocity -5.0) 54 | (distance 100.0) 55 | (state :busy) 56 | ) 57 | {:keys [position state velocity distance]} (t/update-turtle turtle)] 58 | (should= [-4.0 1.0] position) 59 | (should= -5.0 velocity) 60 | (should= 95.0 distance) 61 | (should= :busy state))) 62 | 63 | (it "steps by distance and goes idle when distance is near" 64 | (let [turtle (-> @turtle 65 | (heading 0.0) 66 | (velocity 5.0) 67 | (distance 3.0) 68 | (state :busy) 69 | ) 70 | {:keys [position state velocity distance]} (t/update-turtle turtle)] 71 | (should= [4.0 1.0] position) 72 | (should= 0.0 velocity) 73 | (should= 0.0 distance) 74 | (should= :idle state)))) 75 | 76 | (it "steps back by distance and goes idle when distance is near" 77 | (let [turtle (-> @turtle 78 | (heading 0.0) 79 | (velocity -5.0) 80 | (distance 3.0) 81 | (state :busy)) 82 | {:keys [position state velocity distance]} (t/update-turtle turtle)] 83 | (should= [-2.0 1.0] position) 84 | (should= 0.0 velocity) 85 | (should= 0.0 distance) 86 | (should= :idle state))) 87 | 88 | (context "angle update" 89 | (it "holds angle when there's no omega" 90 | (let [turtle (-> @turtle (omega 0) (heading 90) (angle 30) (state :idle)) 91 | new-turtle (t/update-turtle turtle)] 92 | (should= turtle new-turtle))) 93 | 94 | (it "steps by omega when angle is far" 95 | (let [turtle (-> @turtle 96 | (omega 5.0) 97 | (angle 100.0) 98 | (state :busy)) 99 | {:keys [heading state omega angle]} (t/update-turtle turtle)] 100 | (should= 6.0 heading) 101 | (should= 5.0 omega) 102 | (should= 95.0 angle) 103 | (should= :busy state))) 104 | 105 | (it "steps back by omega when angle is far" 106 | (let [turtle (-> @turtle 107 | (omega -5.0) 108 | (angle 100.0) 109 | (state :busy)) 110 | {:keys [heading state omega angle]} (t/update-turtle turtle)] 111 | (should= 356.0 heading) 112 | (should= -5.0 omega) 113 | (should= 95.0 angle) 114 | (should= :busy state))) 115 | 116 | (it "steps by omega and goes idle when angle is near" 117 | (let [turtle (-> @turtle 118 | (omega 5.0) 119 | (angle 3.0) 120 | (state :busy)) 121 | {:keys [heading state omega angle]} (t/update-turtle turtle)] 122 | (should= 4.0 heading) 123 | (should= 0.0 omega) 124 | (should= 0.0 angle) 125 | (should= :idle state))) 126 | 127 | (it "steps back by omega and goes idle when angle is near" 128 | (let [turtle (-> @turtle 129 | (omega -5.0) 130 | (angle 3.0) 131 | (state :busy)) 132 | {:keys [heading state omega angle]} (t/update-turtle turtle)] 133 | (should= 358.0 heading) 134 | (should= 0.0 omega) 135 | (should= 0.0 angle) 136 | (should= :idle state)))) 137 | 138 | (context "pen up and down" 139 | (it "marks the starting coordinate upon pen down" 140 | (let [turtle (t/pen-down @turtle) 141 | pen (:pen turtle) 142 | pen-start (:pen-start turtle)] 143 | (should= :down pen) 144 | (should= [1.0 1.0] pen-start))) 145 | 146 | (it "does not mark starting position if pen already down" 147 | (let [turtle (-> @turtle (t/pen-down) (position [2.0 2.0]) (t/pen-down)) 148 | pen (:pen turtle) 149 | pen-start (:pen-start turtle)] 150 | (should= :down pen) 151 | (should= [1.0 1.0] pen-start))) 152 | 153 | (it "adds line when pen goes back up" 154 | (let [turtle (-> @turtle 155 | (t/weight [3]) 156 | (t/pen-down) 157 | (position [2.0 2.0]) 158 | (t/pen-up)) 159 | pen (:pen turtle) 160 | pen-start (:pen-start turtle) 161 | lines (:lines turtle)] 162 | (should= :up pen) 163 | (should-be-nil pen-start) 164 | (should= [{:line-start [1.0 1.0] 165 | :line-end [2.0 2.0] 166 | :line-weight 3}] lines))) 167 | 168 | (it "does not add line when pen is already up" 169 | (let [turtle (-> @turtle (position [2.0 2.0]) (t/pen-up)) 170 | pen (:pen turtle) 171 | pen-start (:pen-start turtle) 172 | lines (:lines turtle)] 173 | (should= :up pen) 174 | (should-be-nil pen-start) 175 | (should= [] lines)) 176 | ) 177 | 178 | (it "adds line upon idle after move" 179 | (let [turtle (-> 180 | @turtle 181 | (heading 0) 182 | (t/pen-down) 183 | (t/weight [3]) 184 | (t/forward [1]) 185 | (t/update-turtle)) 186 | pen (:pen turtle) 187 | state (:state turtle) 188 | lines (:lines turtle) 189 | pen-start (:pen-start turtle) 190 | position (:position turtle)] 191 | (should= :down pen) 192 | (should= :idle state) 193 | (should= position pen-start) 194 | (should= [{:line-start [1.0 1.0] 195 | :line-end [2.0 1.0] 196 | :line-weight 3}] lines))) 197 | ) 198 | ) 199 | -------------------------------------------------------------------------------- /gui/turtle-graphics/src/turtle_graphics/core.clj: -------------------------------------------------------------------------------- 1 | (ns turtle-graphics.core 2 | (:require [quil.core :as q] 3 | [quil.middleware :as m] 4 | [turtle-graphics.turtle :as turtle] 5 | [clojure.core.async :as async] 6 | [clojure.tools.namespace.repl :refer [refresh]] 7 | [turtle-graphics.turtle-script :refer [turtle-script]] 8 | [turtle-graphics.turtle-commands :refer [channel]])) 9 | 10 | (defn setup [] 11 | (q/frame-rate 60) 12 | (q/color-mode :rgb) 13 | (let [state {:turtle (turtle/make) 14 | :channel channel}] 15 | (async/go 16 | (turtle-script) 17 | (prn "Turtle script complete")) 18 | state)) 19 | 20 | (defn handle-commands [channel turtle] 21 | (loop [turtle turtle] 22 | (let [command (if (= :idle (:state turtle)) 23 | (async/poll! channel) 24 | nil)] 25 | (if (nil? command) 26 | turtle 27 | (recur (turtle/handle-command turtle command)))))) 28 | 29 | (defn update-state [{:keys [channel] :as state}] 30 | (let [turtle (:turtle state) 31 | turtle (turtle/update-turtle turtle)] 32 | (assoc state :turtle (handle-commands channel turtle)))) 33 | 34 | (defn draw-state [state] 35 | (q/background 240) 36 | (q/with-translation 37 | [500 500] 38 | (let [{:keys [turtle]} state] 39 | (turtle/draw turtle)))) 40 | 41 | (declare turtle-graphics) 42 | 43 | (defn ^:export -main [& args] 44 | (q/defsketch turtle-graphics 45 | :title "Turtle Graphics" 46 | :size [1000 1000] 47 | :setup setup 48 | :update update-state 49 | :draw draw-state 50 | :features [:keep-on-top] 51 | :middleware [m/fun-mode]) 52 | args) 53 | -------------------------------------------------------------------------------- /gui/turtle-graphics/src/turtle_graphics/turtle.clj: -------------------------------------------------------------------------------- 1 | (ns turtle-graphics.turtle 2 | (:require [quil.core :as q] 3 | [clojure.spec.alpha :as s])) 4 | 5 | (s/check-asserts true) 6 | (s/def ::position (s/tuple number? number?)) 7 | (s/def ::heading (s/and number? #(<= 0 % 360))) 8 | (s/def ::velocity number?) 9 | (s/def ::distance number?) 10 | (s/def ::omega number?) 11 | (s/def ::angle number?) 12 | (s/def ::weight (s/and pos? number?)) 13 | (s/def ::state #{:idle :busy}) 14 | (s/def ::pen #{:up :down}) 15 | (s/def ::pen-start (s/or :nil nil? 16 | :pos (s/tuple number? number?))) 17 | (s/def ::line-start (s/tuple number? number?)) 18 | (s/def ::line-end (s/tuple number? number?)) 19 | (s/def ::line (s/keys :req-un [::line-start ::line-end])) 20 | (s/def ::lines (s/coll-of ::line)) 21 | (s/def ::visible boolean?) 22 | (s/def ::speed (s/and int? pos?)) 23 | (s/def ::turtle (s/keys :req-un [::position 24 | ::heading 25 | ::velocity 26 | ::distance 27 | ::omega 28 | ::angle 29 | ::pen 30 | ::weight 31 | ::speed 32 | ::lines 33 | ::visible 34 | ::state] 35 | :opt-un [::pen-start])) 36 | 37 | (defn make [] 38 | {:post [(s/assert ::turtle %)]} 39 | {:position [0.0 0.0] 40 | :heading 0.0 41 | :velocity 0.0 42 | :distance 0.0 43 | :omega 0.0 44 | :angle 0.0 45 | :pen :up 46 | :weight 1 47 | :speed 5 48 | :visible true 49 | :lines [] 50 | :state :idle}) 51 | 52 | (def WIDTH 10) 53 | (def HEIGHT 15) 54 | 55 | (defn draw [turtle] 56 | (when (= :down (:pen turtle)) 57 | (q/stroke 0) 58 | (q/stroke-weight (:weight turtle)) 59 | (q/line (:pen-start turtle) (:position turtle))) 60 | 61 | (doseq [line (:lines turtle)] 62 | (q/stroke-weight (:line-weight line)) 63 | (q/line (:line-start line) (:line-end line))) 64 | 65 | (when (:visible turtle) 66 | (q/stroke-weight 1) 67 | (let [[x y] (:position turtle) 68 | heading (q/radians (:heading turtle)) 69 | base-left (- (/ WIDTH 2)) 70 | base-right (/ WIDTH 2) 71 | tip HEIGHT] 72 | (q/stroke 0) 73 | (q/with-translation 74 | [x y] 75 | (q/with-rotation 76 | [heading] 77 | (q/line 0 base-left 0 base-right) 78 | (q/line 0 base-left tip 0) 79 | (q/line 0 base-right tip 0)))))) 80 | 81 | (defn update-position [{:keys [position velocity heading distance] :as turtle}] 82 | (let [step (min (q/abs velocity) distance) 83 | distance (- distance step) 84 | step (if (neg? velocity) (- step) step) 85 | radians (q/radians heading) 86 | [x y] position 87 | vx (* step (Math/cos radians)) 88 | vy (* step (Math/sin radians)) 89 | position [(+ x vx) (+ y vy)]] 90 | (assoc turtle :position position 91 | :distance distance 92 | :velocity (if (zero? distance) 0.0 velocity)))) 93 | 94 | (defn update-heading [{:keys [heading omega angle] :as turtle}] 95 | (let [angle-step (min (q/abs omega) angle) 96 | angle (- angle angle-step) 97 | angle-step (if (neg? omega) (- angle-step) angle-step) 98 | heading (mod (+ heading angle-step) 360)] 99 | (assoc turtle :heading heading 100 | :angle angle 101 | :omega (if (zero? angle) 0.0 omega)))) 102 | 103 | (defn make-line [{:keys [pen-start position weight]}] 104 | {:line-start pen-start 105 | :line-end position 106 | :line-weight weight}) 107 | 108 | (defn update-turtle [turtle] 109 | {:post [(s/assert ::turtle %)]} 110 | (if (= :idle (:state turtle)) 111 | turtle 112 | (let [{:keys [distance 113 | state 114 | angle 115 | lines 116 | position 117 | pen 118 | pen-start] :as turtle} 119 | (-> turtle 120 | (update-position) 121 | (update-heading)) 122 | done? (and (zero? distance) 123 | (zero? angle)) 124 | state (if done? :idle state) 125 | lines (if (and done? (= pen :down)) 126 | (conj lines (make-line turtle)) 127 | lines) 128 | pen-start (if (and done? (= pen :down)) 129 | position 130 | pen-start)] 131 | (assoc turtle :state state :lines lines :pen-start pen-start)))) 132 | 133 | (defn pen-down [{:keys [pen position pen-start] :as turtle}] 134 | (assoc turtle :pen :down 135 | :pen-start (if (= :up pen) position pen-start))) 136 | 137 | (defn pen-up [{:keys [pen lines] :as turtle}] 138 | (if (= :up pen) 139 | turtle 140 | (let [new-line (make-line turtle) 141 | lines (conj lines new-line)] 142 | (assoc turtle :pen :up 143 | :pen-start nil 144 | :lines lines)))) 145 | 146 | (defn forward [turtle [distance]] 147 | (assoc turtle :velocity (:speed turtle) 148 | :distance distance 149 | :state :busy)) 150 | 151 | (defn back [turtle [distance]] 152 | (assoc turtle :velocity (- (:speed turtle)) 153 | :distance distance 154 | :state :busy)) 155 | 156 | (defn right [turtle [angle]] 157 | (assoc turtle :omega (* 2 (:speed turtle)) 158 | :angle angle 159 | :state :busy)) 160 | 161 | (defn left [turtle [angle]] 162 | (assoc turtle :omega (* -2 (:speed turtle)) 163 | :angle angle 164 | :state :busy)) 165 | 166 | (defn hide [turtle] 167 | (assoc turtle :visible false)) 168 | 169 | (defn show [turtle] 170 | (assoc turtle :visible true)) 171 | 172 | (defn weight [turtle [weight]] 173 | (assoc turtle :weight weight)) 174 | 175 | (defn speed [turtle [speed]] 176 | (assoc turtle :speed speed)) 177 | 178 | (defn handle-command [turtle [cmd & args]] 179 | (condp = cmd 180 | :forward (forward turtle args) 181 | :back (back turtle args) 182 | :right (right turtle args) 183 | :left (left turtle args) 184 | :pen-down (pen-down turtle) 185 | :pen-up (pen-up turtle) 186 | :hide (hide turtle) 187 | :show (show turtle) 188 | :weight (weight turtle args) 189 | :speed (speed turtle args) 190 | :else turtle)) 191 | 192 | 193 | 194 | -------------------------------------------------------------------------------- /gui/turtle-graphics/src/turtle_graphics/turtle_commands.clj: -------------------------------------------------------------------------------- 1 | (ns turtle-graphics.turtle-commands 2 | (:require [clojure.core.async :as async])) 3 | 4 | (def channel (async/chan)) 5 | (defn forward [distance] (async/>!! channel [:forward distance])) 6 | (defn back [distance] (async/>!! channel [:back distance])) 7 | (defn right [angle] (async/>!! channel [:right angle])) 8 | (defn left [angle] (async/>!! channel [:left angle])) 9 | (defn pen-up [] (async/>!! channel [:pen-up])) 10 | (defn pen-down [] (async/>!! channel [:pen-down])) 11 | (defn hide [] (async/>!! channel [:hide])) 12 | (defn show [] (async/>!! channel [:show])) 13 | (defn weight [weight] (async/>!! channel [:weight weight])) 14 | (defn speed [speed] (async/>!! channel [:speed speed])) 15 | -------------------------------------------------------------------------------- /gui/turtle-graphics/src/turtle_graphics/turtle_script.clj: -------------------------------------------------------------------------------- 1 | (ns turtle-graphics.turtle-script 2 | (:require [turtle-graphics.turtle-commands :refer :all])) 3 | 4 | (defn fibs 5 | ([a b] 6 | (lazy-seq 7 | (cons a (fibs b (+ a b))))) 8 | ([] (fibs 1 1)) 9 | ) 10 | 11 | (def PHI (/ (+ 1 (Math/sqrt 5)) 2)) 12 | 13 | (defn dot [] 14 | (weight 5) 15 | (pen-down) 16 | (forward 1) 17 | (pen-up) 18 | (back 1)) 19 | 20 | (defn fib-spiral [] 21 | (speed 1000) 22 | (weight 3) 23 | (doseq [f (take 20 (fibs))] 24 | (weight (inc (Math/log (double f)))) 25 | (forward f) 26 | (right 90) 27 | (dot)) 28 | ) 29 | 30 | (defn rect [a b] 31 | (doseq [_ (range 2)] 32 | (forward a) 33 | (right 90) 34 | (forward b) 35 | (right 90))) 36 | 37 | (defn phi-rect [n] 38 | (pen-down) 39 | (weight 3) 40 | (rect n (* n PHI))) 41 | 42 | (defn scaled-rect [a b scale] 43 | (let [width (* a scale) 44 | height (* b scale)] 45 | (rect width height) 46 | (forward width) 47 | (right 90)) 48 | ) 49 | 50 | (defn phi-spiral [] 51 | (left 90) 52 | (forward 100) 53 | (right 90) 54 | (pen-down) 55 | (weight 2) 56 | (speed 20) 57 | (loop [a 1 b PHI] 58 | (scaled-rect a b 10) 59 | (if (> a 40) 60 | nil 61 | (recur b (* b PHI)) 62 | ) 63 | ) 64 | ) 65 | 66 | (defn square-the-rect [length height f] 67 | (if (zero? height) 68 | (println "Rational.") 69 | (if (> 1 length) 70 | (println "Irrational") 71 | (let [n (quot length height) 72 | r (rem length height)] 73 | (println "Squares: " n " " (/ height f)) 74 | (doseq [_ (range n)] 75 | (forward height) 76 | (right 90) 77 | (pen-down) 78 | (forward height) 79 | (pen-up) 80 | (back height) 81 | (left 90)) 82 | (forward r) 83 | (right 90) 84 | (square-the-rect height r f))))) 85 | 86 | (defn triangle [triplet] 87 | (let [[a b c] (sort triplet) 88 | scale (/ 980 b) 89 | al (* scale a) 90 | bl (* scale b) 91 | cl (* scale c) 92 | atan (+ 90 (/ (* 180.0 (Math/atan2 b a)) Math/PI)) 93 | ] 94 | (left 90) 95 | (pen-up) 96 | (forward bl) 97 | (right atan) 98 | (pen-down) 99 | (forward cl) 100 | (pen-up) 101 | (left atan) 102 | (right 90) 103 | (back al))) 104 | 105 | (defn scale [n] 106 | (let [tic (/ 980 n)] 107 | (dotimes [x n] 108 | (let [len (if (zero? (mod x 10)) 10 5)] 109 | (pen-up) 110 | (right 90) 111 | (pen-down) 112 | (forward len) 113 | (pen-up) 114 | (back len) 115 | (left 90) 116 | (forward tic))) 117 | (back 980))) 118 | 119 | 120 | (defn triangles [triplets] 121 | (speed 1000) 122 | (pen-up) 123 | (right 90) 124 | (forward 490) 125 | (right 90) 126 | (forward 490) 127 | (right 180) 128 | (scale 100) 129 | (pen-down) 130 | (weight 2) 131 | (forward 980) 132 | (pen-up) 133 | (back 980) 134 | (left 90) 135 | (pen-down) 136 | (forward 980) 137 | (pen-up) 138 | (back 980) 139 | (right 90) 140 | (pen-down) 141 | (doseq [triplet triplets] (triangle triplet)) 142 | ) 143 | 144 | (defn square-spiral [a b] 145 | (let [length (max a b) 146 | height (min a b) 147 | f (quot 980 length) 148 | length (* length f) 149 | height (* height f) 150 | _ (prn length height)] 151 | (speed 20) 152 | (pen-up) 153 | (back (quot length 2)) 154 | (left 90) 155 | (forward (quot height 2)) 156 | (right 90) 157 | (pen-down) 158 | (weight 2) 159 | (rect length height) 160 | (pen-up) 161 | (square-the-rect length height f))) 162 | 163 | (defn flower-spiral [theta] 164 | (let [petals 250 165 | radius-increment 2] 166 | (speed 1000) 167 | (doseq [x (range petals)] 168 | (right theta) 169 | (forward (* radius-increment x)) 170 | (dot) 171 | (back (* radius-increment x))) 172 | (hide))) 173 | 174 | (defn polygon [theta, l, n] 175 | (pen-down) 176 | (speed 1000) 177 | (dotimes [_ n] 178 | (forward l) 179 | (right theta))) 180 | 181 | (defn spiral [theta length-f n] 182 | (pen-down) 183 | (speed 1000) 184 | (loop [i 0 len 1] 185 | (if (= i n) 186 | nil 187 | (do 188 | (forward len) 189 | (right theta) 190 | (recur (inc i) (length-f len)))))) 191 | 192 | (defn gcd 193 | ([a b] 194 | (if (zero? b) 195 | a 196 | (gcd b (mod a b)))) 197 | ([l] 198 | (reduce gcd l)) 199 | ) 200 | 201 | (defn find-triplets-up-to [n] 202 | (let [nn (range 1 (inc n)) 203 | nsq (set (map #(* % %) nn)) 204 | triplets (for [a nsq b nsq] 205 | (when (contains? nsq (+ a b)) 206 | [(int (Math/sqrt a)) (int (Math/sqrt b)) (int (Math/sqrt (+ a b)))])) 207 | triplets (filter some? triplets)] 208 | (filter (fn [[a b c]] (<= a b c)) triplets))) 209 | 210 | (defn find-unique-triplets [n] 211 | (sort-by first (filter #(= 1 (gcd %)) (find-triplets-up-to n)))) 212 | 213 | (defn unique-pythagorean-triplets [] 214 | (triangles (find-unique-triplets 1000))) 215 | 216 | (defn turtle-script [] 217 | (polygon 144 400 5)) 218 | 219 | -------------------------------------------------------------------------------- /immutability/simple: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/unclebob/FunctionalDesign/e2b99727e3bd7d52aecb41412dcbfc22522acadd/immutability/simple -------------------------------------------------------------------------------- /immutability/simple.c: -------------------------------------------------------------------------------- 1 | int sumFirstTenSquaresHelper(int sum, int i) { 2 | return (i>10) ? sum : sumFirstTenSquaresHelper(sum+i*i, i+1); 3 | } 4 | 5 | int sumFirstTenSquares() { 6 | return sumFirstTenSquaresHelper(0, 1); 7 | } 8 | 9 | State system(State state, Event event) { 10 | return done(state) ? state : system(state, getEvent()); 11 | } 12 | 13 | #include 14 | int main(int ac, char** av) { 15 | printf("%d\n", sumFirstTenSquares()); 16 | return 0; 17 | } 18 | 19 | -------------------------------------------------------------------------------- /immutability/turnstile: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/unclebob/FunctionalDesign/e2b99727e3bd7d52aecb41412dcbfc22522acadd/immutability/turnstile -------------------------------------------------------------------------------- /immutability/turnstile.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | typedef enum {locked, unlocked, done} State; 4 | typedef enum {coin, pass, quit} Event; 5 | 6 | void lock() { 7 | printf("Locking.\n"); 8 | } 9 | 10 | void unlock() { 11 | printf("Unlocking.\n"); 12 | } 13 | 14 | void thankyou() { 15 | printf("Thanking.\n"); 16 | } 17 | 18 | void alarm() { 19 | printf("Alarming.\n"); 20 | } 21 | 22 | Event getEvent() { 23 | while (1) { 24 | int c = getchar(); 25 | switch (c) { 26 | case 'c': return coin; 27 | case 'p': return pass; 28 | case 'q': return quit; 29 | } 30 | } 31 | } 32 | 33 | State turnstileFSM(State s, Event e) { 34 | switch (s) { 35 | case locked: 36 | switch (e) { 37 | case coin: 38 | unlock(); 39 | return unlocked; 40 | 41 | case pass: 42 | alarm(); 43 | return locked; 44 | 45 | case quit: 46 | return done; 47 | } 48 | 49 | case unlocked: 50 | switch (e) { 51 | case coin: 52 | thankyou(); 53 | return unlocked; 54 | 55 | case pass: 56 | lock(); 57 | return locked; 58 | 59 | case quit: 60 | return done; 61 | } 62 | case done: 63 | return done; 64 | } 65 | } 66 | 67 | State turnstileSystem(State s) { 68 | return (s==done)? 0 : turnstileSystem(turnstileFSM(s, getEvent())); 69 | } 70 | 71 | int main(int ac, char** av) { 72 | turnstileSystem(locked); 73 | return 0; 74 | } -------------------------------------------------------------------------------- /lsp/lsp-stuff/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /lsp/lsp-stuff/README.md: -------------------------------------------------------------------------------- 1 | # lsp-stuff 2 | -------------------------------------------------------------------------------- /lsp/lsp-stuff/project.clj: -------------------------------------------------------------------------------- 1 | (defproject lsp-stuff "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main lsp-stuff.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /lsp/lsp-stuff/spec/lsp_stuff/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns lsp-stuff.core-spec 2 | (:require [speclj.core :refer :all] 3 | [lsp-stuff.core :refer :all])) 4 | 5 | (defn test-is-payday [employee-data pay-date] 6 | true) 7 | 8 | (defn test-calc-pay [employee-data] 9 | (:pay employee-data)) 10 | 11 | (defn test-send-paycheck [employee-data paycheck] 12 | (format "Send %d to: %s at: %s" 13 | paycheck (:name employee-data) (:address employee-data))) 14 | 15 | (defn make-test-employee [name address pay] 16 | (let [employee-data {:name name 17 | :address address 18 | :pay pay} 19 | 20 | employee {:employee-data employee-data 21 | :is-payday (partial test-is-payday employee-data) 22 | :calc-pay (partial test-calc-pay employee-data) 23 | :send-paycheck (partial test-send-paycheck employee-data)}] 24 | employee)) 25 | 26 | (defn make-later-employee [name address pay] 27 | (let [employee (make-test-employee name address pay) 28 | is-payday? (partial (fn [_ _] :tomorrow) (:employee-data employee))] 29 | (assoc employee :is-payday is-payday?))) 30 | 31 | (describe "Payroll" 32 | (it "pays a salaried employee" 33 | (should= "Send 100 to: name at: address" 34 | (pay (make-test-employee "name" "address" 100) :now))) 35 | 36 | (it "does not pay an employee who's payday is not today" 37 | (should-be-nil (pay (make-later-employee "name" "address" 100) :now)))) 38 | -------------------------------------------------------------------------------- /lsp/lsp-stuff/src/lsp_stuff/core.clj: -------------------------------------------------------------------------------- 1 | (ns lsp-stuff.core) 2 | 3 | (defn pay [employee pay-date] 4 | (let [is-payday? (:is-payday employee) 5 | calc-pay (:calc-pay employee) 6 | send-paycheck (:send-paycheck employee)] 7 | (when (= true (is-payday? pay-date)) 8 | (let [paycheck (calc-pay)] 9 | (send-paycheck paycheck))))) -------------------------------------------------------------------------------- /lsp/rect-square/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /lsp/rect-square/README.md: -------------------------------------------------------------------------------- 1 | # rect-square 2 | -------------------------------------------------------------------------------- /lsp/rect-square/project.clj: -------------------------------------------------------------------------------- 1 | (defproject rect-square "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main rect-square.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /lsp/rect-square/spec/rect_square/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns rect-square.core-spec 2 | (:require [speclj.core :refer :all] 3 | [rect-square.core :refer :all])) 4 | 5 | (describe "Rectangle" 6 | (it "calculates proper area after change in size" 7 | (should= 25 (area (make-rect 5 5))) 8 | (should= 36 (area (make-square 6))) 9 | (should= 18 (perimeter (make-rect 4 5))) 10 | (should= 20 (perimeter (make-square 5))) 11 | (should= 12 (-> (make-rect 1 1) (set-h 3) (set-w 4) area)) 12 | (should= 12 (-> (make-square 1) (set-h 3) (set-w 4) area)) 13 | ) 14 | 15 | (it "mimimally increases area" 16 | (should= 15 (-> (make-rect 3 4) minimally-increase-area area)) 17 | (should= 24 (-> (make-rect 5 4) minimally-increase-area area)) 18 | (should= 20 (-> (make-rect 4 4) minimally-increase-area area)) 19 | (should= 30 (-> (make-square 5) minimally-increase-area area)))) 20 | -------------------------------------------------------------------------------- /lsp/rect-square/src/rect_square/core.clj: -------------------------------------------------------------------------------- 1 | (ns rect-square.core) 2 | 3 | (defn make-rect [h w] 4 | {:h h :w w}) 5 | 6 | (defn set-h [rect h] 7 | (assoc rect :h h)) 8 | 9 | (defn set-w [rect w] 10 | (assoc rect :w w)) 11 | 12 | (defn area [rect] 13 | (* (:h rect) (:w rect))) 14 | 15 | (defn perimeter [rect] 16 | (let [{:keys [h w]} rect] 17 | (* 2 (+ h w)))) 18 | 19 | (defn minimally-increase-area [rect] 20 | (let [{:keys [h w]} rect] 21 | (cond 22 | (>= h w) (make-rect (inc h) w) 23 | (> w h) (make-rect h (inc w)) 24 | :else :tilt))) 25 | 26 | (defn make-square [side] 27 | (make-rect side side)) -------------------------------------------------------------------------------- /ocp/copy/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /ocp/copy/README.md: -------------------------------------------------------------------------------- 1 | # copy 2 | -------------------------------------------------------------------------------- /ocp/copy/project.clj: -------------------------------------------------------------------------------- 1 | (defproject copy "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main copy.core 7 | :dependencies [[org.clojure/clojure "1.8.0"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /ocp/copy/spec/copy/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns copy.core-spec 2 | (:require [speclj.core :refer :all] 3 | [copy.core :refer :all])) 4 | 5 | (defrecord str-device [in-atom out-atom] 6 | device 7 | (getchar [_] 8 | (let [c (first @in-atom)] 9 | (if (nil? c) 10 | :eof 11 | (do 12 | (swap! in-atom rest) 13 | c)))) 14 | 15 | (putchar [_ c] 16 | (swap! out-atom str c))) 17 | 18 | (describe "copy" 19 | (it "can read and write using protocol" 20 | (let [device (->str-device (atom "abcdef") (atom nil))] 21 | (copy device) 22 | (should= "abcdef" @(:out-atom device))))) 23 | 24 | (defmethod getchar :test-device [device] 25 | (let [input (:input device) 26 | c (first @input)] 27 | (if (nil? c) 28 | :eof 29 | (do 30 | (swap! input rest) 31 | c)))) 32 | 33 | (defmethod putchar :test-device [device c] 34 | (let [output (:output device)] 35 | (swap! output str c))) 36 | 37 | (describe "copy-mm" 38 | (it "can read and write using multi-method" 39 | (let [device {:device-type :test-device 40 | :input (atom "abcdef") 41 | :output (atom nil)}] 42 | (copy device) 43 | (should= "abcdef" @(:output device))))) -------------------------------------------------------------------------------- /ocp/copy/src/copy/core.clj: -------------------------------------------------------------------------------- 1 | (ns copy.core) 2 | 3 | (defprotocol device 4 | (getchar [_]) 5 | (putchar [_ c])) 6 | 7 | (defn copy [device] 8 | (let [c (getchar device)] 9 | (if (= c :eof) 10 | nil 11 | (do 12 | (putchar device c) 13 | (recur device))))) 14 | 15 | (defmulti getchar (fn [device] (:device-type device))) 16 | (defmulti putchar (fn [device c] (:device-type device))) -------------------------------------------------------------------------------- /persitentData/sieve/src/sieve/Sieve.java: -------------------------------------------------------------------------------- 1 | package sieve; 2 | 3 | import java.util.ArrayList; 4 | import java.util.Arrays; 5 | import java.util.List; 6 | 7 | public class Sieve { 8 | static List primesUpTo(int upTo) { 9 | return getPrimes( 10 | computeSieve( 11 | makeSieve(Math.max(upTo, 1)), 12 | 0), 13 | new ArrayList<>(), 0); 14 | } 15 | 16 | private static boolean[] makeSieve(int upTo) { 17 | boolean[] sieve = new boolean[upTo + 1]; 18 | Arrays.fill(sieve, false); 19 | sieve[0] = sieve[1] = true; 20 | return sieve; 21 | } 22 | 23 | private static boolean[] computeSieve(boolean[] sieve, int n) { 24 | if (n >= sieve.length) 25 | return sieve; 26 | else if (!sieve[n]) 27 | return computeSieve(markMultiples(sieve, n, 2), n + 1); 28 | else return computeSieve(sieve, n + 1); 29 | } 30 | 31 | private static boolean[] markMultiples(boolean[] sieve, 32 | int prime, 33 | int m) { 34 | int multiple = prime * m; 35 | if (multiple >= sieve.length) 36 | return sieve; 37 | else { 38 | var markedSieve = Arrays.copyOf(sieve, sieve.length); 39 | markedSieve[multiple] = true; 40 | return markMultiples(markedSieve, prime, m + 1); 41 | } 42 | } 43 | 44 | public static List getPrimes(boolean[] sieve, 45 | List primes, 46 | int n) { 47 | if (n >= sieve.length) 48 | return primes; 49 | else if (!sieve[n]) { 50 | var newPrimes = new ArrayList<>(primes); 51 | newPrimes.add(n); 52 | return getPrimes(sieve, newPrimes, n + 1); 53 | } else { 54 | return getPrimes(sieve, primes, n + 1); 55 | } 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /persitentData/sieve/test/sieve/SieveTest.java: -------------------------------------------------------------------------------- 1 | package sieve; 2 | 3 | import org.junit.Test; 4 | 5 | import java.util.List; 6 | 7 | import static org.junit.Assert.assertEquals; 8 | 9 | public class SieveTest { 10 | @Test 11 | public void sieveTest() throws Exception { 12 | assertEquals(List.of(), Sieve.primesUpTo(0)); 13 | assertEquals(List.of(), Sieve.primesUpTo(1)); 14 | assertEquals(List.of(2), Sieve.primesUpTo(2)); 15 | assertEquals(List.of(2, 3), Sieve.primesUpTo(3)); 16 | assertEquals(List.of(2, 3), Sieve.primesUpTo(4)); 17 | assertEquals(List.of(2, 3, 5), Sieve.primesUpTo(5)); 18 | assertEquals(List.of(2, 3, 5), Sieve.primesUpTo(6)); 19 | assertEquals(List.of(2, 3, 5, 7), Sieve.primesUpTo(7)); 20 | assertEquals(List.of(2, 3, 5, 7), Sieve.primesUpTo(8)); 21 | assertEquals(List.of(2, 3, 5, 7), Sieve.primesUpTo(9)); 22 | assertEquals(List.of(2, 3, 5, 7), Sieve.primesUpTo(10)); 23 | assertEquals(List.of(2, 3, 5, 7, 11), Sieve.primesUpTo(11)); 24 | assertEquals(List.of(2, 3, 5, 7, 11, 13, 17, 19, 23, 29), Sieve.primesUpTo(30)); 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /srp/parse-order/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /srp/parse-order/README.md: -------------------------------------------------------------------------------- 1 | # parse-order 2 | -------------------------------------------------------------------------------- /srp/parse-order/project.clj: -------------------------------------------------------------------------------- 1 | (defproject parse-order "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main parse-order.core 7 | :dependencies [[org.clojure/clojure "1.10.3"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /srp/parse-order/spec/parse_order/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns parse-order.core-spec 2 | (:require [speclj.core :refer :all] 3 | [parse-order.core :refer :all] 4 | [clojure.spec.alpha :as s])) 5 | 6 | (describe "Order Entry System" 7 | (context "Parsing Customers" 8 | (it "parses a valid customer" 9 | (let [customer (parse-customer 10 | ["Customer-id: 1234567" 11 | "Name: customer name" 12 | "Address: customer address" 13 | "Credit Limit: 50000"])] 14 | (should= 15 | {:id "1234567" 16 | :name "customer name" 17 | :address "customer address" 18 | :credit-limit 50000} 19 | customer) 20 | (should (s/valid? :parse-order.core/customer customer)))) 21 | 22 | (it "parses invalid customer" 23 | (should= :invalid 24 | (parse-customer 25 | ["Customer-id: X" 26 | "Name: customer name" 27 | "Address: customer address" 28 | "Credit Limit: 50000"])) 29 | (should= :invalid 30 | (parse-customer 31 | ["Customer-id: 1234567" 32 | "Name: " 33 | "Address: customer address" 34 | "Credit Limit: 50000"])) 35 | (should= :invalid 36 | (parse-customer 37 | ["Customer-id: 1234567" 38 | "Name: customer name" 39 | "Address: " 40 | "Credit Limit: 50000"])) 41 | (should= :invalid 42 | (parse-customer 43 | ["Customer-id: 1234567" 44 | "Name: customer name" 45 | "Address: customer address" 46 | "Credit Limit: invalid"]))) 47 | (it "makes sure credit limit is <= 50000" 48 | (should= :invalid 49 | (parse-customer 50 | ["Customer-id: 1234567" 51 | "Name: customer name" 52 | "Address: customer address" 53 | "Credit Limit: 50001"]))) 54 | )) 55 | -------------------------------------------------------------------------------- /srp/parse-order/src/parse_order/core.clj: -------------------------------------------------------------------------------- 1 | (ns parse-order.core 2 | (:require [clojure.spec.alpha :as s])) 3 | 4 | (s/def ::id (s/and 5 | string? 6 | #(re-matches #"\d+" %))) 7 | (s/def ::name string?) 8 | (s/def ::address string?) 9 | (s/def ::credit-limit (s/and int? #(<= % 50000))) 10 | (s/def ::customer (s/keys :req-un [::id ::name ::address ::credit-limit])) 11 | 12 | 13 | (defn validate-customer [{:keys [id name address credit-limit] :as customer}] 14 | (if (or (nil? id) 15 | (nil? name) 16 | (nil? address) 17 | (nil? credit-limit)) 18 | :invalid 19 | (let [credit-limit (Integer/parseInt credit-limit)] 20 | (if (> credit-limit 50000) 21 | :invalid 22 | (assoc customer :credit-limit credit-limit))))) 23 | 24 | (defn parse-customer [lines] 25 | (let [[_ id] (re-matches #"^Customer-id: (\d{7})$" (nth lines 0)) 26 | [_ name] (re-matches #"^Name: (.+)$" (nth lines 1)) 27 | [_ address] (re-matches #"^Address: (.+)$" (nth lines 2)) 28 | [_ credit-limit] (re-matches #"^Credit Limit: (\d+)$" (nth lines 3))] 29 | (validate-customer 30 | {:id id 31 | :name name 32 | :address address 33 | :credit-limit credit-limit}))) 34 | 35 | 36 | -------------------------------------------------------------------------------- /tests/factors/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /tests/factors/README.md: -------------------------------------------------------------------------------- 1 | # factors 2 | -------------------------------------------------------------------------------- /tests/factors/project.clj: -------------------------------------------------------------------------------- 1 | (defproject factors "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main factors.core 7 | :dependencies [[org.clojure/clojure "1.11.1"] 8 | ] 9 | :profiles {:dev {:dependencies [[speclj "3.3.2"] 10 | [org.clojure/test.check "1.1.1"]]}} 11 | :plugins [[speclj "3.3.2"]] 12 | :test-paths ["spec"]) 13 | -------------------------------------------------------------------------------- /tests/factors/spec/factors/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns factors.core-spec 2 | (:require [speclj.core :refer :all] 3 | [factors.core :refer :all] 4 | [clojure.test.check :as tc] 5 | [clojure.test.check.generators :as gen] 6 | [clojure.test.check.properties :as prop])) 7 | 8 | (defn power2 [n] 9 | (apply * (repeat n 2N))) 10 | 11 | (describe "factor primes" 12 | (it "factors 1 -> []" 13 | (should= [] (factors-of 1))) 14 | (it "factors 2 -> [2]" 15 | (should= [2] (factors-of 2))) 16 | (it "factors 3 -> [3]" 17 | (should= [3] (factors-of 3))) 18 | (it "factors 4 -> [2 2]" 19 | (should= [2 2] (factors-of 4))) 20 | (it "factors 5 -> [5]" 21 | (should= [5] (factors-of 5))) 22 | (it "factors 6 -> [2 3]" 23 | (should= [2 3] (factors-of 6))) 24 | (it "factors 7 -> [7]" 25 | (should= [7] (factors-of 7))) 26 | (it "factors 8 -> [2 2 2]" 27 | (should= [2 2 2] (factors-of 8))) 28 | (it "factors 9 -> [3 3]" 29 | (should= [3 3] (factors-of 9))) 30 | (it "factors lots" 31 | (should= [2 2 3 3 5 7 11 11 13] 32 | (factors-of (* 2 2 3 3 5 7 11 11 13)))) 33 | (it "factors Euler 3" 34 | (should= [71 839 1471 6857] (factors-of 600851475143))) 35 | 36 | (it "factors mersenne 2^31-1" 37 | (should= [2147483647] (factors-of (dec (power2 31))))) 38 | ) 39 | 40 | (def gen-inputs (gen/large-integer* {:min 1 :max 1E9})) 41 | 42 | (declare n) 43 | 44 | (describe "properties" 45 | (it "multiplies out properly" 46 | (should-be 47 | :result 48 | (tc/quick-check 49 | 1000 50 | (prop/for-all 51 | [n gen-inputs] 52 | (let [factors (factors-of n)] 53 | (= n (reduce * factors)))))))) 54 | 55 | (defn is-prime? [n] 56 | (if (= 2 n) 57 | true 58 | (loop [candidates (range 2 (inc (Math/sqrt n)))] 59 | (if (empty? candidates) 60 | true 61 | (if (zero? (rem n (first candidates))) 62 | false 63 | (recur (rest candidates))))))) 64 | 65 | (describe "is-prime" 66 | (it "tests for primes" 67 | (should (every? is-prime? [2 3 5 7 11 13 17 19 151]))) 68 | (it "tests for composites" 69 | (should-be-nil (some is-prime? [4 6 8 9 10 12 14 15 16 18 20 21])))) 70 | 71 | (describe "factors" 72 | (it "they are all prime" 73 | (should-be 74 | :result 75 | (tc/quick-check 76 | 1000 77 | (prop/for-all 78 | [n gen-inputs] 79 | (let [factors (factors-of n)] 80 | (every? is-prime? factors))))))) -------------------------------------------------------------------------------- /tests/factors/src/factors/core.clj: -------------------------------------------------------------------------------- 1 | (ns factors.core) 2 | 3 | (defn factors-of [n] 4 | (loop [factors [] n n divisor 2] 5 | (if (> n 1) 6 | (cond 7 | (> divisor (Math/sqrt n)) 8 | (conj factors n) 9 | (= 0 (mod n divisor)) 10 | (recur (conj factors divisor) 11 | (quot n divisor) 12 | divisor) 13 | :else 14 | (recur factors n (inc divisor))) 15 | factors))) -------------------------------------------------------------------------------- /visitor/shape-visitor/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /visitor/shape-visitor/README.md: -------------------------------------------------------------------------------- 1 | # shape-visitor 2 | -------------------------------------------------------------------------------- /visitor/shape-visitor/project.clj: -------------------------------------------------------------------------------- 1 | (defproject shape-visitor "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main shape-visitor.core 7 | :dependencies [[org.clojure/clojure "1.11.1"]] 8 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 9 | :plugins [[speclj "3.3.2"]] 10 | :test-paths ["spec"]) 11 | -------------------------------------------------------------------------------- /visitor/shape-visitor/spec/visitor_example/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns visitor-example.core-spec 2 | (:require [speclj.core :refer :all] 3 | [visitor-example 4 | [square :as square] 5 | [json-shape-visitor :as jv] 6 | [circle :as circle] 7 | [main]])) 8 | 9 | (describe "shape-visitor" 10 | (it "makes json square" 11 | (should= "{\"top-left\": [0,0], \"side\": 1}" 12 | (jv/to-json (square/make [0 0] 1)))) 13 | 14 | (it "makes json circle" 15 | (should= "{\"center\": [3,4], \"radius\": 1}" 16 | (jv/to-json (circle/make [3 4] 1))))) 17 | -------------------------------------------------------------------------------- /visitor/shape-visitor/src/visitor_example/circle.clj: -------------------------------------------------------------------------------- 1 | (ns visitor-example.circle 2 | (:require 3 | [visitor-example.shape :as shape])) 4 | 5 | (defn make [center radius] 6 | {::shape/type ::circle 7 | ::center center 8 | ::radius radius}) 9 | 10 | (defmethod shape/translate ::circle [circle dx dy] 11 | (let [[x y] (::center circle)] 12 | (assoc circle ::center [(+ x dx) (+ y dy)]))) 13 | 14 | (defmethod shape/scale ::circle [circle factor] 15 | (let [radius (::radius circle)] 16 | (assoc circle ::radius (* radius factor)))) 17 | -------------------------------------------------------------------------------- /visitor/shape-visitor/src/visitor_example/json_shape_visitor.clj: -------------------------------------------------------------------------------- 1 | (ns visitor-example.json-shape-visitor 2 | (:require [visitor-example 3 | [shape :as shape]])) 4 | 5 | (defmulti to-json ::shape/type) 6 | 7 | -------------------------------------------------------------------------------- /visitor/shape-visitor/src/visitor_example/json_shape_visitor_implementation.clj: -------------------------------------------------------------------------------- 1 | (ns visitor-example.json-shape-visitor-implementation 2 | (:require [visitor-example 3 | [json-shape-visitor :as v] 4 | [circle :as circle] 5 | [square :as square]])) 6 | 7 | (defmethod v/to-json ::square/square [square] 8 | (let [{:keys [::square/top-left ::square/side]} square 9 | [x y] top-left] 10 | (format "{\"top-left\": [%s,%s], \"side\": %s}" x y side))) 11 | 12 | (defmethod v/to-json ::circle/circle [circle] 13 | (let [{:keys [::circle/center ::circle/radius]} circle 14 | [x y] center] 15 | (format "{\"center\": [%s,%s], \"radius\": %s}" x y radius))) -------------------------------------------------------------------------------- /visitor/shape-visitor/src/visitor_example/main.clj: -------------------------------------------------------------------------------- 1 | (ns visitor-example.main 2 | (:require [visitor-example 3 | [json-shape-visitor-implementation]])) 4 | -------------------------------------------------------------------------------- /visitor/shape-visitor/src/visitor_example/shape.clj: -------------------------------------------------------------------------------- 1 | (ns visitor-example.shape) 2 | 3 | (defmulti translate (fn [shape dx dy] (::type shape))) 4 | (defmulti scale (fn [shape factor] (::type shape))) 5 | 6 | -------------------------------------------------------------------------------- /visitor/shape-visitor/src/visitor_example/square.clj: -------------------------------------------------------------------------------- 1 | (ns visitor-example.square 2 | (:require 3 | [visitor-example.shape :as shape])) 4 | 5 | (defn make [top-left side] 6 | {::shape/type ::square 7 | ::top-left top-left 8 | ::side side}) 9 | 10 | (defmethod shape/translate ::square [square dx dy] 11 | (let [[x y] (::top-left square)] 12 | (assoc square ::top-left [(+ x dx) (+ y dy)]))) 13 | 14 | (defmethod shape/scale ::square [square factor] 15 | (let [side (::side square)] 16 | (assoc square ::side (* side factor)))) 17 | -------------------------------------------------------------------------------- /wator/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein-repl-history 12 | -------------------------------------------------------------------------------- /wator/README.md: -------------------------------------------------------------------------------- 1 | # wator 2 | The Case Study for my Functional Design book. 3 | -------------------------------------------------------------------------------- /wator/project.clj: -------------------------------------------------------------------------------- 1 | (defproject wator "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :main wator.core 7 | :dependencies [[org.clojure/clojure "1.11.1"] 8 | [quil "4.0.0-SNAPSHOT"]] 9 | :profiles {:dev {:dependencies [[speclj "3.3.2"]]}} 10 | :plugins [[speclj "3.3.2"]] 11 | :test-paths ["spec"]) 12 | -------------------------------------------------------------------------------- /wator/spec/wator/core_spec.clj: -------------------------------------------------------------------------------- 1 | (ns wator.core-spec 2 | (:require [speclj.core :refer :all] 3 | [wator 4 | [cell :as cell] 5 | [water :as water] 6 | [water-imp] 7 | [animal :as animal] 8 | [fish :as fish] 9 | [fish-imp] 10 | [shark :as shark] 11 | [world :as world] 12 | [world-imp]] 13 | [wator.config :as config])) 14 | 15 | (describe "Wator" 16 | (with-stubs) 17 | (context "Water" 18 | (it "usually remains water" 19 | (with-redefs [rand (stub :rand {:return 0.0})] 20 | (let [water (water/make) 21 | world (world/make 1 1) 22 | [from to] (cell/tick water [0 0] world)] 23 | (should-be-nil from) 24 | (should (water/is? (get to [0 0]))) 25 | ))) 26 | 27 | (it "occasionally evolves into a fish" 28 | (with-redefs [rand (stub :rand {:return 1.0})] 29 | (let [water (water/make) 30 | world (world/make 1 1) 31 | [from to] (cell/tick water [0 0] world)] 32 | (should-be-nil from) 33 | (should (fish/is? (get to [0 0]))))))) 34 | 35 | (context "world" 36 | (it "creates a world full of water cells" 37 | (let [world (world/make 2 2) 38 | cells (::world/cells world) 39 | positions (set (keys cells))] 40 | (should= #{[0 0] [0 1] 41 | [1 0] [1 1]} positions) 42 | (should (every? #(= ::water/water (::cell/type %)) (vals cells))))) 43 | 44 | (it "makes neighbors" 45 | (let [world (world/make 5 5)] 46 | (should= [[0 0] [0 1] [0 2] 47 | [1 0] [1 2] 48 | [2 0] [2 1] [2 2]] 49 | (world/neighbors world [1 1])) 50 | (should= [[4 4] [4 0] [4 1] 51 | [0 4] [0 1] 52 | [1 4] [1 0] [1 1]] 53 | (world/neighbors world [0 0])) 54 | (should= [[3 3] [3 4] [3 0] 55 | [4 3] [4 0] 56 | [0 3] [0 4] [0 0]] 57 | (world/neighbors world [4 4])))) 58 | 59 | (it "moves a fish around each tick" 60 | (doseq [scenario [{:dimension [2 1] :starting [0 0] :ending [1 0]} 61 | {:dimension [2 1] :starting [1 0] :ending [0 0]} 62 | {:dimension [1 2] :starting [0 0] :ending [0 1]} 63 | {:dimension [1 2] :starting [0 1] :ending [0 0]}]] 64 | (let [fish (fish/make) 65 | {:keys [dimension starting ending]} scenario 66 | [h w] dimension 67 | small-world (-> (world/make h w) 68 | (world/set-cell starting fish) 69 | (world/tick)) 70 | vacated-cell (world/get-cell small-world starting) 71 | occupied-cell (world/get-cell small-world ending)] 72 | (should (water/is? vacated-cell)) 73 | (should (fish/is? occupied-cell)) 74 | (should= 1 (animal/age occupied-cell))))) 75 | 76 | (it "fills the world with reproducing fish" 77 | (loop [world (-> (world/make 10 10) 78 | (world/set-cell [5 5] (fish/make))) 79 | n 100] 80 | (if (zero? n) 81 | (let [cells (-> world ::world/cells vals) 82 | fishies (filter fish/is? cells) 83 | fish-count (count fishies)] 84 | (should (< 50 fish-count))) 85 | (recur (world/tick world) (dec n))))) 86 | 87 | (it "move two fish who compete for the same spot" 88 | (let [fish (fish/make) 89 | competative-world (-> (world/make 3 1) 90 | (world/set-cell [0 0] fish) 91 | (world/set-cell [2 0] fish) 92 | (world/tick)) 93 | start-00 (world/get-cell competative-world [0 0]) 94 | start-20 (world/get-cell competative-world [2 0]) 95 | end-10 (world/get-cell competative-world [1 0])] 96 | (should (fish/is? end-10)) 97 | (should (or (fish/is? start-00) 98 | (fish/is? start-20))) 99 | (should (or (water/is? start-00) 100 | (water/is? start-20))))) 101 | ) 102 | 103 | (context "animal" 104 | (it "moves" 105 | (doseq [scenario [{:constructor fish/make :tester fish/is?} 106 | {:constructor shark/make :tester shark/is?}]] 107 | (let [animal ((:constructor scenario)) 108 | world (-> (world/make 3 3) 109 | (world/set-cell [1 1] animal)) 110 | [from to] (animal/move animal [1 1] world) 111 | loc (first (keys to))] 112 | (should (water/is? (get from [1 1]))) 113 | (should ((:tester scenario) (get to loc))) 114 | (should (#{[0 0] [0 1] [0 2] 115 | [1 0] [1 2] 116 | [2 0] [2 1] [2 2]} 117 | loc))))) 118 | 119 | (it "doesn't move if there are no spaces" 120 | (doseq [scenario [{:constructor fish/make :tester fish/is?} 121 | {:constructor shark/make :tester shark/is?}]] 122 | (let [animal ((:constructor scenario)) 123 | world (-> (world/make 1 1) 124 | (world/set-cell [0 0] animal)) 125 | [from to] (animal/move animal [0 0] world)] 126 | (should ((:tester scenario) (get to [0 0]))) 127 | (should (nil? from))))) 128 | 129 | (it "reproduces" 130 | (doseq [scenario [{:constructor fish/make :tester fish/is?} 131 | {:constructor #(-> (shark/make) 132 | (shark/set-health (inc config/shark-reproduction-health))) 133 | :tester shark/is?}]] 134 | (let [animal ((:constructor scenario)) 135 | reproduction-age (animal/get-reproduction-age animal) 136 | animal (animal/set-age animal reproduction-age) 137 | world (-> (world/make 3 3) 138 | (world/set-cell [1 1] animal)) 139 | [from to] (animal/reproduce animal [1 1] world) 140 | from-loc (-> from keys first) 141 | from-cell (-> from vals first) 142 | to-loc (-> to keys first) 143 | to-cell (-> to vals first)] 144 | (should= from-loc [1 1]) 145 | (should ((:tester scenario) from-cell)) 146 | (should= 0 (animal/age from-cell)) 147 | (should (#{[0 0] [0 1] [0 2] 148 | [1 0] [1 2] 149 | [2 0] [2 1] [2 2]} 150 | to-loc)) 151 | (should ((:tester scenario) to-cell)) 152 | (should= 0 (animal/age to-cell))))) 153 | 154 | (it "doesn't reproduce if there is no room" 155 | (doseq [scenario [{:constructor fish/make :tester fish/is?} 156 | {:constructor shark/make :tester shark/is?}]] 157 | (let [animal ((:constructor scenario)) 158 | reproduction-age (animal/get-reproduction-age animal) 159 | animal (animal/set-age animal reproduction-age) 160 | world (-> (world/make 1 1) 161 | (world/set-cell [0 0] animal)) 162 | failed (animal/reproduce animal [0 0] world)] 163 | (should-be-nil failed)))) 164 | 165 | (it "doesn't reproduce if too young" 166 | (doseq [scenario [{:constructor fish/make :tester fish/is?} 167 | {:constructor shark/make :tester shark/is?}]] 168 | (let [animal ((:constructor scenario)) 169 | reproduction-age (animal/get-reproduction-age animal) 170 | animal (animal/set-age animal (dec reproduction-age)) 171 | world (-> (world/make 3 3) 172 | (world/set-cell [1 1] animal)) 173 | failed (animal/reproduce animal [1 1] world)] 174 | (should-be-nil failed))))) 175 | 176 | (context "shark" 177 | (it "starts with some health" 178 | (let [shark (shark/make)] 179 | (should= config/shark-starting-health 180 | (shark/health shark)))) 181 | 182 | (it "loses health with time" 183 | (let [small-world (-> (world/make 1 1) 184 | (world/set-cell [0 0] (shark/make))) 185 | aged-world (world/tick small-world) 186 | aged-shark (world/get-cell aged-world [0 0])] 187 | (should= (dec config/shark-starting-health) 188 | (shark/health aged-shark)))) 189 | 190 | (it "dies when health goes to zero" 191 | (let [sick-shark (-> (shark/make) 192 | (shark/set-health 1)) 193 | small-world (-> (world/make 1 1) 194 | (world/set-cell [0 0] sick-shark)) 195 | aged-world (world/tick small-world) 196 | dead-shark (world/get-cell aged-world [0 0])] 197 | (should (water/is? dead-shark)))) 198 | 199 | (it "eats when a fish is adjacent" 200 | (let [world (-> (world/make 2 1) 201 | (world/set-cell [0 0] (fish/make)) 202 | (world/set-cell [1 0] (shark/make))) 203 | shark-ate-world (world/tick world) 204 | full-shark (world/get-cell shark-ate-world [0 0]) 205 | where-shark-was (world/get-cell shark-ate-world [1 0]) 206 | expected-health (max config/shark-max-health 207 | (+ config/shark-starting-health 208 | config/shark-eating-health 209 | -1))] 210 | (should (shark/is? full-shark)) 211 | (should (water/is? where-shark-was)) 212 | (should= expected-health (shark/health full-shark)))) 213 | 214 | (it "shares health with both daughters after reproduction" 215 | (let [initial-health (inc config/shark-reproduction-health) 216 | pregnant-shark (-> (shark/make) 217 | (animal/set-age (inc config/shark-reproduction-age)) 218 | (shark/set-health initial-health)) 219 | world (-> (world/make 2 1) 220 | (world/set-cell [0 0] pregnant-shark)) 221 | new-world (world/tick world) 222 | daughter1 (world/get-cell new-world [0 0]) 223 | daughter2 (world/get-cell new-world [1 0]) 224 | expected-health (quot (dec initial-health) 2)] 225 | (should (shark/is? daughter1)) 226 | (should (shark/is? daughter2)) 227 | (should= expected-health (shark/health daughter1)) 228 | (should= expected-health (shark/health daughter2)))) 229 | 230 | (it "doesn't reproduce if not healthy enough" 231 | (let [shark (-> (shark/make) 232 | (shark/set-health (dec config/shark-reproduction-health)) 233 | (animal/set-age config/shark-reproduction-age)) 234 | world (-> (world/make 3 3) 235 | (world/set-cell [1 1] shark)) 236 | failed (animal/reproduce shark [1 1] world)] 237 | (should-be-nil failed)))) 238 | 239 | (context "fish" 240 | (it "usually remains fish" 241 | (with-redefs [rand (stub :rand {:return 0.0})] 242 | (let [fish (fish/make) 243 | world (world/make 1 1) 244 | [from to] (cell/tick fish [0 0] world)] 245 | (should-be-nil from) 246 | (should (fish/is? (get to [0 0]))) 247 | ))) 248 | 249 | (it "occasionally evolves into a shark" 250 | (with-redefs [rand (stub :rand {:return 1.0})] 251 | (let [fish (fish/make) 252 | world (world/make 1 1) 253 | [from to] (cell/tick fish [0 0] world)] 254 | (should-be-nil from) 255 | (should (shark/is? (get to [0 0])))))))) 256 | 257 | 258 | 259 | 260 | -------------------------------------------------------------------------------- /wator/src/wator/animal.clj: -------------------------------------------------------------------------------- 1 | (ns wator.animal 2 | (:require [clojure.spec.alpha :as s] 3 | [wator 4 | [world :as world] 5 | [cell :as cell] 6 | [water :as water]])) 7 | 8 | (s/def ::age int?) 9 | (s/def ::animal (s/keys :req [::age])) 10 | 11 | (defmulti move (fn [animal & args] (::cell/type animal))) 12 | (defmulti reproduce (fn [animal & args] (::cell/type animal))) 13 | (defmulti make-child ::cell/type) 14 | (defmulti get-reproduction-age ::cell/type) 15 | 16 | (defn make [] 17 | {::age 0}) 18 | 19 | (defn age [animal] 20 | (::age animal)) 21 | 22 | (defn set-age [animal age] 23 | (assoc animal ::age age)) 24 | 25 | (defn increment-age [animal] 26 | (update animal ::age inc)) 27 | 28 | (defn tick [animal loc world] 29 | (let [aged-animal (increment-age animal) 30 | reproduction (reproduce aged-animal loc world)] 31 | (if reproduction 32 | reproduction 33 | (move aged-animal loc world)))) 34 | 35 | (defn do-move [animal loc world] 36 | (let [neighbors (world/neighbors world loc) 37 | moved-into (get world :moved-into #{}) 38 | available-neighbors (remove moved-into neighbors) 39 | destinations (filter #(water/is? (world/get-cell world %)) 40 | available-neighbors) 41 | new-location (if (empty? destinations) 42 | loc 43 | (rand-nth destinations))] 44 | (if (= new-location loc) 45 | [nil {loc animal}] 46 | [{loc (water/make)} {new-location animal}]))) 47 | 48 | (defn do-reproduce [animal loc world] 49 | (if (>= (age animal) (get-reproduction-age animal)) 50 | (let [neighbors (world/neighbors world loc) 51 | birth-places (filter #(water/is? (world/get-cell world %)) 52 | neighbors)] 53 | (if (empty? birth-places) 54 | nil 55 | [{loc (set-age animal 0)} 56 | {(rand-nth birth-places) (make-child animal)}])) 57 | nil)) 58 | 59 | -------------------------------------------------------------------------------- /wator/src/wator/cell.clj: -------------------------------------------------------------------------------- 1 | (ns wator.cell) 2 | 3 | (defmulti tick (fn [cell & args] (::type cell))) 4 | 5 | -------------------------------------------------------------------------------- /wator/src/wator/config.clj: -------------------------------------------------------------------------------- 1 | (ns wator.config) 2 | 3 | (def water-evolution-rate 0.99999) 4 | (def fish-evolution-rate 0.99999) 5 | (def fish-reproduction-age 6) 6 | (def shark-reproduction-age 5) 7 | (def shark-reproduction-health 8) 8 | (def shark-starting-health 5) 9 | (def shark-eating-health 5) 10 | (def shark-max-health 10) -------------------------------------------------------------------------------- /wator/src/wator/fish.clj: -------------------------------------------------------------------------------- 1 | (ns wator.fish 2 | (:require [clojure.spec.alpha :as s] 3 | [wator 4 | [cell :as cell] 5 | [animal :as animal]] 6 | [wator.config :as config])) 7 | 8 | (s/def ::fish (s/and #(= ::fish (::cell/type %)) 9 | ::animal/animal)) 10 | (defn is? [cell] 11 | (= ::fish (::cell/type cell))) 12 | 13 | (defn make [] 14 | {:post [(s/valid? ::fish %)]} 15 | (merge {::cell/type ::fish} 16 | (animal/make))) 17 | 18 | (defmethod animal/make-child ::fish [fish] 19 | (make)) 20 | 21 | (defmethod animal/get-reproduction-age ::fish [fish] 22 | config/fish-reproduction-age) 23 | 24 | 25 | -------------------------------------------------------------------------------- /wator/src/wator/fish_imp.clj: -------------------------------------------------------------------------------- 1 | (ns wator.fish-imp 2 | (:require [wator 3 | [config :as config] 4 | [cell :as cell] 5 | [animal :as animal] 6 | [fish :as fish] 7 | [shark :as shark]])) 8 | 9 | (defmethod cell/tick ::fish/fish [fish loc world] 10 | (if (> (rand) config/fish-evolution-rate) 11 | [nil {loc (shark/make)}] 12 | (animal/tick fish loc world))) 13 | 14 | (defmethod animal/move ::fish/fish [fish loc world] 15 | (animal/do-move fish loc world)) 16 | 17 | (defmethod animal/reproduce ::fish/fish [fish loc world] 18 | (animal/do-reproduce fish loc world)) 19 | 20 | -------------------------------------------------------------------------------- /wator/src/wator/shark.clj: -------------------------------------------------------------------------------- 1 | (ns wator.shark 2 | (:require [clojure.spec.alpha :as s] 3 | [wator 4 | [config :as config] 5 | [world :as world] 6 | [cell :as cell] 7 | [water :as water] 8 | [fish :as fish] 9 | [animal :as animal]])) 10 | 11 | (s/def ::health int?) 12 | (s/def ::shark (s/and #(= ::shark (::cell/type %)) 13 | ::animal/animal 14 | (s/keys :req [::health]))) 15 | (defn is? [cell] 16 | (= ::shark (::cell/type cell))) 17 | 18 | (defn make [] 19 | {:post [(s/valid? ::shark %)]} 20 | (merge {::cell/type ::shark 21 | ::health config/shark-starting-health} 22 | (animal/make))) 23 | 24 | (defmethod animal/make-child ::shark [fish] 25 | (make)) 26 | 27 | (defmethod animal/get-reproduction-age ::shark [shark] 28 | config/shark-reproduction-age) 29 | 30 | (defn health [shark] 31 | (::health shark)) 32 | 33 | (defn set-health [shark health] 34 | (assoc shark ::health health)) 35 | 36 | (defn decrement-health [shark] 37 | (update shark ::health dec)) 38 | 39 | (defn feed [shark] 40 | (let [new-health (max config/shark-max-health 41 | (+ (health shark) config/shark-eating-health))] 42 | (assoc shark ::health new-health))) 43 | 44 | (defn eat [shark loc world] 45 | (let [neighbors (world/neighbors world loc) 46 | fishy-neighbors (filter #(fish/is? (world/get-cell world %)) 47 | neighbors)] 48 | (if (empty? fishy-neighbors) 49 | nil 50 | [{loc (water/make)} 51 | {(rand-nth fishy-neighbors) (feed shark)}])) 52 | ) 53 | 54 | (defmethod cell/tick ::shark [shark loc world] 55 | (if (= 1 (health shark)) 56 | [nil {loc (water/make)}] 57 | (let [aged-shark (-> shark 58 | (animal/increment-age) 59 | (decrement-health))] 60 | (if-let [reproduction (animal/reproduce aged-shark loc world)] 61 | reproduction 62 | (if-let [eaten (eat aged-shark loc world)] 63 | eaten 64 | (animal/move aged-shark loc world)))))) 65 | 66 | (defmethod animal/move ::shark [shark loc world] 67 | (animal/do-move shark loc world)) 68 | 69 | (defmethod animal/reproduce ::shark [shark loc world] 70 | (if (< (health shark) config/shark-reproduction-health) 71 | nil 72 | (if-let [reproduction (animal/do-reproduce shark loc world)] 73 | (let [[from to] reproduction 74 | from-loc (-> from keys first) 75 | to-loc (-> to keys first) 76 | daughter-health (quot (health shark) 2) 77 | from-shark (-> from vals first (set-health daughter-health)) 78 | to-shark (-> to vals first (set-health daughter-health))] 79 | [{from-loc from-shark} 80 | {to-loc to-shark}]) 81 | nil))) 82 | 83 | -------------------------------------------------------------------------------- /wator/src/wator/water.clj: -------------------------------------------------------------------------------- 1 | (ns wator.water 2 | (:require [wator 3 | [cell :as cell]])) 4 | 5 | (defn make [] {::cell/type ::water}) 6 | 7 | (defn is? [cell] 8 | (= ::water (::cell/type cell))) 9 | -------------------------------------------------------------------------------- /wator/src/wator/water_imp.clj: -------------------------------------------------------------------------------- 1 | (ns wator.water-imp 2 | (:require [wator 3 | [cell :as cell] 4 | [water :as water] 5 | [fish :as fish] 6 | [config :as config]])) 7 | 8 | (defmethod cell/tick ::water/water [water loc world] 9 | (if (> (rand) config/water-evolution-rate) 10 | [nil {loc (fish/make)}] 11 | [nil {loc water}])) 12 | -------------------------------------------------------------------------------- /wator/src/wator/world.clj: -------------------------------------------------------------------------------- 1 | (ns wator.world 2 | (:require [clojure.spec.alpha :as s] 3 | [wator 4 | [cell :as cell]])) 5 | 6 | (s/def ::location (s/tuple int? int?)) 7 | (s/def ::cell #(contains? % ::cell/type)) 8 | (s/def ::cells (s/map-of ::location ::cell)) 9 | (s/def ::bounds ::location) 10 | (s/def ::world (s/and (s/keys :req [::cells ::bounds]) 11 | #(= (::type %) ::world))) 12 | 13 | (defmulti tick ::type) 14 | (defmulti make-cell (fn [factory-type cell-type] factory-type)) 15 | 16 | (defn make [w h] 17 | {:post [(s/valid? ::world %)]} 18 | (let [locs (for [x (range w) y (range h)] [x y]) 19 | default-cell (make-cell ::world :default-cell) 20 | loc-water (interleave locs (repeat default-cell)) 21 | cells (apply hash-map loc-water)] 22 | {::type ::world 23 | ::cells cells 24 | ::bounds [w h]})) 25 | 26 | (defn set-cell [world loc cell] 27 | (assoc-in world [::cells loc] cell)) 28 | 29 | (defn get-cell [world loc] 30 | (get-in world [::cells loc])) 31 | 32 | (defn wrap [world [x y]] 33 | (let [[w h] (::bounds world)] 34 | [(mod x w) (mod y h)]) 35 | ) 36 | 37 | (defn neighbors [world loc] 38 | (let [[x y] loc 39 | neighbors (for [dx (range -1 2) dy (range -1 2)] 40 | (wrap world [(+ x dx) (+ y dy)]))] 41 | (remove #(= loc %) neighbors))) 42 | 43 | 44 | -------------------------------------------------------------------------------- /wator/src/wator/world_imp.clj: -------------------------------------------------------------------------------- 1 | (ns wator.world-imp 2 | (:require [wator 3 | [world :as world :refer :all] 4 | [cell :as cell] 5 | [fish :as fish] 6 | [shark :as shark] 7 | [water :as water]])) 8 | 9 | (defmethod world/tick ::world/world [world] 10 | (let [cells (::world/cells world)] 11 | (loop [locs (keys cells) 12 | new-cells {} 13 | moved-into #{}] 14 | (cond 15 | (empty? locs) 16 | (assoc world ::world/cells new-cells) 17 | 18 | (contains? moved-into (first locs)) 19 | (recur (rest locs) new-cells moved-into) 20 | 21 | :else 22 | (let [loc (first locs) 23 | cell (get cells loc) 24 | [from to] (cell/tick cell loc (assoc world :moved-into moved-into)) 25 | new-cells (-> new-cells (merge from) (merge to)) 26 | to-loc (first (keys to)) 27 | to-cell (get to to-loc) 28 | moved-into (if (water/is? to-cell) 29 | moved-into 30 | (conj moved-into to-loc))] 31 | (recur (rest locs) new-cells moved-into)))))) 32 | 33 | (defmethod world/make-cell ::world/world [world cell-type] 34 | (condp = cell-type 35 | :default-cell (water/make) 36 | :water (water/make) 37 | :fish (fish/make) 38 | :shark (shark/make))) 39 | -------------------------------------------------------------------------------- /wator/src/wator_gui/main.clj: -------------------------------------------------------------------------------- 1 | (ns wator-gui.main 2 | (:require [quil.core :as q] 3 | [quil.middleware :as m] 4 | [wator 5 | [world :as world] 6 | [water :as water] 7 | [fish :as fish] 8 | [shark :as shark] 9 | [world-imp] 10 | [water-imp] 11 | [fish-imp]])) 12 | 13 | (defn setup [] 14 | (q/frame-rate 60) 15 | (q/color-mode :rgb) 16 | (-> (world/make 80 80) 17 | (world/set-cell [40 40] (fish/make))) 18 | ) 19 | 20 | (defn update-state [world] 21 | (world/tick world)) 22 | 23 | (defn draw-state [world] 24 | (q/background 240) 25 | (let [cells (::world/cells world)] 26 | (doseq [loc (keys cells)] 27 | (let [[x y] loc 28 | cell (get cells loc) 29 | x (* 12 x) 30 | y (* 12 y) 31 | color (cond 32 | (water/is? cell) [255 255 255] 33 | (fish/is? cell) [0 0 255] 34 | (shark/is? cell) [255 0 0])] 35 | (q/no-stroke) 36 | (apply q/fill color) 37 | (when-not (water/is? cell) 38 | (q/rect x y 11 11)))))) 39 | 40 | (declare wator) 41 | 42 | (defn ^:export -main [& args] 43 | (q/defsketch wator 44 | :title "Wator" 45 | :size [960 960] 46 | :setup setup 47 | :update update-state 48 | :draw draw-state 49 | :features [:keep-on-top] 50 | :middleware [m/fun-mode]) 51 | args) 52 | 53 | --------------------------------------------------------------------------------