Recursively calling function in scheme with let - recursion

Is it possible, in scheme, to do something like the following?
(define (foo a b c d e)
(let ((recurse (foo a b c (bar d) e))
(if (= d e)
#f
(recurse))))
I have a function with a rather lengthy set of arguments and some conditions that recursively call it and it's rather unsightly, I'd like to be able to shorthand it.
I've tried this a few different ways but I either get an infinite loop (I presume let is eagerly evaluating) or I get bad let form errors.

You need a thunk:
(define (foo a b c d e)
(let ((recurse (lambda () (foo a b c (bar d) e))))
(if (= d e)
#f
(recurse))))
This then permits you to add arguments if some but not all of the parameters change.

Since most of the arguments don't change you should consider using named let:
(define (foo a b c d e)
(let recurse ((d d))
(if (= d e)
#f
(recurse (cdr d)))))
This is basically the same as:
(define (foo a b c d e)
(define (recurse d)
(if (= d e)
#f
(recurse (cdr d))))
// start recursion
(recurse d))
All the other variables will be available through the closure.

Related

Skip value in multiple-value-bind

A library function returns seven values. I only need the first four and the last one. Is there a more elegant way than:
(multiple-value-bind (a b c d e f g)
(library-call)
(declare (ignore e f))
(rest-of-code a b c d g))
You can keep a "mvb" look and feel with the metabang-bind library (a let on steroïds which allows more destructing and bindings) and use the _ placeholder.
Below, we "bind" on a multiple-value with `(:values …):
(metabang.bind:bind (((:values _ b) (values 1 2)))
b)
;; => 2
You can use MULTIPLE-VALUE-LIST and SUBSEQ:
(defun library-call () (apply #'values '(a b c d e f g)))
(defun rest-of-code (&rest rest)
(print rest))
(let ((lst (multiple-value-list (library-call))))
(apply #'rest-of-code
`(,#(subseq lst 0 4) ,(car (last lst)))))
=> (A B C D G)
I think the only way to do this without consing some intermediate structure is what you suggest. Of course this is easy to define syntax for if it happens a lot.
As an example here's a thing called mvb which is like multiple-value-bind except that variables whose name is "_" are ignored (so this doesn't rely on exporting a symbol _). This relies on org.tfeb.hax.collecting: it could be redone not to.
(defmacro mvb (bindings form &body forms)
(multiple-value-bind (vars ignores)
(with-collectors (var ignore)
(let ((i 1))
(dolist (b bindings)
(typecase b
(symbol
(cond
((string= (symbol-name b) "_")
(let ((g (make-symbol (format nil "_~D" i))))
(incf i)
(var g)
(ignore g)))
(t
(var b))))
(t
(error "mutant binding ~A" b))))))
`(multiple-value-bind ,vars ,form
,#(if ignores `((declare (ignore ,#ignores))))
,#forms)))
With this your call would be
(mvb (a b c d _ _ g)
(library-call)
(rest-of-code a b c d g))
Which turns into
(multiple-value-bind (a b c d #:|_1| #:|_2| g)
(library-call)
(declare (ignore #:|_1| #:|_2|))
(rest-of-code a b c d g))
Note that my binding macro now supports something similar to this, using nil as the 'don't bind anything' placeholder:
(binding
(bind/values (a nil b) (values 1 2 3))
(print a)
(bind c (+ a b))
c)
nil is a nice choice I think because it can't break any existing program since nil can't be bound.

Function that returns the union(in alphabetic order) of two sets in Lisp

The procedure below takes two lists and returns their union as an ordered list.
(defun stable-union (lst1 lst2)
(cond ((null lst1) lst2)
((null lst2) lst1)
((and (null lst1) (null lst2)) nil)
(t
(let ((el1 (car lst1))
(el2 (car lst2)))
(cond ((string= el1 el2)
(cons el1
(stable-union (cdr lst1) (cdr lst2))))
((string< el1 el2)
(cons el1
(stable-union (cdr lst1) lst2)))
(t
(cons el2
(stable-union lst1 (cdr lst2)))))))))
It works for some examples and fails for others. For example:
STABLE-UNION: (STABLE-UNION '(A B C) '(B A D)) failed:
Expected (A B C D) but saw (A B A C D)
STABLE-UNION: (STABLE-UNION '(A B C) '(A D B E)) failed:
Expected (A B C D E) but saw (A B C D B E)
STABLE-UNION: (STABLE-UNION '(C B A) '(A E B D)) failed:
Expected (C B A E D) but saw (A C B A E B D)
Can you guide me as to where I am making mistakes in my code? Thank you so much.
The above function works only for lists that are composed by symbols already lexicographically ordered. So, for instance, it works correctly for '(A B C) '(A B D), but not for '(A B C) '(B A D).
There are several ways of correcting it. The simplest one is to call it by sorting (with stable-sort) the two arguments, for instance:
(defun stable-union-general (lst1 lst2)
(stable-union (stable-sort lst1 #'string<) (stable-sort lst2 #'string<)))
(stable-union-general '(A B C) '(B A D))
(A B C D)
Another, less efficient, way is to change the algorithm by taking into account unordered lists.
Finally note that the third branch of the outer conditional is never statisfied: ((and (null lst1) (null lst2)) nil)
This is because, in this case, the first branch is true and the function returns nil.

Scheme / Racket insert-everywhere function with sublists

So I've been trying to solve this problem:
Given an element E and a list L insert E into every position in the list L (so the result is a list of lists). Example:
(insert-everywhere 'a '(b c)) would give ((a b c) (b a c) (b c a))
This is easy enough but there is one other condition in my problem that is making it difficult for me - if an element of L is a list itself then the element must also be inserted into every position in the sublist. For example:
(insert-everywhere 'd '(a (b c))) would return: ((d a (b c)) (a d (b c)) (a (d b c)) (a (b d c)) (a (b c d)) (a (b c) d)).
This is the code I have so far (which I mostly lifted from here):
#lang racket
(define (insert-at pos elmt lst)
(if (empty? lst) (list elmt)
(if (list? (car lst)) (insert-everywhere elmt (car lst))
(if (= 1 pos)
(cons elmt lst)
(cons (first lst)
(insert-at (- pos 1) elmt (rest lst)))))))
(define (insert-everywhere sym lst)
(remove-duplicates
(map (lambda (i)
(insert-at i sym lst))
(range 1 (+ 2 (length lst))))))
where this line: (if (list? (car lst)) (insert-everywhere elmt (car lst)) is supposed to handle the sublists but it isn't working. (If I run (insert-everywhere 'd '(a (b c))) with the above code I get ((d a (b c)) (a (d b c) (b d c) (b c d))))
If anyone has suggestions on how to approach this differently I'd be happy to hear.
I wouldn't do indexing as it is very inefficient. Rather reverse the input list and build the list from end to beginning making the results in reverse order. You have a current list that you add elements to with cons that you use to add new additions to the results and each level each result that existed gets the one element added too.
As parameters you have state. When i made a reference I used result and cur and typically my iteration did like this for (insert-everywhere 'd '(a b c)):
lst cur results
(c b a) () ((d))
(b a) (c) ((d c) (c d))
(a) (b c) ((d b c) (b d c) (b c d))
() (a b c) ((d a b c) (a d b c) (a b d c) (a b c d)))
Now adding support for sublists are just doing the same with them and then do a map such that you create one result per sublist in the result, adding cur in addition to adding it as an element.
Notice all new results are just cur with an added inserted element and all th erest gets a new element in fron which is the first element of the input. cur will grow and it is shared so only the elements up to the inserted element will be unique to that sub result.
I have a working implementation, but it's no fun getting the solution prematurely. Have fun.

Why does the Common Lisp's apply function give a different result?

When I try this code on Emacs SLIME, the apply function gives a different result. Isn't it supposed to give the same result? Why does it give a different result? Thanks.
CL-USER> (apply #'(lambda (n)
(cons n '(b a))) '(c))
(C B A)
CL-USER> (cons '(c) '(b a))
((C) B A)
cons takes an element and a list as arguments. So (cons 'x '(a b c d)) will return (x a b c d).
apply takes a function and a list of arguments -- but the arguments will not be passed to the function as a list! They will be split and passed individually:
(apply #'+ '(1 2 3))
6
(actually, it takes one function, several arguments, of which the last must be a list -- this list will be split and treated as "the rest of the arguments to the function". try, for example, (apply #'+ 5 1 '(1 2 3)), which will return 12)
Now to your code:
The last argument you passed to the apply function is '(c), a list with one element, c. Apply will treat it as a list of arguments, so the first argument you passed to your lambda-form is c.
In the second call, you passed '(c) as first argument to cons. This is a list, which was correctly included in the first place of the resulting list: ( (c) b a).
The second call would be equivalent to the first if you did
(cons 'c '(b a))
(c b a)
And the first call would be equivalent to the second if you did
(apply #'(lambda (n) (cons n '(b a))) '((c)))
((c) b a)
CL-USER 51 > (cons '(c) '(b a))
((C) B A)
CL-USER 52 > (apply #'(lambda (n)
(cons n '(b a)))
'(c))
(C B A)
Let's use FUNCALL:
CL-USER 53 > (funcall #'(lambda (n)
(cons n '(b a)))
'(c))
((C) B A)
See also what happens when we apply a two element list:
CL-USER 54 > (apply #'(lambda (n)
(cons n '(b a)))
'(c d))
Error: #<anonymous interpreted function 40600008E4> got 2 args, wanted 1.
There is a symmetry between &rest arguments in functions and apply.
(defun function-with-rest (arg1 &rest argn)
(list arg1 argn))
(function-with-rest 1) ; ==> (1 ())
(function-with-rest 1 2) ; ==> (1 (2))
(function-with-rest 1 2 3 4 5) ; ==> (1 (2 3 4 5))
Imagine we want to take arg1 and argn and use it the same way with a function of our choice in the same manner as function-with-rest. We double the first argument and sum the rest.
(defun double-first-and-sum (arg1 &rest argn)
(apply #'+ (* arg1 2) argn))
(double-first-and-sum 1 1) ; ==> 3
(double-first-and-sum 4 5 6 7) ; ==> 26
The arguments between the function and the list of "rest" arguments are additional arguments that are always first:
(apply #'+ 1 '(2 3 4)) ; ==> (+ 1 2 3 4)
(apply #'+ 1 2 3 '(4)) ; ==> (+ 1 2 3 4)
This is very handy since often we want to add more arguments than we are passed (or else we could just have used the function apply is using in the first place. Here is something called zip:
(defun zip (&rest args)
(apply #'mapcar #'list args))
So what happens when you call it like this: (zip '(a b c) '(1 2 3))? Well args will be ((a b c) (1 2 3)) and the apply will make it become (mapcar #'list '(a b c) '(1 2 3)) which will result in ((a 1) (b 2) (c 3)). Do you see the symmetry?
Thus you could in your example you could have done this:
(apply #'(lambda (&rest n)
(cons n '(b a))) '(c))
;==> ((c) b a)
(apply #'(lambda (&rest n)
(cons n '(b a))) '(c d e))
;==> ((c d e) b a)

Scheme: Counting types using recursion

Structure Definition:
(define-struct movie (title genre stars))
;; title is a nonempty string
;; genre is a nonempty string
;; stars us a list of nonempty strings
I am trying to write a scheme function that consumes a list of movies and produces the genre that occurs most often.
So far, I have the following:
(define (popular-gnere movies)
(local
[(define acc movies genre)
(cond
[(empty? movies) genre]
[(equal? genre (movie-genre (first movies)))
(acc (rest movies genre)))
I'm stuck as to how I can keep count of how many times a specific genre has appeared in a given list of movies.
I understand that accumulated recursion in this case would be most efficient but am having trouble completing my accumulator.
Why don't you fix your parentheses problem and indent the code properly. Press CRTL+i. Where the identation is wrong you probably have missing parentheses. Press Run to evaluate and you'd get proper error messages. When you have something that doesn't produce errors, update this question.
The answer your question you add more parameters to your local procedures than the global. That way you hae a parameter that can hold a count that you increase when you find the search element in the current element.eg.
(define (length lst)
(define (length-aux lst cnt)
(if (null? lst)
cnt
(length-aux (cdr lst) (add1 cnt))))
(length-aux lst 0))
Or better with named let
(define (length lst)
(let length-aux ((lst lst) (cnt 0))
(if (null? lst)
cnt
(length-aux (cdr lst) (add1 cnt)))))
EDIT
I recommend having at least 4 helper procedures that takes each their part of a problem. (Less if you make use racket's own remove, count, and argmax). Note that there are probably many other ways to solve this but this is how I would have solved it without a hash table.
Since you are only interested in genre the first thing to imagine is that you can do (map movie-genre lst) so that you get a list of genres to work with in your main helper.
In your main helper you can build up a list of cons having genre and count. To do that you use a helper count that (count 'c '(a b c d c c a) 0) ==> 3 and you just take the first genre and count the list for those as the first accumulated value, then process the result of (remove 'c '(a b c d c c a) '()) ==> (a d b a) on the rest of the list.
When processing is done you have in your accumulator ((a . 4) (b . 6) ...) and you need a helper (max-genre 'a 4 '((b . 6) (c . 20) (d . 10))) ; ==> c
The main helper would look something like this:
(define (aux lst acc)
(if (null? lst)
(max-genre (caar acc) (cdar acc) (cdr acc))
(aux (remove (car lst) lst '())
(cons (cons (car lst) (count (car lst) lst 0)) acc))))
Now you could do it a lot simpler with a hash table in one pass. You'd still have to have max-genre/argmax after reading all elements once.
First you need to settle on a key-value datatype. You could use association lists, but hash tables are a more efficient choice.
Let's start with a short list:
(define-struct movie (title genre stars))
(define films
(list
(make-movie "Godfater" "Crime" '("Marlon Brando" "Al Pacino"))
(make-movie "Rambo" "Thriller" '("Sylvester Stallone"))
(make-movie "Silence of the Lambs" "Crime" '("Jodie Foster" "Anthony Hopkins"))))
and create an empty hash table
(define h (make-hash))
Now we process every film, updating the hash table as we go:
> (for-each (lambda (e) (hash-update! h e add1 0)) (map movie-genre films))
> h
'#hash(("Thriller" . 1) ("Crime" . 2))
Now we need to find the highest count:
> (hash-values h)
'(1 2)
> (define most (foldl (lambda (e r) (if (> e r) e r)) 0 (hash-values h)))
> most
2
So 2 is our highest count. Now we create a list of all genres with count 2:
> (hash->list h)
'(("Thriller" . 1) ("Crime" . 2))
> (foldl
(lambda (e r) (if (= (cdr e) most) (cons (car e) r) r))
null
(hash->list h))
'("Crime")
Putting it all together:
(define (count-by-genre lst)
(define h (make-hash))
(for-each (lambda (e) (hash-update! h e add1 0)) (map movie-genre lst))
(define most (foldl (lambda (e r) (if (> e r) e r)) 0 (hash-values h)))
(foldl
(lambda (e r) (if (= (cdr e) most) (cons (car e) r) r))
null
(hash->list h)))
But this is quite inefficient, for several reasons:
after updating the hash table, we have to re-iterate over it, create a list and then apply foldl just to find the highest value, whereas we could have just kept note of it while updating the hash table
then again we create a full list (hash->list) and a final result list using foldl.
Lots of consing and stuff. An alternative, more efficient version using Racket-specific for constructs, could be:
(define (count-by-genre lst)
(define h (make-hash))
(define most
(for/fold ((highest 0)) ((e (in-list (map movie-genre lst))))
(define new (add1 (hash-ref h e 0)))
(hash-set! h e new)
(max highest new)))
(for/fold ((res null)) (((k v) (in-hash h)))
(if (= v most) (cons k res) res)))

Resources