I'd like to create an array of array.
For example: ((a b c) (d e f))
(bind ?part1 (create$ a b c))
(bind ?part2 (create$ d e f))
(bind ?structure (create$))
(bind ?structure (insert$ ?structure 1 (create$ ?part1)))
(bind ?structure (insert$ ?structure 2 (create$ ?part2)))
This code gives me:
(bind ?part1 (create$ a b c))
(a b c)
CLIPS> (bind ?part2 (create$ d e f))
(d e f)
CLIPS> (bind ?structure (create$))
()
CLIPS> (bind ?structure (insert$ ?structure 1 (create$ ?part1)))
(a b c)
CLIPS> (bind ?structure (insert$ ?structure 2 (create$ ?part2)))
(a d e f b c)
CLIPS>
Any hints, please?
Thank you
Nico
Multifields can't be nested. I'd suggest using instances if you need to nest values:
CLIPS> (defclass VALUES (is-a USER) (multislot values))
CLIPS> (make-instance v1 of VALUES (values a b c))
[v1]
CLIPS> (make-instance v2 of VALUES (values d e f))
[v2]
CLIPS> (make-instance v3 of VALUES (values [v1] [v2]))
[v3]
CLIPS>
Related
I am trying to write a function in Scheme that returns all rotations of a given list. For example, (rotate '(a b c d e)) should return ((a b c d e) (b c d e a) (c d e a b) (d e a b c) (e a b c d)) (in some order).
I am not sure this would work:
(define (make-rotate alphabet) (lambda (x) (+ x alphabet)))
(define (same-arg-twice fn) (lambda (arg) (fn arg arg)))
(define (flip fn) (lambda (a b c d e) (fn b c d e a) (fn c d a e b) (fn d e a b c) (fn e a b c d)
(define (flip fn)
(lambda (3 9 5 8 2 4 7) (fn 9 4 3 2 4 7 8) (fn 3 2 4)
Start with a function that rotates a list once.
That is, it takes the list's first element and puts it at the back instead.
(define (rotate-once ls)
(append (cdr ls) (list (car ls))))
Test:
> (rotate-once '(a b c))
'(b c a)
Looks good.
Now we can use this on an already rotated list to produce the next rotation.
> (rotate-once (rotate-once '(a b c)))
'(c a b)
We could almost write this recursive procedure
(define (rotate ls)
(if (...)
'()
(cons ls (rotate (rotate-once ls)))))
but there is no useful condition for terminating the recursion.
We could depend on the length of the list, but I did this instead: make a helper function and pass it the list of elements that haven't been moved around yet.
When that list is empty, we're done.
(define (rotate-helper ls remaining)
(if (null? remaining)
'()
(cons ls (rotate-helper (rotate-once ls) (cdr remaining)))))
and now we can define
(define (rotate ls) (rotate-helper ls ls))
and
> (rotate '(a b c d e))
'((a b c d e) (b c d e a) (c d e a b) (d e a b c) (e a b c d))
(define (rotate lst)
(for/list ((_ lst))
(let ((tmp lst))
(set! lst (append (cdr lst) (list (car lst))))
tmp)))
> (rotate '(a b c d e))
'((a b c d e) (b c d e a) (c d e a b) (d e a b c) (e a b c d))
or:
(define (one-rotate lst)
(append (cdr lst) (list (car lst))))
(define (rotate lst)
(for/list ((_ lst))
(let ((tmp lst))
(set! lst (one-rotate lst))
tmp)))
(defun split-list (L)
(if (endp L)
'(nil nil)
(let ((x (split-list (cdr L))))
(list (cons (car L) (cadr x))(car X))
)))
This is the code which I have. It works fine:
(split-list '(1 2 3 4 5 6))
((1 3 5) (2 4 6))
But I need an explanation on the recursion part.
When we call the function (split-list (cdr L)) I am sure that it goes from 123456 to 23456. (car L) is 1
and (cadr X) is 3 but how did 5 came there ?
when function did
(split-list (cdr L)) didn't the x became 3456 and (cadr x) should be 4 ? which is wrong and same with other half. (car x) should be 3 now which is wrong.
Could anyone please explain ?
I would rewrite a recursive split-list as this:
(defun split-list (list)
(if (endp list)
(values nil nil)
(multiple-value-bind (split1 split2)
(split-list (rest list))
(values (cons (first list) split2)
split1))))
Above uses multiple values. The function returns the split result as two values. We also replace car with first and cdr with rest. The are just better names, but have the same functionality. multiple-value-bind binds the the two values of the recursive split-list call to the variables split1 and split2. The function values returns its two arguments as two values.
In the example below, you can see that the function indeed returns two values:
CL-USER 20 > (split-list '(a b c d e f))
(A C E)
(B D F)
You can trace its execution:
CL-USER 21 > (trace split-list)
(SPLIT-LIST)
CL-USER 22 > (split-list '(a b c d e f))
0 SPLIT-LIST > ((A B C D E F))
1 SPLIT-LIST > ((B C D E F))
2 SPLIT-LIST > ((C D E F))
3 SPLIT-LIST > ((D E F))
4 SPLIT-LIST > ((E F))
5 SPLIT-LIST > ((F))
6 SPLIT-LIST > (NIL)
6 SPLIT-LIST < (NIL NIL)
5 SPLIT-LIST < ((F) NIL)
4 SPLIT-LIST < ((E) (F))
3 SPLIT-LIST < ((D F) (E))
2 SPLIT-LIST < ((C E) (D F))
1 SPLIT-LIST < ((B D F) (C E))
0 SPLIT-LIST < ((A C E) (B D F))
(A C E)
(B D F)
I came across Pascal Bourguignon's solutions of the 99 Lisp problems and was wondering if his recursive solution of problem 27 using a nested mapcan-mapcar-construct could also be written using nested loops.
His solution is definitely very elegant:
(defun group (set sizes)
(cond
((endp sizes)
(error "Not enough sizes given."))
((endp (rest sizes))
(if (= (first sizes) (length set))
(list (list set))
(error "Cardinal mismatch |set| = ~A ; required ~A"
(length set) (first sizes))))
(t
(mapcan (lambda (combi)
(mapcar (lambda (group) (cons combi group))
(group (set-difference set combi) (rest sizes))))
(combinations (first sizes) set)))))
The function combinations is defined here as:
(defun combinations (count list)
(cond
((zerop count) '(())) ; one combination of zero element.
((endp list) '()) ; no combination from no element.
(t (nconc (mapcar (let ((item (first list)))
(lambda (combi) (cons item combi)))
(combinations (1- count) (rest list)))
(combinations count (rest list))))))
I started with a simple approach:
(defun group-iter (set sizes)
(loop :with size = (first sizes)
:for subgroup :in (combination size set)
:for remaining = (set-difference set subgroup)
:collect (list subgroup remaining) :into result
:finally (return result)))
which results in:
> (group-iter '(a b c d e f) '(2 2 2))
(((A B) (F E D C)) ((A C) (F E D B)) ((A D) (F E C B)) ((A E) (F D C B))
((A F) (E D C B)) ((B C) (F E D A)) ((B D) (F E C A)) ((B E) (F D C A))
((B F) (E D C A)) ((C D) (F E B A)) ((C E) (F D B A)) ((C F) (E D B A))
((D E) (F C B A)) ((D F) (E C B A)) ((E F) (D C B A)))
But now I am totally failing to implement the nesting which takes care of the further processing of remaining. As far as I understood there is always a way to express a recursion with a iteration but how does it look like here?
I have a file which name is dictionary.lisp. That includes some words like
(defparameter *dictionary* '(
(a b a)
(a b a d i)
.
.
)
I try to find them as a list. I tried the followings
[5]> (find '((a b a d i)) *dictionary* :test 'equal )
NIL
[6]> (find '((a b a d i)) *dictionary* :test #'equalp )
NIL
[7]> (member '((a b a d i)) *dictionary* :test 'equal )
NIL
[8]> (member '((a b a d i)) *dictionary* :test #'equalp )
NIL
[9]> (find '((a b a d i)) *dictionary* :test #'subsetp )
NIL
Is there any lisp function that can return non-nil?
You need to use equal or equalp as your test, which you're doing in four of your examples. You also need to search for something that's actually in the list. For instance, The dictionary you've described contains the list of five symbols (a b a d i) as an element, but not the list ((a b a d i)) (which is a list containing a single element, and that element is a list of five symbols). This means you'd do (find '(a b a d i) … :test 'equal):
CL-USER> (defparameter *dictionary* '((a b a)
(a b a d i)))
*DICTIONARY*
CL-USER> (find '((a b a d i)) *dictionary* :test 'equal)
NIL
CL-USER> (find '(a b a d i) *dictionary* :test 'equal)
(A B A D I)
CL-USER> (find '(f o o) *dictionary* :test 'equal)
NIL
CL-USER 25 > (defparameter *dictionary* '((a b a) (a b a d i)))
*DICTIONARY*
CL-USER 26 > (defun my-find (list0 list1)
(and (find (first list0) list1 :test #'equal)
t))
MY-FIND
CL-USER 27 > (my-find '((a b a d i)) *dictionary*)
T
It just does not look like it will make much sense.
I would like to print all the datas of the facts with a rule. Here are the facts :
(deffacts datas
(pile name 1 blocks A B C A B)
(pile name 2 blocks B A)
(pile name 3 blocks A B)
(pile name 4 blocks A))
And here are the printing I want to see :
pile 1 : A B C A B
pile 2 : B A
pile 3 : A B
pile 4 : A
Does somebody has an idea how to do it ?
Thank you for your help !
If the order in which the piles are printed doesn't matter, you can do it this way:
CLIPS> (clear)
CLIPS>
(deffacts datas
(pile name 1 blocks A B C A B)
(pile name 2 blocks B A)
(pile name 3 blocks A B)
(pile name 4 blocks A))
CLIPS>
(defrule print
(pile name ?name blocks $?blocks)
=>
(printout t pile " " ?name " : " (implode$ ?blocks) crlf))
CLIPS> (reset)
CLIPS> (run)
pile 4 : A
pile 3 : A B
pile 2 : B A
pile 1 : A B C A B
CLIPS> (clear)
CLIPS>
(deftemplate pile
(slot name)
(multislot blocks))
CLIPS>
(deffacts datas
(pile (name 1) (blocks A B C A B))
(pile (name 2) (blocks B A))
(pile (name 3) (blocks A B))
(pile (name 4) (blocks A)))
CLIPS>
(defrule print
(pile (name ?name) (blocks $?blocks))
=>
(printout t pile " " ?name " : " (implode$ ?blocks) crlf))
CLIPS> (reset)
CLIPS> (run)
pile 4 : A
pile 3 : A B
pile 2 : B A
pile 1 : A B C A B
CLIPS>
If the order is important, you can do it using facts in the following manners, but this is either destructive in the first case or requires cleanup in the second case:
CLIPS> (clear)
CLIPS>
(deftemplate pile
(slot name)
(multislot blocks))
CLIPS>
(deffacts datas
(pile (name 1) (blocks A B C A B))
(pile (name 2) (blocks B A))
(pile (name 3) (blocks A B))
(pile (name 4) (blocks A)))
CLIPS>
(defrule print
?pile <- (pile (name ?name) (blocks $?blocks))
(not (pile (name ?name2&:(< ?name2 ?name))))
=>
(retract ?pile)
(printout t pile " " ?name " : " (implode$ ?blocks) crlf))
CLIPS> (reset)
CLIPS> (run)
pile 1 : A B C A B
pile 2 : B A
pile 3 : A B
pile 4 : A
CLIPS> (facts)
f-0 (initial-fact)
For a total of 1 fact.
CLIPS> (clear)
CLIPS>
(deftemplate pile
(slot name)
(multislot blocks))
CLIPS>
(deffacts datas
(pile (name 1) (blocks A B C A B))
(pile (name 2) (blocks B A))
(pile (name 3) (blocks A B))
(pile (name 4) (blocks A)))
CLIPS>
(defrule print
(pile (name ?name) (blocks $?blocks))
(not (and (pile (name ?name2&:(< ?name2 ?name)))
(not (pile-printed ?name2))))
=>
(assert (pile-printed ?name))
(printout t pile " " ?name " : " (implode$ ?blocks) crlf))
CLIPS> (reset)
CLIPS> (run)
pile 1 : A B C A B
pile 2 : B A
pile 3 : A B
pile 4 : A
CLIPS> (facts)
f-0 (initial-fact)
f-1 (pile (name 1) (blocks A B C A B))
f-2 (pile (name 2) (blocks B A))
f-3 (pile (name 3) (blocks A B))
f-4 (pile (name 4) (blocks A))
f-5 (pile-printed 1)
f-6 (pile-printed 2)
f-7 (pile-printed 3)
f-8 (pile-printed 4)
For a total of 9 facts.
CLIPS>
Finally, you can use the fact query functions to retrieve all the piles facts and then sort them to get the desired order:
CLIPS> (clear)
CLIPS>
(deffunction pile-sort (?f1 ?f2)
(> (fact-slot-value ?f1 name)
(fact-slot-value ?f2 name)))
CLIPS>
(deftemplate pile
(slot name)
(multislot blocks))
CLIPS>
(deffacts datas
(pile (name 1) (blocks A B C A B))
(pile (name 2) (blocks B A))
(pile (name 3) (blocks A B))
(pile (name 4) (blocks A)))
CLIPS>
(defrule print
=>
(bind ?facts (find-all-facts ((?f pile)) TRUE))
(bind ?facts (sort pile-sort ?facts))
(progn$ (?f ?facts)
(printout t pile " " (fact-slot-value ?f name) " : "
(implode$ (fact-slot-value ?f blocks)) crlf)))
CLIPS> (reset)
CLIPS> (run)
pile 1 : A B C A B
pile 2 : B A
pile 3 : A B
pile 4 : A
CLIPS>