(defmacro block [ctx & expr]
`(let [~#(mapcat (fn [[k v]] [k `~v]) ctx)]
~#expr
))
(defn action1 [] (print "action1") (rand-nth [true false]))
(defn action2 [] (print "action2") (rand-nth [true false]))
( block { __blockaddrabsolute "1_1" __blockaddr "1_1"}
( block {typeofparent "ummutate" __nodeid "c21f80" __blockaddr "1_1_1"} ( action1 ))
( block {__blockaddrabsolute "1_1_2" __nodeid "c60590" __blockaddr "1_1_2"} ( action2 ))
( block {__blockaddrabsolute "1_1_3" __nodeid "c60595" __blockaddr "1_1_3"} ( action1 ))
( block {__blockaddrabsolute "1_1_4" __nodeid "c60596" __blockaddr "1_1_4"} ( action2 ))
"end" )
I want to break the execution from macro evaluation if any of the action returns false.
Expected output :
action1 true
action2 true
action1 false
The short-circuiting behavior you want is available through if/when forms, so we can use macros to transform a series of forms in the body into nested when forms:
(defmacro block [bindings & body]
(let [whens (reduce (fn [acc elem]
`(when ~elem ~acc))
(last body)
(reverse (butlast body)))]
`(let [~#(mapcat (fn [[k v]] [k `~v]) bindings)]
~whens)))
Then if we macroexpand your sample block form we get this (reformatted for readability):
(let* [__blockaddrabsolute "1_1" __blockaddr "1_1"]
(when (block {typeofparent "ummutate", __nodeid "c21f80", __blockaddr "1_1_1"} (action1))
(when (block {__blockaddrabsolute "1_1_2", __nodeid "c60590", __blockaddr "1_1_2"} (action2))
(when (block {__blockaddrabsolute "1_1_3", __nodeid "c60595", __blockaddr "1_1_3"} (action1))
(when (block {__blockaddrabsolute "1_1_4", __nodeid "c60596", __blockaddr "1_1_4"} (action2))
"end")))))
Because your action1/action2 functions return random booleans you'll get varying results, but you do get the desired short-circuiting behavior. If any of the nested forms fail the when test, the ultimate result will be nil.
I'd consider refactoring this by introducing a more focused, generally useful do-like macro that short-circuits when any of its inner forms aren't truthy, and isn't concerned with bindings at all. Then use let for your inner bindings:
(defmacro do-when [x & xs]
(if xs
`(when ~x (do-when ~#xs))
`~x))
(do-when
(let [x 1 y 2] (println "step 1") (= x (dec y)))
(rand-nth [true false])
"randomly successful result")
Related
I'm new to Clojure and I tried to implement a genetic algorithm. Thus, I've got a problem, the implementation keeps throwing the following error:
class clojure.lang.LazySeq cannot be cast to class clojure.lang.Associative (clojure.lang.LazySeq and clojure.lang.Associative are in unnamed module
of loader 'app')
To be mentioned that each function is tested individually in REPL and returns the correct results but after putting them all together, the error is thrown, and I don't understand it since it doesn't seems to specify a line number.
The version of clojure is the one from master branch and built with maven, on Windows.
The full code:
(ns ga)
(defn new-individual
[genome-length]
{:genome (vec (repeatedly genome-length #(rand-int 2))) :fitness 0}
)
(defn fitness-function
[genome, target]
(Math/abs (- (reduce + genome) target))
)
(defn calculate-fitness
[population, target]
(defn fitness-function-helper
[individual, target]
(assoc individual :fitness (fitness-function (individual :genome) target))
)
(map (fn [individual] (#(fitness-function-helper individual target))) population)
)
(defn crossover
[first-individual, second-individual, crossover-rate, target]
(let [new-genome (map (fn [i1,i2] (let [crossover-probability (rand)]
(cond
(<= crossover-probability crossover-rate) i1
:else i2
)
)
)
(first-individual :genome) (second-individual :genome)
)]
{:genome new-genome :fitness (fitness-function new-genome target)}
)
)
(defn mutate
[individual, genome-length, target]
(let [new-genome (assoc (individual :genome) (rand-int genome-length) (rand-int 2))]
{:genome new-genome :fitness (fitness-function new-genome target)}
)
)
(defn better
[i1 i2]
(< (i1 :fitness) (i2 :fitness)))
(defn tournament-selection
[population, population-size, steps, tournament-size, new-population, target]
(if (< steps tournament-size)
(recur population population-size (inc steps) tournament-size (conj new-population (nth population ((comp rand-int -) population-size 2))) target
)
;(println new-population)
(first (sort better (calculate-fitness new-population target)))
)
)
(defn new-generation [population, population-size, crossover-rate, target, tournament-size]
(loop [steps 0 new-population ()]
(if (< steps population-size)
(let [i1 (tournament-selection population population-size 0 tournament-size () target)]
(let [i2 (tournament-selection population population-size 0 tournament-size () target)]
(let [offs (crossover i1 i2 crossover-rate target)]
(recur (inc steps) (conj new-population offs))
)
)
)
new-population
)
)
)
(defn new-mutated-generation [population, population-size, genome-length, target]
(loop [steps 0 new-population ()]
(if (< steps population-size)
(recur (inc steps) (conj new-population (mutate (nth population steps) genome-length target)))
new-population
)
)
)
(defn evolve [population-size, genome-length, target]
(let [population (calculate-fitness (repeatedly population-size #(new-individual genome-length)) target)]
(let [offsprings (new-generation population population-size 0.5 target 5)]
(println (new-mutated-generation offsprings population-size genome-length target))
)
)
)
(evolve 10 5 5)
A stacktrace reveals that the problematic code is the line
(let [new-genome (assoc (vec (individual :genome)) (rand-int genome-length) (rand-int 2))]
and more specifically, the call to assoc. If we edit the code by inserting the following line just above:
(println "Individual: " (individual :genome) ", " (class (individual :genome)))
it prints out
Individual: (0 1 1 0 1) , clojure.lang.LazySeq
The problem is that assoc cannot be used with lazy sequences (clojure.lang.LazySeq) because it does not implement the clojure.lang.Associative interface which is needed by assoc.
This lazy sequence is constructed by the call to map on this line:
(let [new-genome (map (fn [i1,i2] (let [crossover-probability (rand)]
If you replace map by mapv so that the code looks like this
(let [new-genome (mapv (fn [i1,i2] (let [crossover-probability (rand)]
the code will work.
Error happens in the function mutate. It has this source:
(defn mutate
[individual, genome-length, target]
(let [new-genome (assoc (individual :genome) (rand-int genome-length) (rand-int 2))]
{:genome new-genome :fitness (fitness-function new-genome target)}))
In one step, you are calling it with these arguments: {:genome (0 1 1 1 1), :fitness 1} 5 5 (genome can have different value, but it's always sequence of numbers).
(individual :genome) returns (0 1 1 1 1) (sequence) and then you used assoc, which is function for hash maps or vectors.
Genome is vector at the beginning, but it's converted into sequence in crossover function- use mapv instead of map here:
(defn crossover
[first-individual, second-individual, crossover-rate, target]
(let [new-genome (mapv (fn [i1, i2] (let [crossover-probability (rand)]
(if (<= crossover-probability crossover-rate) i1 i2)))
(first-individual :genome) (second-individual :genome))]
{:genome new-genome :fitness (fitness-function new-genome target)}))
By the way, all parentheses at the end of definition belong at the same line.
(defmacro action1 [] `(prn "action1" ~'start ~'etype1))
(defmacro block [bindings & body]
`(let [~#(mapcat (fn [[k v]] [(if (symbol? k) k (symbol (name k))) `'~v]) (cond
(map? bindings) bindings
(symbol? bindings) (var-get (resolve bindings))
:else (throw (Exception. "bindings must be map or symbol"))))]
~body))
(defmacro bar [ctx arity & expr]
`(let [~'t1 "lv" ~'np (prn "bar_1st_let" '~ctx ~ctx '~arity ~arity '~arity(resolve (first '~arity)) )
]
(block ~ctx ;;~ctx = {start "s1" top "x"}
(fn '~arity ;; '~arity = [etype1 cid1 id1 pl1]
(let [~'__execonceresult 1]
(do ~#expr)
)
)
)
)
)
(defmacro foo_multi [metadata ctxv aritym & expr]
`(let [~#(mapcat (fn [[k v]] [k `~v]) metadata) ~'np (prn "foo_multi_1st_let" '~aritym)]
(fn ~aritym
(for [~'ctx (filter #(= (% (some (fn [~'m] (if (= (name ~'m) "top") ~'m)) (keys %))) ~'etype) '~ctxv)]
(do (prn "foo_multi_b4_case" ~'ctx ~'etype ~aritym)
(case ~'etype
"x"
(let [[~'etype1 ~'cid1 ~'id1 ~'pl1] ~aritym ~'np (prn "foo_multi_2nd_let" ~'ctx ~'etype1 ~'cid1 ~'id1 ~'pl1)]
(bar ~'ctx [~'etype1 ~'cid1 ~'id1 ~'pl1] ~#expr))
"y"
(let [[~'etype2 ~'cid2 ~'id2 ~'pl2] ~aritym]
(bar ~'ctx [~'etype2 ~'cid2 ~'id2 ~'pl2] ~#expr))
))))))
(def foo (foo_multi { meta1 "m1" meta2 "m2" } [{start "s1" top "x"}
{start "s3" top "x"} {start "s2" top "y"}] [etype a1 a2 a3] (block {toc "c"}
(block {c1 "d"} (action1)) "end"))
)
(let [myarr ["x" 100 200 {"p" 1 "q" 2}]] (apply foo myarr))
Unable to pass arity from bar macro to block macro and getting java.lang.NullPointerException.
The rest of the code executes if I comment the block call from the bar macro.
(defmacro bar [ctx arity & expr]
`(let [~'t1 "lv" ~'np (prn "bar_1st_let" '~ctx ~ctx '~arity ~arity '~arity(resolve (first '~arity)) )
]
(comment block ~ctx ;;~ctx = {start "s1" top "x"}
(fn '~arity ;; etype specific ~arity eg: [etype1 cid1 id1 pl1]
(let [~'__execonceresult 1]
(do ~#expr) ;; uses etype1
)
)
)
)
)
After commenting below is the output of the debug lines :
"foo_multi_1st_let" [etype a1 a2 a3]
"foo_multi_b4_case" {start "s1", top "x"} "x" ["x" 100 200 {"p" 1, "q" 2}]
"foo_multi_2nd_let" {start "s1", top "x"} "x" 100 200 {"p" 1, "q" 2}
"bar_1st_let" ctx {start "s1", top "x"} [etype1 cid1 id1 pl1] ["x" 100 200 {"p" 1, "q" 2}] [etype1 cid1 id1 pl1] nil
"foo_multi_b4_case" {start "s3", top "x"} "x" ["x" 100 200 {"p" 1, "q" 2}]
"foo_multi_2nd_let" {start "s3", top "x"} "x" 100 200 {"p" 1, "q" 2}
"bar_1st_let" ctx {start "s3", top "x"} [etype1 cid1 id1 pl1] ["x" 100 200 {"p" 1, "q" 2}] [etype1 cid1 id1 pl1] nil
As per the debug lines printed above, In the bar macro I am unable to resolve first arity symbol and it is printed nil (Don't know the reason why). The goal is to pass arity correctly from bar macro to the block macro and be able to access and print start and etype1 value in action1 macro.
I'm getting a NullPointer caused by your action1 macro returning nil and the block macro trying to execute the response from action1. A splicing quote would fix that. Also, it looks to me like there are too many quotes on the values of the bindings in block, so I've taken them out too.
(defmacro block [bindings & body]
(let [bs (->>
(cond
(map? bindings) bindings
(symbol? bindings) []
:else (throw (Exception. "bindings must be map or symbol")))
(mapcat (fn [[k v]] [(if (symbol? k) k (symbol (name k))) v])))]
`(let [~#bs]
~#body)))
Secondly, clojure.core/resolve will only look up vars in a namespace, not locals created by clojure.core/let or clojure.core/fn. So if you try and resolve a local you will get nil.
(defmacro bar [bindings arity & expr]
`(block ~bindings ;;~bindings = {start "s1" top "x"}
(fn ~arity ;; '~arity = [etype1 cid1 id1 pl1]
(let [~'__execonceresult 1]
(do ~#expr)))))
(macroexpand-1 '(bar {start "s1" top "x"} [etype1 cid1 id1 pl1] (action1)))
;; =>
(do
(user/block
{start "s1", top "x"}
(clojure.core/fn
[etype1 cid1 id1 pl1]
(clojure.core/let [__execonceresult 1] (do (action1))))))
So this part of foo_multi now runs.
(block {toc "c"} (block {c1 "d"} (action1)) "end")
;;=>
"action1" :start :etype1
"end"
In foo_multi:
(defn named-top? [m]
(when (= (name m) "top")
m))
(defmacro foo_multi [metadata ctxv aritym & expr]
(prn "foo_multi" (map #(get % (some named-top? (keys %))) ctxv))
`(let [~#(mapcat (fn [[k v]] [k v]) metadata)]
(prn "foo_multi_1st_let" '~aritym)
(fn ~aritym
(for [~'ctx (filter #(= (get % (some named-top? (keys %))) ~'etype) '~ctxv)]
(do #_ (prn "foo_multi_b4_case" ~'ctx ~'etype ~aritym)
(case ~'etype
"x"
(let [[~'etype1 ~'cid1 ~'id1 ~'pl1] ~aritym ~'np (prn "foo_multi_2nd_let" ~'ctx ~'etype1 ~'cid1 ~'id1 ~'pl1)]
(bar ~'ctx [~'etype1 ~'cid1 ~'id1 ~'pl1] ~#expr))
"y"
(let [[~'etype2 ~'cid2 ~'id2 ~'pl2] ~aritym]
(bar ~'ctx [~'etype2 ~'cid2 ~'id2 ~'pl2] ~#expr))))))))
the filter (filter #(= (get % (some named-top? (keys %))) ~'etype) '~ctxv) seems like that will error because etype won't exist unless it's forced to be in the metadata argument. It's generally a bad idea to create these magic locals with the ~'idiom because you never know what you're shadowing and it's just spooky action at a distance. It's better to use the gensym feature of syntax-quote local# as described here.
Just as a comment on debugging strategy, trying to extract a simplified minimal case would have probably helped you understand what was going on. This code is rather confused I think. There's a whole bunch of stuff hacked together. It reads like you're leaning about Clojure and macros and biting off too much in one go. I think that you're trying to replicate lexical scope with these macros but I'm not totally sure what the end goal is. Maybe reading through this will help.
Also, I suspect you're going to run into trouble when you discover that clojure.core/for is lazy.
foo_multi returns a function that returns a list of functions. So to actually execute the majority of the code you've written, you'll need to call those functions.
(let [start :start
etype1 :etype1
foo (foo_multi {meta1 "m1" meta2 "m2" }
[{start "s1" top "x"}
{start "s3" top "x"}
{start "s2" top "y"}]
[etype a1 a2 a3]
(block {toc "c"}
(block {c1 "d"} (action1))
"end"))
args ["x" 100 200 {"p" 1 "q" 2}]
fns (apply foo args)]
(map #(apply % args) fns))
If you are trying to replicate lexical scope using maps instead of vectors, perhaps this code snippet will help you rethink your approach:
(defmacro my-let [bindings & body]
(let [bs (vec (mapcat (fn [[k v]] [k v]) bindings))]
`(let ~bs
~#body)))
(defmacro my-multi-let [bindings-list & body]
(->> bindings-list
(map (fn [b] `(my-let ~b ~#body)))
(cons `list)))
(macroexpand-1 '(my-let {a "a1" b "b1"} [a b]))
(macroexpand-1 '(my-multi-let [{a "a1" b "b1"} {a "a2" b "b2"}] [a b]))
as #I0st3d pointed out, this could be your solution after modifing bar definition and foo_multi will become like above solution my-multi-let.
(defmacro action1 [] `(prn "action1" ~'start ~'etype))
(defn named-type? [m] (when (= (name m) "top") m))
(defmacro block [ctx & expr]
`(let [~#(mapcat (fn [[k v]] [k `~v]) ctx)] ~#expr))
(defmacro bar [bindings & body]
`(block ~bindings (if (= ~'top ~'etype) (do
~#body))))
(defmacro foo_multi [metadata bindings-list arity & body]
(let [fns (->> bindings-list
(map (fn [b] `(bar ~b ~arity ~#body))))
] `(block ~metadata (fn ~arity (do ~#fns)))
))
(def foo (foo_multi {meta1 "m1" meta2 "m2"} [{start "s1" top "x"}
{start "s2" top "y"}] [etype a1 a2 a3]
(block {toc "c"} (block {c1 "d"} (action1)) "end")
))
(let [myarr ["x" 100 200 {"p" 1 "q" 2}]] (apply foo myarr))
In bar macro you'll get all arity params accessible, so you can create a map vars varying for etype specific symbols also if required.
your (let [myarr ["x" 100 200 {"p" 1 "q" 2}]] (apply foo myarr)) will also work as expected.
I wrote a macro to handle http response
(defmacro defhandler
[name & args]
(let [[docstring args] (if (string? (first args))
[(first args) (next args)]
[nil args])
args (apply hash-map :execute-if true (vec args))]
`(do
(def ~name
(with-meta (fn [scope# promise#]
(let [e# (:execute-if ~args)
ei# (if (fn? e#)
(e# scope#)
(boolean e#))]
(when ei#
(.then promise# (fn [result#]
(let [{:strs [http-status# value#]} result#
the-func# ((keyword http-status#) ~args)]
(the-func# scope# value#))))))) {:structure ~args}))
(alter-meta! (var ~name) assoc :doc ~docstring))))
So I can do
(defhandler my-handler
:200 (fn [$scope value] (set! (.-content $scope) value)))
But that throws "UnmatchedDelimiter" at line 1, but if I try with a named function:
(defn my-func [$scope value] (set! (.-content $scope) value))
(defhandler my-handler
:200 my-func)
It works ok. I'm just curious, is that a normal behaviour?
That is not the behavior I see when I try your example, nor does it seem very likely. I suggest checking that the forms you pasted here are exactly the ones that produce an error; I suspect your actual anonymous function included one too many )s.
Given that I have a expression of the form
'(map? %)
How do I convert it into something like
'#(map? %)
So that I can ultimately expand it into something like
'(apply #(map? %) value)
I think I should use a macro in some way, but am not sure how.
The # invokes a reader macro and reader macros expansion happen before normal macros expansion happens. So to do what you have mentioned, you need to go through the reader in your macro using read-string as shown below.
(defmacro pred [p v]
(let [s# (str \# (last p))]
`(apply ~(read-string s#) ~v)))
user=> (pred '(map? %) [{}])
true
user=> (pred '(map? %) [[]])
false
In case the data i.e the predicate expression is available at runtime then you need to use a function (which is more flexible then macro).
(defn pred [p v]
(let [s (read-string (str \# p))]
(eval `(apply ~s ~v))))
user=> (map #(pred % [12]) ['(map? %)'(even? %)])
(false true)
#(...) is a reader macro. I don't think that you can generate expression with reader macro. For example '#(map? %) will automatically expand into (fn* [p1__352#] (map? p1__352#)) or something similar.
Here's a somewhat relevant discussion on other reader macro.
Would it be possible to change format of the predicate? If it looked something like:
'([arg1] (map? arg1))
Then it would be trivial to make a function form it:
(cons 'fn '([arg1] (map? arg1)))
(def pred (eval (cons 'fn '([p](map? p)))))
#'predicate.core/pred
(pred {})
true
(pred 10)
false
Now please don't hate me for what I'm going to post next. I wrote an overly simplified version of the function reader macro:
(defn get-args [p]
(filter #(.matches (str %) "%\\d*")
(flatten p)))
(defn gen-args [p]
(into []
(into (sorted-set)
(get-args p))))
(defmacro simulate-reader [p]
(let [arglist (gen-args p)
p (if (= (str (first p)) "quote")
(second p)
p)]
(list 'fn (gen-args p) p)))
Using it is very straight-forward:
((simulate-reader '(map? %)) {}) ; -> true
; or without quote
((simulate-reader (map? %)) {})
; This also works:
((simulate-reader '(+ %1 %2)) 10 5) ; -> 15
The difference with the other solution given by #Ankur is:
I like mine less. I just thought it was a fun thing to do.
Does not require conversion to string and then applying reader macro to it.
What's the problem with following code:
the func expression get expression that contains term that can contain expression...
(defn term[]
(def mytmp (zip/xml-zip {:tag :term}))
(cond
(= (first(:content(first vecTok))) "(")
(do
(def mytmp (popVecTo mytmp))
(def mytmp (zip/append-child mytmp (expression)))
(def mytmp (popVecTo mytmp)))
:else
(def mytmp (popVecTo mytmp)))
(zip/node mytmp))
(defn expression[]
(def mytmp (zip/xml-zip {:tag :expression}))
(def mytmp (zip/append-child mytmp (term)))
(while (contains? #{"+", "-", "*","/", "&", "|", "<", ">", "="} (first(:content(first vecTok))) )
(do
(def mytmp (popVecTo mytmp))
(def mytmp (zip/append-child mytmp (term)))))
(zip/node mytmp))
(def vecTok (vec (:content(first(xml-seq (parse "C:/Users/User/Desktop/forHekronot/BallT.xml"))))))
In the file :
<a><symbol>(</symbol><identifier>dy</identifier><symbol>-</symbol><identifier>dx</identifier><symbol>)</symbol></a>
Notwithstanding #jszakmeister's comment on how to better solve the problem, let me try to give and answer to the question:
you can first (def expression) and then (defn term [] ...) and finally (defn expression [] ...).
The classic example for indirect recursion is of course the poor man's odd/even function for positive numbers:
clojurec.core=> (def even)
#'clojurec.core/even
clojurec.core=> (defn odd [x] (and (not (= x 0)) (even (dec x))))
#'clojurec.core/odd
clojurec.core=> (defn even [x] (or (= x 0) (odd (dec x))))
#'clojurec.core/even
clojurec.core=> (even 10)
true
clojurec.core=> (odd 10)
false
clojurec.core=> (odd 10000)
StackOverflowError clojure.lang.Numbers.equal (Numbers.java:214)
Ooops, depending on the size (or rather depth) of your file this could be a problem. But not all is lost, we can redefine even to use trampoline internally:
(defn even [n]
(letfn [(evenrec [x] (or (= x 0) #(oddrec (dec x))))
(oddrec [x] (and (not (= x 0)) #(evenrec (dec x))))]
(trampoline evenrec n)))