I have a rule similar to the following:
(deftemplate person
(slot name ( type INTEGER))
(slot surname ( type INTEGER))
)
(defrule surname_cant_be_a_name
?p1<-(person (name ?n1))
?p2<-(person (surname ?n2&:(= ?n1 ?n2)))
=>
(retract ?p2)
)
Functionally, this works. But I run this on a huge fact-set, and the complexity gets through the roof fairly quickly.
Because the rule is looking for two person objects, there's a nested for-loop kinda situation slowing the execution down. This setup goes through every possible person pairing and only after having a pair the rule filters out based on my setup "&:(= ?n1 ?n2))"
I feel like there must be a smarter way to do this. Ideally, I want p1 to iterate through all person objects, but only match with p2 objects that conform to my rule.
To make my point clearer, I'm looking for something like the following which will avoid double looping:
(defrule surname_cant_be_a_name
?p1<-(person (name ?n1))
?p2<-(person (surname %%JUST_MATCH_n1%% ))
=>
(retract ?p2)
)
Is this possible to achieve something like that? Any recommendation to optimize this rule is appreciated.
Thanks
P.S. Sorry for the ridiculous example, but it highlights my situation very well.
If you're comparing variables for equality, it's much more efficient to use the same variable in both places than to use two separate variables and call the = or eq function to compare for equality. Across patterns, hash tables are used to quickly locate facts sharing the same variables, something which isn't done when you're using a function call to perform an equality comparison. For a large number of facts, this can improve performance by orders of magnitude:
CLIPS (6.31 6/12/19)
CLIPS> (clear)
CLIPS>
(deftemplate person
(slot name (type INTEGER))
(slot surname (type INTEGER)))
CLIPS>
(defrule surname_cant_be_a_name
?p1<- (person (name ?n1))
?p2<- (person (surname ?n2&:(= ?n1 ?n2)))
=>
(retract ?p2))
CLIPS> (timer (loop-for-count (?i 10000) (assert (person (name ?i) (surname (+ ?i 1))))))
12.3485549999987
CLIPS> (clear)
CLIPS>
(deftemplate person
(slot name (type INTEGER))
(slot surname (type INTEGER)))
CLIPS>
(defrule surname_cant_be_a_name
?p1 <- (person (name ?n1))
?p2 <- (person (surname ?n1))
=>
(retract ?p2))
CLIPS> (timer (loop-for-count (?i 10000) (assert (person (name ?i) (surname (+ ?i 1))))))
0.0177029999995284
CLIPS> (/ 12.3485549999987 0.0177029999995284)
697.540247434201
CLIPS>
Related
Suppose I have a function that returns two values inside a loop macro. Is there an elegant way to collect the first values into one list and second values into another list?
As a silly example, consider the following function:
(defun name-and-phone (id)
(case id
(0 (values "Peter" 1234))
(1 (values "Alice" 5678))
(2 (values "Bobby" 8910))))
Now I would like to collect the names into one list and phone numbers into another one. I could do something like
(loop for i upto 2
collect (nth-value 0 (name-and-phone i))
into names
collect (nth-value 1 (name-and-phone i))
into phones
finally (return (values names phones)))
but that means I have to call name-and-phone twice for each i, which seems inefficient.
I could also use a temporary dotted list
(loop for i upto 2
collect (multiple-value-bind (name phone)
(name-and-phone i)
(cons name phone))
into names-and-phones
finally (return (values (mapcar #'car names-and-phones)
(mapcar #'cdr names-and-phones))))
but that does not feel very elegant.
Is there a way I could use loop's collect inside the scope of multiple-value-bind?
Googling around I could not find much; the closest is this question, where OP is collecting a variable of loop (and not from a nested scope).
(loop with name and number
for i from 0 upto 2
do (setf (values name number)
(name-and-phone i))
collect name into names
collect number into numbers
finally (return (values names numbers)))
Alternative: there is the slightly more powerful ITERATE macro as a library.
Use Destructuring:
(loop for n from 0 to 10
for (f r) = (multiple-value-list (floor n 3))
collect f into fs
collect r into rs
finally (return (values fs rs)))
==> (0 0 0 1 1 1 2 2 2 3 3)
(0 1 2 0 1 2 0 1 2 0 1)
A sufficiently smart compiler should be able to avoid consing up a list in multiple-value-list.
See also values function in Common Lisp.
One of the problems with loop is that, while its very good at the things it does, if you want to do things it doesn't do you're immediately going to have a mass of not-very-easy-to-understand code. I think that's what you're seeing here, and the other answers are as good as any I think: it's just a bit painful.
I think the fashionable answer to making it less painful is either to use an extensible loop, of which there is at least one, or some alternative comprehensive iteration macro.
Having been down those rabbit holes further than anyone should be allowed to go, I've recently decided that the answer is not ever-more-fancy iteration macros, but decomposing the problem into, among other things, much less fancy macros which iterate and much less fancy macros which collect objects which then can be naturally composed together.
So in your case you could have:
(with-collectors (name phone)
(dotimes (i 2)
(multiple-value-bind (n p) (name-and-phone i)
(name n) (phone p))))
or, because supporting multiple values naturally is quite useful, you could write this:
(defmacro collecting-values ((&rest collectors) &body forms)
(let ((varnames (mapcar (lambda (c)
(make-symbol (symbol-name c)))
collectors)))
`(multiple-value-bind ,varnames (progn ,#forms)
,#(mapcar #'list collectors varnames))))
giving you
(with-collectors (name phone)
(dotimes (i 2)
(collecting-values (name phone)
(name-and-phone i))))
and then
> (with-collectors (name phone)
(dotimes (i 2)
(collecting-values (name phone)
(name-and-phone i))))
("Peter" "Alice")
(1234 5678)
(collecting / with-collectors was written by a friend of mine, and can be found here.)
I am trying to do the following:
1. I have multiple agents who are maps that contain expressions.
(see first three lines of code)
What I want is, on a given date inside a let scope, the above expression form the map should bind to the local date.
(rest of the lines)
What am i doing wrong, how should I approach this problem? Thanks.
--- all code below
(def dates [20171002 20171003])
(def date 20171002)
(def data (zipmap dates (repeatedly (count dates) #(ref {:entry true :exit true} )) ))
(dosync (alter (data 20171003) assoc-in [:entry] false))
(println data)
(def agent-1 {:entry-condition '((data date) :entry)})
;(eval (:entry-condition agent-1))
;(data date)
(def date-given 20171003)
(let [date date-given
enter? (eval (:entry-condition agent-1))]
(if enter? (println "hi") (println "correct")))
;; i need correct, not hi.
First things first, +1 to #amalloy comment that this eval is not you friend here (some say evil).
The root cause of the problem here is that eval looks in the current namespace and not the current lexical scope. That is further explained in this answer.
So, to rebind date, you need to use binding rather than let (at least for the date symbol). It then also needs to be dynamic. In your def of date, you can make it dynamic with:
(def ^:dynamic date 20171002)
;; or better yet:
(declare ^:dynamic date)
then when you use it,
(binding [date date-given]
(let [enter? (eval (:entry-condition agent-1))]
(if enter?
(println "NO")
(println "correct") )) )
I have a function that begins like this:
(defn data-one [suser]
(def suser-first-name
(select db/firstNames
(fields :firstname)
(where {:username suser})))
(def suser-middle-name
(select db/middleNames
(fields :middlename)
(where {:username suser})))
(def suser-last-name
(select db/middleNames
(fields :lastname)
(where {:username suser})))
;; And it just continues on and on...
)
Of course, I don't like this at all. I have this pattern repeating in many areas in my code-base and I'd like to generalize this.
So, I came up with the following to start:
(def data-input {:one '[suser-first-name db/firstNames :firstname]
'[suser-middle-name db/middleNames :middlename]
'[suser-last-name db/lastNames :lastname]})
(defpartial data-build [data-item suser]
;; data-item takes the arg :one in this case
`(def (data-input data-item)
(select (data-input data-item)
(fields (data-input data-item))
(where {:username suser}))))
There's really a few questions here:
-- How can I deconstruct the data-input so that it creates x functions when x is unknown, ie. that the values of :one is unknown, and that the quantities of keys in data-input is unknown.
-- I'm thinking that this is a time to create a macro, but I've never built one before, so I am hesitant on the idea.
And to give a little context, the functions must return values to be deconstructed, but I think once I get this piece solved, generalizing all of this will be doable:
(defpage "/page-one" []
(let [suser (sesh/get :username)]
(data-one suser)
[:p "Firat Name: "
[:i (let [[{fname :firstname}] suser-first-name]
(format "%s" fname))]
[:p "Middle Name: "
[:i (let [[{mname :emptype}] suser-middle-name]
(format "%s" mname))]
[:p "Last Name: "
[:i (let [[{lname :months}] suser-last-name]
(format "%s" lname))]]))
Some suggestions:
def inside a function is really nasty - you are altering the global environment, and it can cause all kinds of issues with concurrency. I would suggest storing the results in a map instead.
You don't need a macro here - all of the data fetches can be done relatively easily within a function
I would therefore suggest something like:
(def data-input [[:suser-first-name db/firstNames :firstname]
[:suser-middle-name db/middleNames :middlename]
[:suser-last-name db/lastNames :lastname]])
(def data-build [data-input suser]
(loop [output {}
items (seq data-input)]
(if items
(recur
(let [[kw db fieldname] (first items)]
(assoc output kw (select db (fields fieldname) (where {:username suser}))))
(next items))
output)))
Not tested as I don't have your database setup - but hopefully that gives you an idea of how to do this without either macros or mutable globals!
Nice question. First of all here's the macro that you asked for:
(defmacro defquery [fname table fields ]
(let [arg-name (symbol 'user-name)
fname (symbol fname)]
`(defn ~fname [~arg-name]
(print ~arg-name (str ~# fields)))))
You can call it like that:
(defquery suser-first-name db/firstNames [:firstname])
or if you prefer to keep all your configurations in a map, then it will accept string as the first argument instead of a symbol:
(defquery "suser-first-name" db/firstNames [:firstname])
Now, if you don't mind me recommending another solution, I would probably chose to use a single function closed around configuration. Something like that:
(defn make-reader [query-configurations]
(fn [query-type user-name]
(let [{table :table field-names :fields}
(get query-configurations query-type)]
(select table
(apply fields field-names)
(where {:username suser})))))
(def data-input {:firstname {:table db/firstNames :fields :firstname}
:middlename {:table db/middleNames :fields :middlename}
:lastname {:table db/lastNames :fields :lastname}})
(def query-function (make-reader data-input))
;; Example of executing a query
(query-function :firstname "tom")
By the way there's another way to use Korma:
;; This creates a template select from the table
(def table-select (select* db/firstNames))
;; This creates new select query for a specific field
(def first-name-select (fields table-select :firstname))
;; Creating yet another query that filters results by :username
(defn mkselect-for-user [suser query]
(where query {:username suser}))
;; Running the query for username "tom"
;; I fully specified exec function name only to show where it comes from.
(korma.core/exec (mkselect-for-user "tom" first-name-select))
For more information I highly recommend looking at Korma sources.
I've just started playing with core.logic, and to work on it I'm trying to implement something simple that is similar to a problem that I am currently working on professionally. However, one part of the problem has me stumped...
As a simplification of my example, if I have a catalog of items, and some of them are only available in certain countries, and some are not available in specific countries. I'd like to be able specify the list of items, and the exceptions, something like:
(defrel items Name Color)
(defrel restricted-to Country Name)
(defrel not-allowed-in Country Name)
(facts items [['Purse 'Blue]
['Car 'Red]
['Banana 'Yellow]])
(facts restricted-to [['US 'Car]])
(facts not-allowed-in [['UK 'Banana]
['France 'Purse]])
If possible, I'd rather not specify allowed-in for all countries, as the set of items with restrictions is relatively small, and I'd like to be able to make a single change to allow/exclude for an item for a given country.
How can I write a rule that gives the list of items/colors for a country, with the following constraints:
The item must be in the list of items
The country/item must be not be in the 'not-allowed-in' list
Either:
There is no country in the restricted-to list for that item
The country/item pair is in the restricted-to list
Is there some way to do this? Am I thinking about things in entirely the wrong way?
Usually when you start negating goals in logic programming, you need to reach for non-relational operations (cut in Prolog, conda in core.logic).
This solution should only be called with ground arguments.
(defn get-items-colors-for-country [country]
(run* [q]
(fresh [item-name item-color not-country]
(== q [item-name item-color])
(items item-name item-color)
(!= country not-country)
(conda
[(restricted-to country item-name)
(conda
[(not-allowed-in country item-name)
fail]
[succeed])]
[(restricted-to not-country item-name)
fail]
;; No entry in restricted-to for item-name
[(not-allowed-in country item-name)
fail]
[succeed]))))
(get-items-colors-for-country 'US)
;=> ([Purse Blue] [Banana Yellow] [Car Red])
(get-items-colors-for-country 'UK)
;=> ([Purse Blue])
(get-items-colors-for-country 'France)
;=> ([Banana Yellow])
(get-items-colors-for-country 'Australia)
;=> ([Purse Blue] [Banana Yellow])
Full solution
Conda may complexifies the code, using nafc, you can more easily reorder goals if you want.
This is still non-relational ! :)
(ns somenamespace
(:refer-clojure :exclude [==])
(:use [clojure.core.logic][clojure.core.logic.pldb]))
(db-rel items Name Color)
(db-rel restricted-to Country Name)
(db-rel not-allowed-in Country Name)
(def stackoverflow-db
(db [items 'Purse 'Blue]
[items 'Car 'Red]
[items 'Banana 'Yellow]
[restricted-to 'US 'Car]
[not-allowed-in 'UK 'Banana]
[not-allowed-in 'France 'Purse]))
(defn get-items-colors-for-country [country]
(with-db stackoverflow-db
(run* [it co]
(items it co)
(nafc not-allowed-in country it)
(conde
[(restricted-to country it)]
[(nafc #(fresh [not-c] (restricted-to not-c %)) it)]))))
(get-items-colors-for-country 'US)
;=> ([Purse Blue] [Banana Yellow] [Car Red])
(get-items-colors-for-country 'UK)
;=> ([Purse Blue])
(get-items-colors-for-country 'France)
;=> ([Banana Yellow])
(get-items-colors-for-country 'Australia)
;=> ([Purse Blue] [Banana Yellow])
For more examples : https://gist.github.com/ahoy-jon/cd0f025276234de464d5
Ok Here is what i am trying to do
(defn addresses [person-id]
;addresses-retrival )
(defn person [id]
(merge {:addresses (addresses id)} {:name "john"}))
In the above person function i want addresses to be retrieved only on demand , like only when i do
(:addresses (person 10))
and not when
(person 10)
I am not sure if i am going about this right, being new to clojure.
You can use delay.
(defn person [id]
(delay {:addresses (addresses id) :name "john"}))
(person 2) will then return a delayed, without evaluating anything.
To access the content and evaluate the delayed object, use force or deref (or #).
(:addresses #(person 5))
Alternatively, you can put the delay on the address only.
(defn person [id]
{:addresses (delay (addresses id)) :name "john"})
which can be nicer depending on your problem.
It allows to define:
(defn get-address [person]
#(:address person))
Which will get the delayed address and force it.
(Forcing means computing the first time and retrieving the forced result any other times).
At least as far as sequences go, clojure is pretty damned lazy without needed to be told.
Here, modelling your address-retrieval as counting, try:
(defn addresses [person-id]
(iterate #(do (println %) (inc %)) person-id))
(defn person [id]
(merge {:addresses (addresses id)} {:name "john"}))
(def people (map person (range 100)))
So far it won't have printed anything, but if you say:
(doall (take 5 (:addresses (nth people 10))))
Then you should see the printing happen in exactly the cases that need to happen to count up five in the tenth place. I'd imagine that might be the sort of behaviour you want?
So get your address lookup to produce a lazy sequence (map, filter, reduce will all do)
You can return a function from the addresses function which when later called will retrieve the addresses. Something like this:
(defn addresses [person-id]
#(;addresses-retrival))
(defn person [id]
(merge {:addresses ((addresses id))} {:name "john"}))
Note than the addresses function returns an anonymous function (created using #) and the person function calls that anonymous function using an extra pair of parens.
I can suggest something close to what you expect.
; Note the use of anonymouns function. #(addresses id)
(defn person [id]
(merge {:addresses #(addresses id)} {:name "john"}))
; :addresses returns a function. Evaluate it by wrapping it in another set of parans.
((:addresses (person 10)))
Remember that Delays are memoized, so successive calls of your addresses delay will always yield the same address as the first time you derefed the Delay.
(defn addresses [person-id]
{:home (str (rand-int 100) " Cool St.") :work "1243 Boring St."})
(defn person [id]
(merge {:addresses (delay (addresses id))} {:name "john"}))
(let [person1 (person 1)]
(println #(:addresses person1))
(println #(:addresses person1)))
This will print:
{:home 65 Cool St., :work 1243 Boring St.}
{:home 65 Cool St., :work 1243 Boring St.}
Notice how the home address is unchanged on the second deref of the delay.
If you don't want this behavior you need to use a function closure instead.
(defn addresses [person-id]
{:home (str (rand-int 100) " Cool St.") :work "1243 Boring St."})
(defn person [id]
(merge {:addresses (fn [] (addresses id))} {:name "john"}))
(let [person1 (person 1)]
(println ((:addresses person1)))
(println ((:addresses person1))))
This will print:
{:home 16 Cool St., :work 1243 Boring St.}
{:home 31 Cool St., :work 1243 Boring St.}
Notice how the home address was different on the sub-sequent call to the closure.
So, if you're addresses function does side-effect, say fetches addresses from a database. And the persons can change their addresses, and you'd want your code to always have the most recent address, it's something to keep in mind if Delay works for you, or if a function closure would be a better candidate.