The goal of this function is to generate the cartesian product of 2 list.
For example
(combo (list 1 2 3) (list 4 5)) => (1 4) (1 5) (2 4) (2 5) (3 4) (3 5)
(defun combo (l1 l2)
(let (
(res (list))
)
(dolist (elem1 l1 res)
(dolist (elem2 l2 res)
(setq res (append res (list(list elem1 elem2))))
)
)
)
)
How could be implemented recursively?
A simple recursive implementation would be to use two helper functions; one to traverse through L1 (%COMBO in the code below), calling another function to pair an element with each element from L2 (%PRODUCT):
(defun combo (l1 l2)
(labels ((%product (el list &optional (acc (list)))
(if (endp list)
acc
(%product el (rest list) (cons (list el (first list)) acc))))
(%combo (l1 l2 &optional (acc (list)))
(if (endp l1)
(nreverse acc)
(%combo (rest l1) l2 (nconc (%product (first l1) l2) acc)))))
(%combo l1 l2)))
The iterative approach is both simpler and more efficient though. Instead of using APPEND in a loop, you should just reverse the list at the end.
(defun combo (l1 l2)
(let ((res (list)))
(dolist (e1 l1 (nreverse res))
(dolist (e2 l2)
(push (list e1 e2) res)))))
You could also just use the MAP-PRODUCT function from Alexandria:
CL-USER> (ql:quickload :alexandria)
;=> (:ALEXANDRIA)
CL-USER> (use-package :alexandria)
;=> T
CL-USER> (map-product #'list (list 1 2 3) (list 4 5))
;=> ((1 4) (1 5) (2 4) (2 5) (3 4) (3 5))
It seems ideal for Prolog, though data has to be put differently:
items1(1).
items1(2).
items1(3).
items2(4).
items2(5).
?- findall((A,B), (items1(A), items2(B)), L).
L = [ (1, 4), (1, 5), (2, 4), (2, 5), (3, 4), (3, 5)].
Related
How can I use typed Racket for some functions in my codebase, but use (untyped) Racket for others? When I define a function in Racket but import it into a typed Racket context, it seems to be changing the behavior of the function (functions described below).
As it is now, the files do typecheck, but don't pass my tests in p11typedtest.rkt -- however, my files do successfully pass my tests if I either (A) switch p11typed.rkt to regular Racket or (B) copy the pack function into p11typed.rkt and provide its type annotation.
;; p09.rkt
#lang racket
(provide pack)
;; packs consecutive duplicates within a list into sublists
(define (pack lst)
(for/foldr ([acc '()]) ([x lst])
(match acc
[(cons (cons y ys) zs) #:when (equal? x y)
(list* (list* x y ys) zs)]
[_ (list* (list x) acc)]
)))
;; p11typed.rkt
#lang typed/racket
(provide encode-runlen-mod)
;; (require (only-in (file "p09.rkt") pack))
(require/typed (only-in (file "p09.rkt") pack)
[pack (All (A) (-> (Listof A) (Listof (Listof A))))]
)
(define-type (Runof a) (List Index a))
(define-type (RunListof a) (Listof (U a (Runof a))))
;; encodes a list as a list of runs
(: encode-runlen-mod (All (A) (-> (Listof A) (RunListof A))))
(define (encode-runlen-mod lst)
;; uncomment to print the result of pack
;; (displayln (pack lst))
(for/list ([dups (pack lst)])
(match (length dups)
[1 (car dups)]
[n (list n (car dups))]
)))
; (: pack (All (A) (-> (Listof A) (Listof (Listof A)))))
; (define (pack lst)
; (for/foldr ([acc '()]) ([x lst])
; (match acc
; [(cons (cons y ys) zs) #:when (equal? x y)
; (list* (list* x y ys) zs)]
; [_ (list* (list x) acc)]
; )))
;; p11typedtest.rkt
#lang racket
(require (only-in (file "p11typed.rkt") encode-runlen-mod))
(define (test-output namespace expr v)
(let* ([val (eval expr namespace)]
[fail (not (equal? val v))])
(begin
(display (if fail "FAIL" "ok "))
(display " '(=? ")
(print expr)
(display " ")
(print v)
(display ")'")
(if fail
(begin
(display ", got ")
(print val)
(displayln " instead")
)
(displayln "")
)
(void))
))
(define-namespace-anchor a)
(define ns (namespace-anchor->namespace a))
(test-output ns '(encode-runlen-mod '(1 2 3 4)) '(1 2 3 4))
(test-output ns '(encode-runlen-mod '(1 1 1)) '((3 1)))
(test-output ns '(encode-runlen-mod '(1 2 2 3 4)) '(1 (2 2) 3 4))
(test-output ns '(encode-runlen-mod '(1 2 3 4 4 4)) '(1 2 3 (3 4)))
(test-output ns '(encode-runlen-mod '(1 2 3 (3 4))) '(1 2 3 (3 4)))
(test-output ns '(encode-runlen-mod '(A A A A B C C A A D E E))
'((4 A) B (2 C) (2 A) D (2 E)))
)
I would like to write the Racket function find-subsets. The function produces the list of subsets of a list of numbers w/o helper functions and that only uses lambda, cond, cons, rest, first, and other primitive functions.
For instance, the following check-expects should be satisfied:
(check-expect (find-subsets '(2 2 3 3)) '(() (2) (3) (2 2) (2 3) (3 3) (2 2 3) (2 3 3)
(2 2 3 3)))
(check-expect (find-subsets '(1 2 3)) '(() (1) (2) (3) (1 2) (1 3) (2 3) (1 2 3)))
Basically, this function produces the power set of a set of numbers, but I'm not sure how it can produce all of the elements, without recursion.
#lang racket
(define-syntax-rule (my-let ([var val]) body)
((λ (var) body) val))
(define-syntax-rule (Y e)
((λ (f) ((λ (x) (f (λ (y) ((x x) y))))
(λ (x) (f (λ (y) ((x x) y))))))
e))
(define-syntax-rule (define/rec f e)
(define f (Y (λ (f) e))))
(define/rec my-append
(λ (l1)
(λ (l2)
(cond [(empty? l1) l2]
[else (cons (first l1) ((my-append (rest l1)) l2))]))))
(define/rec my-map
(λ (f)
(λ (l)
(cond [(empty? l) empty]
[else (cons (f (first l)) ((my-map f) (rest l)))]))))
(define/rec my-power-set
(λ (set)
(cond [(empty? set) (cons empty empty)]
[else (my-let ([rst (my-power-set (rest set))])
((my-append ((my-map (λ (x) (cons (first set) x))) rst))
rst))])))
Summary:
I took the standard definition of powerset from here and curried it. Then I replaced let, append, and map with my-let, my-append, and my-map. I defined the Y combinator as the Y macro and a helper define/rec that makes a function recursive. Then I defined my-append and my-map using the define/rec macro (note that they're curried too). We can substitute everything to get the desired code.
Hello i am trying to create a function in common-lisp that takes two lists, and output their intersections, assuming there is no repetition in each list without using intersection function. It seems that it is not working. Can anyone help?
(defun isect (lst_1 lst_2)
(setq newlist nil)
(dolist (x lst_1 newlist)
(dolist (y lst_2)
(if (equal x y) (setf newlist (append newlist x)))
)
)
)
I assume isect with both arguments being the same list should return an equal list and not one that is flattened. In that case (append newlist x) is not adding an element to the end of a list. Here is my suggestion:
(defun intersect (lst-a lst-b &aux result)
(dolist (a lst-a (nreverse result))
(dolist (b lst-b)
(when (equal a b)
(push a result)))))
This is O(n^2) while you can do it in O(n) using a hash table.
A built-in way (that won't work for homeworks ;) ) is to use intersection: https://lispcookbook.github.io/cl-cookbook/data-structures.html#intersection-of-lists
What elements are both in list-a and list-b ?
(defparameter list-a '(0 1 2 3))
(defparameter list-b '(0 2 4))
(intersection list-a list-b)
;; => (2 0)
If you can ensure that the lists are sorted (ascending) you could do something like
(defun isect (l1 l2 acc)
(let ((f1 (car l1))
(f2 (car l2))
(r1 (cdr l1))
(r2 (cdr l2)))
(cond ((or (null l1) (null l2)) acc)
((= f1 f2) (isect r1 r2 (cons f1 acc)))
((< f1 f2) (isect r1 l2 acc))
((> f1 f2) (isect l1 r2 acc)))))
Note though, that the result is in reversed order. Also, the example assumes that the
elements are numbers. If you wanted to generalize, you could pass an ordering as an optional argument to make it work with arbitrary elements.
NB: A solution using loop would likely be faster but I could not think of how to partially "advance" the lists when the cars are different.
;; the key function for simple lists
(defun id (x) x)
;; the intersect function for two lists
;; with sorting included:
;; you need an equality-test:
;; default is #'eql (for simple numbers or symbols this is sufficient)
;; - for numbers only #'=
;; - for characters only #'char=
;; - for strings only #'string=
;; - for lists #'equal
;; - for nearly everything #'equalp (case insensitive for char/strings!)
;; then you need also a sorting tester:
;; - increasing number: #'<
;; - decreasing number: #'>
;; - increasing char: #'char<
;; - decreasing char: #'char>
;; - increasing strings: #'string<
;; - decreasing strings: #'string>
;; - other cases I haven't think of - does somebody have an idea?
;; (one could sort by length of element etc.)
;; so sort-test should be a diadic function (function taking 2 arguments to compare)
;; then you also need an accessor function
;; so, how withing each element the to-be-sorted element should be accessed
;; for this, I prepared the `id` - identity - function because this is the
;; sort-key when simple comparison of the elements of the two lists
;; should be compared - and this function is also used for testing
;; for equality in the inner `.isect` function.
(defun isect (lst-1 lst-2 &key (equality-test #'eql) (sort-test #'<) (sort-key #'id))
(let ((lst-1-sorted (stable-sort lst-1 sort-test :key sort-key))
(lst-2-sorted (stable-sort lst-2 sort-test :key sort-key)))
(labels ((.isect (l1 l2 acc)
(cond ((or (null l1) (null l2)) (nreverse acc))
(t (let ((l1-element (funcall sort-key (car l1)))
(l2-element (funcall sort-key (car l2))))
(cond ((funcall sort-test l1-element l2-element)
(.isect (cdr l1) l2 acc))
((funcall equality-test l1-element l2-element)
(.isect (cdr l1) (cdr l2) (cons (car l1) acc)))
(t (.isect l1 (cdr l2) acc))))))))
(.isect lst-1-sorted lst-2-sorted '()))))
Simple tests:
(isect '(0 1 2 3 4 5 6) '(9 0 3 5 12 24 8 6))
;; => (0 3 5 6)
(isect '(#\a #\c #\h #\t #\e #\r #\b #\a #\h #\n)
'(#\a #\m #\s #\e #\l #\s #\t #\a #\r)
:equality-test #'char=
:sort-test #'char<
:key #'id)
;; => (#\a #\a #\e #\r #\t)
(isect '("this" "is" "just" "a" "boring" "test")
'("this" "boring" "strings" "are" "to" "be" "intersected")
:equality-test #'string=
:sort-test #'string<
:key #'id)
;; => ("boring" "this")
I have a problem with this function two-similar-p.
(defun two-similar-p (list1 list2)
(mapcar
(lambda (e)
(mapcar
(lambda (e1)
(if (equal e e1) t))
list2))
list1))
But is not correct use mapcar because this function returns a new list with T or NIL, but I need only to return a true or false.
ex.
(two-similar-p '(2 1 3) '(1 2 3))
==> ((NIL T NIL) (T NIL NIL) (NIL NIL T))
I was thinking to use recursion to compare the various elements, but I have no idea how to do that.
My function needs to work like:
(two-similar-p '(1 2 3) '(1 4 5)) ; ==> nil
(two-similar-p '(1 2 5) '(1 4 5)) ; ==> t
(two-similar-p '(1 2 6) '(6 4 2)) ; ==> t
Any advice?
The easiest "off-the-shelf" solution is to check that the intersection contains at least two elements:
(defun two-similar-p (l1 l2)
(consp (cdr (intersection l1 l2 :test #'equal))))
A slightly less OTS solution is to use hash tables:
(defun two-similar-p (l1 l2)
(let ((h1 (make-hash-table :test 'equal))
(common 0))
(dolist (x l1)
(setf (gethash x h1) t))
(dolist (x l2)
(when (gethash x h1)
(incf common))
(when (>= common 2)
(return t)))))
The advantage of the second approach is that its complexity is O(len(l1) + len(l2)),
while the mapcar approach will be O(len(l1) * len(l2)).
The standard does not specify the complexity of intersection and friends, but most implementations take good care of their users here (IOW, the complexity will be linear, not quadratic).
I have a macro called compare-and-swap!:
(define-macro (compare-and-swap! l x y)
`(if (> (vector-ref ,l ,x) (vector-ref ,l ,y))
(vector-swap! ,l ,x ,y)))
It works, I'm testing it like this:
(define v (list->vector '(5 4 3 2 1)))
(print v)
(compare-and-swap! v 1 2)
(print v)
I have a function that returns a list of pairs that I can call compare-and-swap! on serially to sort the whole list:
(batcher 8) → ((0 1) (2 3) (0 2) (1 3) (1 2) (4 5) (6 7) (4 6) (5 7) (5 6) (0 4) (2 6) (2 4) (1 5) (3 7) (3 5) (1 2) (3 4) (5 6))
Now I wish to create a macro that generates a lambda that sorts an N element list by calling batcher and doing the compare-and-swap! for each pair.
For example,
(generate-sorter 8)
→
(lambda (l) (begin (compare-and-swap! l 0 1) (compare-and-swap! l 2 3) ...))
→
(lambda (l) (begin (if (> (vector-ref l 0) (vector-ref l 1)) (vector-swap! 0 1)) (if (> (vector-ref l 2) (vector-ref l 3)) (vector-swap! 2 3))) ... )
I made a function that generates the necessary code:
(define generate-sorter (lambda (len)
(list 'lambda '( li ) 'begin (map (lambda (pair) (list 'compare-and-swap! 'li (first pair) (second pair))) (batcher len)))
))
But I don't now how to make it into a macro.
You don't need a macro for this and, in particular, for the 'generate' part. I suspect that you were thinking macro because the result of generate-sorter can vary from call to call and you hoped to encode the result through macro expansion. An alternative is to capture the result in the lexical environment as such:
(define-syntax compare-and-swap!
(syntax-rules ()
((_ l x y)
(when (> (vector-ref l x) (vector-ref l y))
(vector-swap! l x y)))))
(define (generate-sorter n)
(let ((sorters (generate-sorter n)))
(lambda (l)
(for-each (lambda (sorter)
(compare-and-swap! l (car sorter) (card sorter)))
sorters))))
(define sorter-8 (generate-sorter 8))
(sorter-8 <l-thingy>)
-> <sorted-l-thingy>