Defining a macro in Scheme to create fancy sublist - functional-programming

I would like to resolve a problem about macro:
Define this construct:
(subl e_1 e_2 ... -> e_i ... e_j <- e_j+1 ... e_n);
its evalutation returns the sublist (e_i ... e_j).
E.g. (subl 1 -> 2 3 4 <- 5 6) should be (2 3 4).
I tried to solve it (the following is a partial solution) but it didn't work...
(define-syntax subl
(syntax-rules(> <)
((_ x y ... > x ... y < c v )
(begin
'(x y)))))
The error is :
syntax-rules: misplaced ellipsis in pattern (follows other ellipsis)
in: ...

You cannot use multiple ellipsis in a single pair of brackets, it doesn't matter if you are using the keywords -> and <- the language is not clever enough to know where to stop the expansion.
Examples:
(_ x ...) is legit and x ... captures everything until the closing bracket.
(_ x y ... z) is legit and x matches a single element at the beginning, y ... captures everything, but the last element and z matches a single element at the end.
(_ (x ...) y ...) is legit and x ... captures everything inside the inner brackets and y ... everithing inside the outer brackets.
(_ x ... y ...) it is not legit, since you can't tell how far to expand the two groups.
So you have to address the problem in multiple steps: remove the elements before ->, remove the elements after <- and finally capture the list in the middle.
(define-syntax subl
(syntax-rules (-> <-)
((_ -> x ... <-)
'(x ...))
((_ -> x ... y)
(subl -> x ...))
((_ x y ...)
(subl y ...))))

You need to make patterns that transforms your source to something simpler to process:
(define-syntax subl
(syntax-rules (-> <-)
((_ "build-list" end middle before)
(subl "execute" before middle end))
((_ "build-list" before () () -> . rest)
(subl "build-list" () () before . rest ))
((_ "build-list" middle () before <- . rest)
(subl "build-list" () middle before . rest ))
((_ "build-list" (xs ...) the others x . rest)
(subl "build-list" (xs ... x) the others . rest))
((_ "execute" before middle end)
; I guess this is wrong
'middle)
((_ . rest)
(subl "build-list" () () () . rest))))
(subl a b c -> d e f <- f g) ; == '(d e f) => (d e f)
What is does is to change the format you would like the code to have to something simpler. (subl a b c -> d e f <- f g) => (subl "execute" (a b c) (d e f) (f g)) then you have the logic you want in the pattern for "execute".

You can implement your macro using Racket's syntax-parse (since you included the racket tag :) ), which has a more expressive pattern language than syntax-rules.
#lang racket
(require (for-syntax syntax/parse))
(define-syntax (subl stx)
(syntax-parse stx #:datum-literals (-> <-)
[(_ a b ... -> c ... d <- e ... f)
#:when (printf "a: ~a\n" (syntax->datum #'a))
#:when (printf "bs: ~a\n" (syntax->datum #'(b ...)))
#:when (printf "cs: ~a\n" (syntax->datum #'(c ...)))
#:when (printf "d: ~a\n" (syntax->datum #'d))
#:when (printf "es: ~a\n" (syntax->datum #'(e ...)))
#:when (printf "f: ~a\n" (syntax->datum #'f))
#''(c ... d)]))
(subl 1 -> 2 3 4 <- 5 6)
produces:
a: 1
bs: ()
cs: (2 3)
d: 4
es: (5)
f: 6
'(2 3 4)

Related

Counting number of occurrences of elements in a list

I am writing a function called count-if, which takes in a predicate, p?, and a list, ls. The function returns the number of occurrences of elements in the nested list that satisfy p?
For example: (count-if (lambda (x) (eq? 'z x)) '((f x) z (((z x c v z) (y))))) will return 3. This is what I have written:
(define (count-if p ls) (cond
((null? ls) '())
((p (car ls))
(+ 1 (count-if p (cdr ls))))
(else
(count-if p (cdr ls)))))
But I just get an error. I could use some help finding a better way to go about this problem. Thanks!
What is the signature of count-if? It is:
[X] [X -> Boolean] [List-of X] -> Number
What does the first cond clause return? It returns:
'()
This is a simple type error. Just change the base case to 0 and count-if works.
Edit (for nested).
First we define the structure of the date as Nested.
A symbol is just fed into the score helper function. Otherwise the recursive call is applied on all nested sub-nesteds, and the results are summed up.
#lang racket
; Nested is one of:
; - Number
; - [List-of Nested]
; Nested -> Number
(define (count-if pred inp)
; Symbol -> Number
(define (score n) (if (pred n) 1 0))
; Nested -> Number
(define (count-if-h inp)
(if (symbol? inp)
(score inp)
(apply + (map count-if-h inp))))
(count-if-h inp))
(count-if (lambda (x) (eq? 'z x)) '((f x) z (((z x c v z) (y)))))
; => 3

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)

How to use tail-recursive to implement a recursive function

(replicate-to-length '(a b c) 8)
(a b c a b c a b)
(replicate-to-length '(a b c) 2)
(a b)
Well. you define a local procedure and make sure you don't shadow the original argument so that you can us it instead of the empty list.
(define (replicate-to-length x i)
(define (replicate-to-length-aux cx i)
...)
;; call helper
(replicate-to-length-aux x i))
Or you can lambda lift it:
(define (replicate-to-length-aux x cx i)
...)
(define (replicate-to-length x i)
(replicate-to-length-aux x x i))
Of course I guess this is just to learn. I would have done something like this:
#!r6rs
(import (rnrs base)
(only (srfi :1) circular-list take))
(define (replicate-to-length x i)
(take (apply circular-list x) i))

Applying the Y-Combinator to a recursive function with two arguments in Clojure?

Doing the Y-Combinator for a single argument function such as factorial or fibonacci in Clojure is well documented:
http://rosettacode.org/wiki/Y_combinator#Clojure
My question is - how do you do it for a two argument function such as this getter for example?
(Assumption here is that I want to solve this problem recursively and this non-idiomatic clojure code is there deliberately for another reason)
[non y-combinator version]
(defn get_ [n lat]
(cond
(empty? lat) ()
(= 0 (- n 1)) (first lat)
true (get_ (- n 1) (rest lat))))
(get_ 3 '(a b c d e f g h i j))
The number of args doesn't change anything since the args are apply'd. You just need to change the structure of get_:
(defn get_ [f]
(fn [n lat]
(cond
(empty? lat) ()
(= 1 n) (first lat)
:else (f (dec n) (next lat)))))
(defn Y [f]
((fn [x] (x x))
(fn [x]
(f (fn [& args]
(apply (x x) args))))))
user=> ((Y getf) 3 '(a b c d e f g h i j))
c
It'd be pretty straight forward.
Say you've got a function H:
(def H
(fn [x]
(fn [x y]
(stuff happens))))
Then you apply the same ol' Y-Combinator:
((Y H) 4 5)
Where 4 and 5 are arguments you want to pass to H.
The combinator is essentially "dealing with" the top-level function in H, not the one that's doing the hard work (the one with arity 2, here).

Scheme/Lisp nested loops and recursion

I'm trying to solve a problem in Scheme which is demanding me to use a nested loop or a nested recursion.
e.g. I have two lists which I have to check a condition on their Cartesian product.
What is the best way to approach these types of problems? Any pointers on how to simplify these types of functions?
I'll elaborate a bit, since my intent might not be clear enough.
A regular recursive function might look like this:
(define (factorial n)
(factorial-impl n 1))
(define (factorial-impl n t)
(if (eq? n 0)
t
(factorial-impl (- n 1) (* t n))))
Trying to write a similar function but with nested recursion introduces a new level of complexity to the code, and I was wondering what the basic pattern is for these types of functions, as it can get very ugly, very fast.
As a specific example, I'm looking for the easiest way to visit all the items in a cartesian product of two lists.
In Scheme,
The "map" function is often handy for computing one list based on another.
In fact, in scheme, map takes an "n-argument" function and "n" lists and calls the
function for each corresponding element of each list:
> (map * '(3 4 5) '(1 2 3))
(3 8 15)
But a very natural addition to this would be a "cartesian-map" function, which would call your "n-argument" function with all of the different ways of picking one element from each list. It took me a while to figure out exactly how to do it, but here you go:
; curry takes:
; * a p-argument function AND
; * n actual arguments,
; and returns a function requiring only (p-n) arguments
; where the first "n" arguments are already bound. A simple
; example
; (define add1 (curry + 1))
; (add1 3)
; => 4
; Many other languages implicitly "curry" whenever you call
; a function with not enough arguments.
(define curry
(lambda (f . c) (lambda x (apply f (append c x)))))
; take a list of tuples and an element, return another list
; with that element stitched on to each of the tuples:
; e.g.
; > (stitch '(1 2 3) 4)
; ((4 . 1) (4 . 2) (4 . 3))
(define stitch
(lambda (tuples element)
(map (curry cons element) tuples)))
; Flatten takes a list of lists and produces a single list
; e.g.
; > (flatten '((1 2) (3 4)))
; (1 2 3 4)
(define flatten
(curry apply append))
; cartesian takes two lists and returns their cartesian product
; e.g.
; > (cartesian '(1 2 3) '(4 5))
; ((1 . 4) (1 . 5) (2 . 4) (2 . 5) (3 . 4) (3 . 5))
(define cartesian
(lambda (l1 l2)
(flatten (map (curry stitch l2) l1))))
; cartesian-lists takes a list of lists
; and returns a single list containing the cartesian product of all of the lists.
; We start with a list containing a single 'nil', so that we create a
; "list of lists" rather than a list of "tuples".
; The other interesting function we use here is "fold-right" (sometimes called
; "foldr" or "reduce" in other implementations). It can be used
; to collapse a list from right to left using some binary operation and an
; initial value.
; e.g.
; (fold-right cons '() '(1 2 3))
; is equivalent to
; ((cons 1 (cons 2 (cons 3 '())))
; In our case, we have a list of lists, and our binary operation is to get the
; "cartesian product" between each list.
(define cartesian-lists
(lambda (lists)
(fold-right cartesian '(()) lists)))
; cartesian-map takes a n-argument function and n lists
; and returns a single list containing the result of calling that
; n-argument function for each combination of elements in the list:
; > (cartesian-map list '(a b) '(c d e) '(f g))
; ((a c f) (a c g) (a d f) (a d g) (a e f) (a e g) (b c f)
; (b c g) (b d f) (b d g) (b e f) (b e g))
(define cartesian-map
(lambda (f . lists)
(map (curry apply f) (cartesian-lists lists))))
Without all the comments and some more compact function definition syntax we have:
(define (curry f . c) (lambda x (apply f (append c x))))
(define (stitch tuples element)
(map (curry cons element) tuples))
(define flatten (curry apply append))
(define (cartesian l1 l2)
(flatten (map (curry stitch l2) l1)))
(define cartesian-lists (curry fold-right cartesian '(()))))
(define (cartesian-map f . lists)
(map (curry apply f) (cartesian-lists lists)))
I thought the above was reasonably "elegant"... until someone showed me the equivalent Haskell definition:
cartes f (a:b:[]) = [ f x y | x <- a , y <- b ]
cartes f (a:b:bs) = cartes f ([ f x y | x <- a , y <- b ]:bs)
2 lines!!!
I am not so confident on the efficiency of my implementation - particularly the "flatten" step was quick to write but could end up calling "append"
with a very large number of lists, which may or may not be very efficient on some Scheme
implementations.
For ultimate practicality/usefulness you would want a version that could take "lazily evaluated" lists/streams/iterator rather than fully specified lists.... a "cartesian-map-stream" function if you like, that would then return a "stream" of the results... but this depends on the context (I am thinking of the "stream" concept as introduced in SICP)... and would come for free from the Haskell version thanks to it's lazy evaluation.
In general, in Scheme, if you wanted to "break out" of the looping at some point you could also use a continuation (like throwing an exception but it is accepted practise in Scheme for control flow).
I had fun writing this!
I'm not sure I see what the problem is.
I believe the main thing you have to understand in functional programming is : build complicated functions by composing several simpler functions.
For instance, in this case:
;compute the list of the (x,y) for y in l
(define (pairs x l)
(define (aux accu x l)
(if (null? l)
accu
(let ((y (car l))
(tail (cdr l)))
(aux (cons (cons x y) accu) x tail))))
(aux '() x l))
(define (cartesian-product l m)
(define (aux accu l)
(if (null? l)
accu
(let ((x (car l))
(tail (cdr l)))
(aux (append (pairs x m) accu) tail))))
(aux '() l))
You identify the different steps: to get the cartesian product, if you "loop" over the first list, you're going to have to be able to compute the list of the (x,y), for y in the second list.
There are some good answers here already, but for simple nested functions (like your tail-recursive factorial), I prefer a named let:
(define factorial
(lambda (n)
(let factorial-impl ([n n] [t 1])
(if (eq? n 0)
t
(factorial-impl (- n 1) (* t n))))))

Resources