Code aus der Wiederholungsstunde vom 30.1.

dynamic.clj

(ns wdhg.dynamic)

;; Lexical scoping

(def x 2)

(defn foo [n] (* x n))

(def a  (foo 3))

(def b (let [x 3]
         (foo 3)))

(= a b) ;; Was kommt raus und warum?

(comment
  (def c (binding [x 3]
           (foo 3)))
  )

;; Dynamic scoping 

(def ^:dynamic *y* 2)
(def *blah* 5) ;; warning

(defn bar [n] (* *y* n))

(def d (bar 3))

(def e (let [*y* 3] (bar 3)))



(def f (binding [*y* 3] (bar 3)))

(= d f)

(def g (let [n 5] (binding [*y* 3] (bar n))))


;; Schritt 1: Schau im lokalen Scope nach
;; Schritt 2: 
;; a) Lexical Scoping: (Schau in der Definition nach)*
;; b) Dynamic Scoping: (Schau im Aufrufer nach)*

;; Vermeide dynamisches Scoping nach Möglichkeit

macro.clj

(ns wdhg.macro
  (:use clojure.walk))

(defn foo []
  (Thread/sleep (rand-int 1000))
  :done)

(def x (time (foo)))

x

;; Ausgabe fangen
(let [sw (java.io.StringWriter.)]
  (binding [*out* sw]
    (time (foo)))
  (.toString sw))


;; Abstraktion in einer Funktion
;; Jeder sollte erklären können, warum das nicht geht!


