zip up two list of different lengths in elisp - elisp

I have two lists:
(setq x (list "a" "b" "c"))
(setq y (list "1" "2" "3" "4"))
How can I create a list of cons cells (("a" . "1") ("b" . "2") ("c" . "3") ("a" . "4")) with the shorter list recycled?

Here's my take:
(require 'cl-lib)
(cl-mapcar #'list (setcdr (last x) x) y)
I'd add a check for which of them is larger, but that would spoil the brevity:).

There is surely a simpler way to do it, but here's a version that turns the input sequences into infinite lists and zips them together:
(defun* cycle-iterator (xs &optional (idx 0) (len (length xs)))
"Create an iterator that will cycle over the elements in XS.
Return a cons, where the car is the current value and the cdr is
a function to continue the iteration."
(cons (nth (mod idx len) xs)
(eval `(lambda () (cycle-iterator ',xs ,(1+ idx) ,len)))))
(defun cycle-take (xs n)
"Take N elements from XS, cycling the elements if N exceeds the length of XS."
(loop
when (plusp n)
;; Creating the iterator returns the first value. Subsequent calls can then
;; be processed in a loop.
with (value . iterator) = (cycle-iterator xs)
with acc = (list value)
repeat (1- n) do (destructuring-bind (val . next) (funcall iterator)
(setq iterator next)
(setq acc (cons val acc)))
finally (return (nreverse acc))))
(defun cycling-zip (xs ys)
"Zip XS and YS together, cycling elements to ensure the result
is as long as the longest input list."
(loop
with limit = (max (length xs) (length ys))
for x in (cycle-take xs limit)
for y in (cycle-take ys limit)
collect (cons x y)))
;; Usage:
(cycling-zip '("a" "b" "c") '("1" "2" "3" "4"))
; => (("a" . "1") ("b" . "2") ("c" . "3") ("a" . "4"))

This answer requires dash list manipulation library. Before attacking your problem, it's good to find the length of the longest list. The first way I came up with is:
(require 'dash)
(require 'dash-functional)
(length (-max-by (-on '> 'length) (list x y))) ; 4
-on is a smart function from package dash-functional that accepts a comparator, a key on which to compare, and returns a function that compares on this key. Therefore (-max-by (-on '> 'length) xs) finds an element in xs, whose length is biggest. But this expression is too smart for its own sake, and dash-functional only works in Emacs 24 due to lexical scoping. Let's rewrite it, inspired by Python solution:
(-max (-map 'length (list x y))) ; 4
To take first n elements from an infinite cycled list, do (-take n (-cycle xs)). Therefore to create an alist, where elements from a smaller list are cycled, write:
(let ((len (-max (-map 'length (list x y)))))
(flet ((cycle (xs) (-take len (-cycle xs))))
(-zip (cycle x) (cycle y)))) ; (("a" . "1") ("b" . "2") ("c" . "3") ("a" . "4"))

I went with the recursive approach that seemed natural for lisp.
(defun zip (xs ys)
(cond
((or (null xs) (null ys)) ())
(t (cons (cons (car xs) (car ys)) (zip (cdr xs) (cdr ys))))))

Related

Compose a list by repeating the elements of a list in Scheme

I know that
(define (repe k n) (make-list k n))
compose a list where n appears k times but... How can I construct a similar sentence for which k is the first element and n the second of a previous list?
My
(define (repe x) (make-list car(x) cdr(x)) list)
does not seem to work.
On the other hand, I want the second element of the list n not to be a number but a letter. How can it be done (since make-list seems to be defined just for numbers)?
Functions are applied like this: (car x) and (cdr x), not like car(x) and cdr(x).
And (cdr x) is a list - the second element is (car (cdr x)), or (cadr x) for short.
Your description isn't entirely clear, but it seems like you're looking for
(define (repe xs) (make-list (car xs) (cadr xs)))
Examples:
> (repe (list 4 #\Z))
'(#\Z #\Z #\Z #\Z)
> (repe (list 3 "hello"))
'("hello" "hello" "hello")
> (repe '(2 (+ 1 1)))
'((+ 1 1) (+ 1 1))

Prolog translation of Lisp's tail-recursion

I have a question that is a followup to a previous topic,
Should I avoid tail recursion in Prolog and in general?
In the above linked article , user false
provided this code example and this explanation ...
Back in the 1970s, the major AI language was LISP. And the
corresponding definition would have been ...
(defun addone (xs)
(cond ((null xs) nil)
(t (cons (+ 1 (car xs))
(addone (cdr xs))))))
... which is not directly tail-recursive: The reason is the cons:
In implementations of that time, its arguments were evaluated first,
only then, the cons could be executed. So rewriting this as you have
indicated (and reversing the resulting list) was a possible
optimization technique.
In Prolog, however, you can create the cons prior to knowing the
actual values, thanks to logic variables. So many programs that were
not tail-recursive in LISP, translated to tail-recursive programs in
Prolog.
The repercussions of this can still be found in many Prolog
textbooks.
My question is : what is a good Prolog translation of the above
LISP code ?
EDIT: added the example of the lisp code in action and the
lisp documentation describing the various lisp functions .
example of addone in action
1 > (addone '(1 2 3))
(2 3 4)
2 > (addone '('()))
> Error: The value 'NIL is not of the expected type NUMBER.
> While executing: CCL::+-2, in process listener(1).
> Type :POP to abort, :R for a list of available restarts.
> Type :? for other options.
3 > (addone '(a b c))
> Error: The value A is not of the expected type NUMBER.
> While executing: CCL::+-2, in process listener(1).
> Type :POP to abort, :R for a list of available restarts.
> Type :? for other options.
3 > ^C
documentation of lisp features
cons object-1 object-2 => cons
Creates a fresh cons ,
the car of which is object-1 ,
and the cdr of which is object-2 .
Examples
(cons 1 2) => (1 . 2)
(cons 1 nil) => (1)
(cons nil 2) => (NIL . 2)
(cons nil nil) => (NIL)
(cons 1 (cons 2 (cons 3 (cons 4 nil)))) => (1 2 3 4)
(cons 'a 'b) => (A . B)
(cons 'a (cons 'b (cons 'c '()))) => (A B C)
(cons 'a '(b c d)) => (A B C D)
(car x) => object
If x is a cons ,
car returns the car of that cons .
If x is nil ,
car returns nil .
(cdr x) => object
If x is a cons ,
cdr returns the cdr of that cons .
If x is nil ,
cdr returns nil
.
cond {clause}* => result*
clause::= (test-form form*)
Test-forms are evaluated one at a time in the order in which they
are given in the argument list until a test-form is found that
evaluates to true .
If there are no forms in that clause, the primary value of the
test-form [ed: the first value of the test-form , or nil if there
are no values] is returned by the cond form. Otherwise, the forms
associated with this test-form are evaluated in order, left to
right, as an implicit progn, and the values returned by the last
form are returned by the cond form.
Once one test-form has yielded true, no additional test-forms are
evaluated. If no test-form yields true, nil is returned
See
http://www.lispworks.com/documentation/HyperSpec/Body/m_cond.htm#cond
for more information .
defun function-name lambda-list form* => function-name
See
http://www.lispworks.com/documentation/HyperSpec/Body/m_defun.htm#defun
for more information .
t => T
t => T
(eq t 't) => T
(case 'b (a 1) (t 2)) => 2
Here's a rendition in Prolog of the given Lisp algorithm. Note that Lisp is functional and a Lisp function can return values. This isn't the case in Prolog, so you need two arguments.
A direct implementation, which is not relational, would be:
addone([], []).
addone([H|T], [H1|T1]) :-
H1 is H + 1,
addone(T, T1).
Note that the [H1|T1] argument in the head of the second predicate clause corresponds to (cons H1 T1) in Lisp.
This can also be done using maplist, which steps a little bit away from the original Lisp implementation, but Lisp does have list mapping functions which could be used to create a Lisp implementation that would look more like this:
addone_element(X, X1) :- X1 is X + 1.
addone(List, List1) :- maplist(addone_element, List, List1).
In Prolog this can be made more relational using CLP(FD) which is useful for reasoning over integers:
:- use_module(library(clpfd)).
addone([], []).
addone([H|T], [H1|T1]) :-
H1 #= H + 1,
addone(T, T1).
And the maplist version:
addone_element(X, X1) :- X1 #= X + 1.
addone(List, List1) :- maplist(addone_element, List, List1).
A direct translation:
(defun addone (xs)
(cond ((null xs) nil)
(t (cons (+ 1 (car xs))
(addone (cdr xs))))))
is
addone( XS, RESULT) :-
( XS = [], % null XS ? then:
RESULT = [] %
;
XS = [CAR | CDR], % else:
R is 1 + CAR, % calculate the two
addone( CDR, S) % fields % almost TR,
RESULT = [R | S], % and cons them up % save for this cons
).
But, transformed,
(defun addone (xs)
(let ((result))
(cond ((null xs) (setf result nil))
(t (setf result (cons (+ 1 (car xs))
(addone (cdr xs))))))
result))
=
(defun addone (xs)
(let ((result))
(cond ((null xs) (setf result nil))
(t (setf result (list nil))
(setf (car result) (+ 1 (car xs)))
(setf (cdr result) (addone (cdr xs)))))
result))
=
(defun addone (xs &optional (result (list nil))) ; head sentinel
(cond ((null xs))
(t (setf (cdr result) (list nil))
(setf (cadr result) (+ 1 (car xs)))
(addone (cdr xs) (cdr result)))) ; almost TR
(cdr result)) ; returned but not used
=
(defun addone (xs &aux (result (list nil)))
(labels ((addone (xs result)
(cond ((null xs))
(t (setf (cdr result) (list nil))
(setf (cadr result) (+ 1 (car xs)))
(addone (cdr xs) (cdr result)))))) ; fully TR
(addone xs result))
(cdr result))
it is, fully tail recursive,
addone( XS, RESULT) :-
( XS = [],
RESULT = []
;
XS = [CAR | CDR],
RESULT = [R | S], % cons two empty places, and
R is 1 + CAR, % fill'em
addone( CDR, S) % up % fully TR
).
Boxing / head sentinel is used so we can have settable pointers in Common Lisp, but in Prolog this isn't needed -- Prolog's logical variables are directly settable (once), named pointers.
This is also the reason why Prolog's transformation is so much smaller and easier than Lisp's. All it took was moving one line of code up a notch or two (and it could've been one just the same).

An algorithm in Racket which make an hash of references between lists?

Let's consider this list:
(define parts '(("a" "b" "c" "d" "e" "1")
("x" "y" "z" "a")
("q" "w" "e" "x")
("1" "2" "3" "4" "q")))
I need to make an hash where every first element is a key and its value is a list with references to this key appeared in another lists. This an example of my desired result:
(define desired-result '#hash(("a" . ("x"))
("x" . ("q"))
("q" . ("1"))
("1" . ("a"))))
As you can see "a" (first in first list) is mentioned by "x" ("a" in present in second list beginning with "x"). "x" is mentioned by "q", etc.
I have come up with this code to get a more complete view of the "references" thing, but it not what I need and it is also ugly (and possibly slow) see the complete code:
#lang racket/base
(require racket/list)
(define parts '(("a" "b" "c" "d" "e" "1")
("x" "y" "z" "a")
("q" "w" "e" "x")
("1" "2" "3" "4" "q")))
(define my-hash (make-hash '()))
; This will initialize a key for every single element in parts
(for-each (λ (x)
(hash-set! my-hash x '()))
(remove-duplicates (flatten parts)))
(define (put x y)
(hash-set! my-hash x y))
(define (get x)
(hash-ref my-hash x))
(define (insert a n)
(let ([aList (get a)]
[nList (get n)])
(unless (member n aList)
(put a (append aList (list n))))
(unless (member a nList)
(put n (append nList (list a))))))
(define (iterate l)
(let ([a (car l)]
[r (cdr l)])
(for-each (λ (n) (insert a n)) r)))
(for-each iterate parts)
my-hash
This will result in:
'#hash(("c" . ("a"))
("e" . ("a" "q"))
("2" . ("1"))
("a" . ("b" "c" "d" "e" "1" "x"))
("w" . ("q"))
("4" . ("1"))
("y" . ("x"))
("d" . ("a"))
("3" . ("1"))
("1" . ("a" "2" "3" "4" "q"))
("b" . ("a"))
("q" . ("w" "e" "x" "1"))
("x" . ("y" "z" "a" "q"))
("z" . ("x")))
There are surely better ways to obtain this (and I am curious if someone can suggest some) and I know I can get to desired-result from this, but this will be even uglier.
PS:
This is not a school assignment
I know hashes are not ordered
My solution additionally uses hash set for performance to test if an element is a member of the leading elements or not.
(define (process parts)
(define leading-list (map first parts))
(define leading-set (list->set leading-list))
(define in-leading-set? (curry set-member? leading-set))
(define my-hash (make-hash (map (curryr cons empty) leading-list)))
(for-each
(λ (lst)
(for-each
(λ (e)
(hash-set! my-hash e (cons (first lst) (hash-ref my-hash e))))
(filter in-leading-set? (rest lst))))
parts)
my-hash)
Here's the output
> (process parts)
'#hash(("1" . ("a")) ("x" . ("q")) ("q" . ("1")) ("a" . ("x")))
This has a caveat that, there might be some elements mapping to an empty list. For example:
> (define parts2 '(("a" "b")))
> (process parts2)
'#hash(("a" . ()))
If you don't prefer them, you could post-process by filtering them out.
This might be what you want:
(define dwim
(lambda (parts)
(let loop ((todo parts)
(done '())
(result '()))
(if (null? todo)
result
(let* ((key (caar todo))
(value
(fold
(lambda (lst previous)
(if (member key lst)
(cons (car lst) previous)
previous))
'()
(append (cdr todo) done))))
(loop (cdr todo)
(cons (car todo) done)
(cons (cons key value) result)))))))

filter function using tail recursion

Currently I have
(define filter
(λ (f xs)
(letrec [(filter-tail
(λ (f xs x)
(if (empty? xs)
x
(filter-tail f (rest xs)
(if (f (first xs))
(cons (first xs) x)
'()
)))))]
(filter-tail f xs '() ))))
It should be have as a filter function
However it outputs as
(filter positive? '(-1 2 3))
>> (3 2)
but correct return should be (2 3)
I was wondering if the code is correctly done using tail-recursion, if so then I should use a reverse to change the answer?
I was wondering if the code is correctly done using tail-recursion.
Yes, it is using a proper tail call. You have
(define (filter-tail f xs x) ...)
Which, internally is recursively applied to
(filter-tail f
(some-change-to xs)
(some-other-change-to x))
And, externally it's applied to
(filter-tail f xs '())
Both of these applications are in tail position
I should use a reverse to change the answer?
Yep, there's no way around it unless you're mutating the tail of the list (instead of prepending a head) as you build it. One of the comments you received alluded to this using set-cdr! (see also: Getting rid of set-car! and set-cdr!). There may be other techniques, but I'm unaware of them. I'd love to hear them.
This is tail recursive, requires the output to be reversed. This one uses a named let.
(define (filter f xs)
(let loop ([ys '()]
[xs xs])
(cond [(empty? xs) (reverse ys)]
[(f (car xs)) (loop (cons (car xs) ys) (cdr xs))]
[else (loop ys (cdr xs))])))
(filter positive? '(-1 2 3)) ;=> '(2 3)
Here's another one using a left fold. The output still has to be reversed.
(define (filter f xs)
(reverse (foldl (λ (x ys) (if (f x) (cons x ys) ys))
'()
xs)))
(filter positive? '(-1 2 3)) ;=> '(2 3)
With the "difference-lists" technique and curried functions, we can have
(define (fold c z xs)
(cond ((null? xs) z)
(else (fold c (c (car xs) z) (cdr xs)))))
(define (comp f g) (lambda (x) ; ((comp f g) x)
(f (g x))))
(define (cons1 x) (lambda (y) ; ((cons1 x) y)
(cons x y)))
(define (filter p xs)
((fold (lambda (x k)
(if (p x)
(comp k (cons1 x)) ; nesting's on the left
k))
(lambda (x) x) ; the initial continuation, IC
xs)
'()))
(display (filter (lambda (x) (not (zero? (remainder x 2)))) (list 1 2 3 4 5)))
This builds
comp
/ \
comp cons1 5
/ \
comp cons1 3
/ \
IC cons1 1
and applies '() to it, constructing the result list in the efficient right-to-left order, so there's no need to reverse it.
First, fold builds the difference-list representation of the result list in a tail recursive manner by composing the consing functions one-by-one; then the resulting function is applied to '() and is reduced, again, in tail-recursive manner, by virtues of the comp function-composition definition, because the composed functions are nested on the left, as fold is a left fold, processing the list left-to-right:
( (((IC+k1)+k3)+k5) '() ) ; writing `+` for `comp`
=> ( ((IC+k1)+k3) (k5 '()) ) ; and `kI` for the result of `(cons1 I)`
<= ( ((IC+k1)+k3) l5 ) ; l5 = (list 5)
=> ( (IC+k1) (k3 l5) )
<= ( (IC+k1) l3 ) ; l3 = (cons 3 l5)
=> ( IC (k1 l3) )
<= ( IC l1 ) ; l1 = (cons 1 l3)
<= l1
The size of the function built by fold is O(n), just like the interim list would have, with the reversal.

Frequency list 2 - Huffman project

Previously I had the question about adding a character to a frequency list(Add a character to a frequency list), it got solved, but i have problems again with the rest of the project. The next 2 functions are working:
Write a function which creates the frequency list( from a list of characters)
(statistiques '("a" "b" "r" "a" "c" "a" "d" "a" "b" "r" "a"))
→ (("a" 5) ("r" 2) ("b" 2) ("d" 1) ("c" 1))
My code:
(define statistiques
(lambda (l)
(if (null? l)
l
(ajoute1(car l)(statistiques (cdr l))))))
Write a function which is inserting a pair (a character and a number which indicates the occurrence of that character in a list), in a list of pairs which is sorted by the number of occurrence
(inserefreq '("b" 2) '(("d" 1) ("a" 5)))
→ (("d" 1) ("b" 2) ("a" 5))
(define inserefreq
(lambda (c l)
(cond ((null? l)
(list c))
((<= (cadr c) (cadar l))
(cons c l))
(else
(cons (car l) (inserefreq c (cdr l)))))))*
Then the problem is with the next one, which is asking to sort a frequency list by successive insertion
(triefreq '(("a" 5) ("r" 2) ("b" 2) ("d" 1) ("c" 1)))
→ (("d" 1) ("c" 1) ("r" 2) ("b" 2) ("a" 5))
My code:
(define tirefreq
(lambda (l)
(inserefreq(car l) (tirefreq (cdr l)))))
Result/error:
You're just missing the base case, when l is empty:
(define triefreq
(lambda (l)
(if (null? l)
'()
(inserefreq (car l) (triefreq (cdr l))))))

Resources