(defmacro catch-print1 [& body]
  `(let [sw (java.io.StringWriter.)]
     (binding [*out* sw]
       (do ~@body))
     (.toString sw)))

(comment
  (catch-print1 (time (foo)))
  )

;; Was bedeutet die Fehlermeldung?

(macroexpand '(catch-print1 (time (foo))))

(comment
  (let [user/foo 1] foo))

(defmacro catch-print2 [& body]
  `(let [~'sw (java.io.StringWriter.)]
     (binding [*out* ~'sw]
       (do ~@body))
     (.toString ~'sw)))

(catch-print2 (time (foo)))

(macroexpand '(catch-print2 (time (foo))))

(comment
  (defmacro catch-print3 [& body]
    `(let [~sw (java.io.StringWriter.)]
       (binding [*out* ~sw]
         (do ~@body))
       (.toString ~sw)))
  )


(defmacro catch-print4 [& body]
  `(let [sw# (java.io.StringWriter.)]
     (binding [*out* sw#]
       (do ~@body))
     (.toString sw#)))


(def y (catch-print4 (time (foo))))

y

(macroexpand '(catch-print4 (time (foo))))

;; catch-print gibt es in Clojure schon
;; es heisst: with-out-str


;; Eine Luxus-Variante

(defmacro catch-output [& body]
  `(let [sw-out# (java.io.StringWriter.)
         sw-err# (java.io.StringWriter.)]
     (binding [*out* sw-out#
               *err* sw-err#]
       (let [result# (do ~@body)]
         {:out (.toString sw-out#)
          :err (.toString sw-err#)
          :result result#}))))


(def z  (catch-output
         (println "foo")
         (binding [*out* *err*]
           (println "Goodbye, world!"))
         (println "haha")
         42))

multimethod.clj

(ns wdhg.multimethod)
  (def statespace {:states [1 2 3 4 5]
                   :transitions [[1 3] [2 1] [3 2] [3 5]
                                 [4 3] [5 2] [3 4] [1 2]
                                 [1 4]]})

  (defn compute-next [task]
    (let [transitions-map (group-by first (:transitions statespace))
          successor-transitions (transitions-map task)]
      (map second successor-transitions)))

  (defn member [v e] ((into #{} v) e))

(declare fixo-peek fixo-push fixo-take)

  (defn model-check
    "Durchläuft den Zustandsraum. Erster Parameter ist ein Zwischenspeicher
mit Reihenfolge. Zweiter Parameter ein Speicher um Endlosschleifen zu verhindern."
    [tasks done]
    (if (fixo-peek tasks) ;; nicht leer
      (let [[e tasks'] (fixo-take tasks)] ;; nächstes Element + neuer Speicher
        (if-not (member done e)
          (let [successors (compute-next e)
                nt (fixo-push tasks' successors) ;; Nachfolger einfügen
                done' (conj done e)]
            (recur nt done'))
          (recur tasks' done)))
      done))


(defn create-queue [] {:tag :queue})
(defn create-stack [] {:tag :stack})
(defn create-prio [] {:tag :prio})

(defmulti fixo-push (fn [m _] (:tag m)))
(defmulti fixo-take :tag)
(defmulti fixo-peek :tag)

(defmethod fixo-peek :queue [{c :content}] (first c))
(defmethod fixo-peek :prio [{c :content}] (first c))
(defmethod fixo-peek :stack [{c :content}] (last c))

(defmethod fixo-push :queue [m es] (update-in m [:content] #(concat % es)))
(defmethod fixo-push :prio [m es] (update-in m [:content] #(sort (concat % es))))
(defmethod fixo-push :stack [m es] (update-in m [:content] #(concat % es)))

(defmethod fixo-take :queue [m] [(fixo-peek m) (update-in m [:content] rest)])
(defmethod fixo-take :prio [m] [(fixo-peek m) (update-in m [:content] rest)])
(defmethod fixo-take :stack [m] [(fixo-peek m) (update-in m [:content] butlast)])



(defn run [] (let [ bf (model-check (fixo-push (create-queue) [1]) [])
                    df (model-check (fixo-push (create-stack) [1]) [])
                    prio (model-check (fixo-push (create-prio) [1]) [])]
                {:bf bf :df df :prio prio}))

ns.clj

(ns wdhg.ns
  (:refer-clojure :exclude [replace])
  (:require [clojure.repl :as repl :refer [doc dir]])
  (:use clojure.walk)
  (:import java.io.File))

(comment
  (replace {1 2} [1 2 3])
  ) ;; replace aus clojure.core ist weg

(clojure.core/replace {1 2} [1 2 3])

(doc clojure.core/replace) ;; doc kann ohne prefix aufgerufen werden
(dir clojure.repl) ;; dir auch

(comment 
  (source dir)
  );; source aber nicht

(repl/source dir)
(clojure.repl/source doc)


(.exists (File. ".")) ;; File ist importiert

(comment
  (.getMonth (Date.)) ;; Date nicht
  )

(.getMonth (java.util.Date.))

(first [1 2 3]) ;; clojure.core 
(clojure.string/join "," [1 2 3]) ;; clojure.string 
(doc clojure.algo.monads/domonad) ;; clojure.algo.monads

protocol.clj

(ns wdhg.protocol)
(def statespace {:states [1 2 3 4 5]
                 :transitions [[1 3] [2 1] [3 2] [3 5]
                               [4 3] [5 2] [3 4] [1 2]
                               [1 4]]})

(defn compute-next [task]
  (let [transitions-map (group-by first (:transitions statespace))
        successor-transitions (transitions-map task)]
    (map second successor-transitions)))

(compute-next 1)


;; Abstrakte Spezifikation eines Zwischenspeichers
(defprotocol PFixo
  (fixo-take [t]) ;; returns [first rest]
  (fixo-push [t es]) ;; returns new DS
  (fixo-peek [e])) ;; first or nil

(defn member [v e] ((into #{} v) e))

(defn model-check
  "Durchläuft den Zustandsraum. Erster Parameter ist ein Zwischenspeicher
mit Reihenfolge. Zweiter Parameter ein Speicher um Endlosschleifen zu verhindern."
  [tasks done]
  (if (fixo-peek tasks) ;; nicht leer
    (let [[e tasks'] (fixo-take tasks)] ;; nächstes Element + neuer Speicher
      (if-not (member done e)
        (let [successors (compute-next e)
              nt (fixo-push tasks' successors) ;; Nachfolger einfügen
              done' (conj done e)]
          (recur nt done'))
        (recur tasks' done)))
    done))

;; Erste Implementierung: LIFO
(defrecord Stack [x]
  PFixo
  (fixo-take [this] (let [x (:x this)]
                   [(last x) (->Stack (vec (butlast x)))]))
  (fixo-peek [this] (last (:x this)))
  (fixo-push [this es]  (->Stack (concat (:x this) es))))

(fixo-push (->Stack [1 2 3]) [5 6 7])

(defn create-stack [& e]
  (fixo-push (->Stack []) e))

(create-stack 8 9)

;; Zweite Implementierung FIFO
(defrecord Q [x]
  PFixo
  (fixo-take [t] (let [x (:x t)]
                   [(first x) (->Q (vec (rest x)))]))
  (fixo-peek [t] (first (:x  t)))
  (fixo-push [t es] (->Q (concat (:x t) es))))

(defn create-queue [& e]
  (fixo-push (->Q []) e))



(defrecord PRIO [x]
  PFixo
  (fixo-take [t] (let [x (:x t)]
                   [(first x) (->PRIO (vec (rest x)))]))
  (fixo-peek [t] (first (:x  t)))
  (fixo-push [t es] (->PRIO (sort (concat (:x t) es))))
  )

(defn create-prio [& e]
  (fixo-push (->PRIO []) e))

(defn run []
  (let [bf (model-check (fixo-push (create-queue) [1]) [])
        df (model-check (fixo-push (create-stack) [1]) [])
        prio (model-check (fixo-push (create-prio) [1]) [])]
    {:bf bf :df df :prio prio}))