Goal: implement unfold function using only two arguments.
The arguments:
the first argument is f which takes an initial value of some type I and returns nil or a cons pair of two elements (the first of these two is the next element that goes in the list of some type A and the next initial value again of some type I).
The second argument is an initial value of some type I and the return is a list of items of type A.
This is what I have so far and I am not sure why it is not working:
(define (descending i)
(if (= i 0)
(list)
(cons i (- i 1))))
(define nil (list))
(define (unfold f init)
(if (eq? (f init) '())
(list)
(cons init (unfold f (f init)))))
(unfold (descending 5))
should evaluate to
'(5 4 3 2 1)
This should be the result but isn't. What am I doing wrong?
First, it should be (unfold descending 5). Then f would produce a pair and you would use both components of it,
(define (unfold f init)
(if (eq? (f init) '())
(list)
(cons (car (f init)) (unfold f (cdr (f init))))))
But this has awful computational complexity as it calls (f init) three times per iteration. A humble let binding remedies this.
(define (unfold f init)
(let ((r (f init)))
(if (empty? r) ;; instead of (eq? r '())
(list)
(cons (car r) (unfold f (cdr r))))))
And a tail recursive form using named let
(define (unfold f init)
(let loop ((acc empty)
(state (f init)))
(if (empty? state)
(reverse acc)
(loop (cons (car state) acc)
(f (cdr state))))))
And using match.
(define (unfold f init)
(let loop ((acc empty)
(state (f init)))
(match state
((cons x next)
(loop (cons x acc)
(f next)))
(empty
(reverse acc)))))
Related
How does the map function implemented in racket and why, recursion or iteration.
Maybe some implementation example
How to implement map
The map function walks a list (or multiple lists), and applies a given function to every value of a list. For example mappiing add1 to a list results in:
> (map add1 '(1 2 3 4))
'(2 3 4 5)
As such, you can implement map as a recursive function:
(define (map func lst)
(if (empty? lst)
'()
(cons (func (first lst)) (map func (rest lst)))))
Of course, map can accept any number of arguments, with each element passed to the given prop. For example, you can zip two lists together using map list:
> (map list '(1 2 3) '(a b c))
'((1 a) (2 b) (3 c))
To implement this variable arity map, we need to make use of the apply function:
(define (map proc lst . lst*)
(if (empty? lst)
'()
(cons (apply proc (first lst) (map first lst*))
(apply map proc (rest lst) (map rest lst*)))))
Now, this does assume all of the given lists have the same length, otherwise you will get some unexpected behavior. To do that right you would want to run empty? on all lists, not just the first one. But...when you use it, you get:
> (map list '(a b c) '(1 2 3))
'((a 1) (b 2) (c 3))
Note that map here calls itself recursively 3 times. A faster implementation might do some unrolling to run faster. A better implementation would also do proper error checking, which I have elided for this example.
How Racket's map is implemented
If you open up DrRacket (using the latest Racket 7 nightly) and make the following file:
#lang racket
map
You can now right click on map and select Open Defining File. From here, you can see that map is renamed from the definition map2. The definition of which is:
(define map2
(let ([map
(case-lambda
[(f l)
(if (or-unsafe (and (procedure? f)
(procedure-arity-includes? f 1)
(list? l)))
(let loop ([l l])
(cond
[(null? l) null]
[else
(let ([r (cdr l)]) ; so `l` is not necessarily retained during `f`
(cons (f (car l)) (loop r)))]))
(gen-map f (list l)))]
[(f l1 l2)
(if (or-unsafe
(and (procedure? f)
(procedure-arity-includes? f 2)
(list? l1)
(list? l2)
(= (length l1) (length l2))))
(let loop ([l1 l1] [l2 l2])
(cond
[(null? l1) null]
[else
(let ([r1 (cdr l1)]
[r2 (cdr l2)])
(cons (f (car l1) (car l2))
(loop r1 r2)))]))
(gen-map f (list l1 l2)))]
[(f l . args) (gen-map f (cons l args))])])
map))
Preface: I'm currently taking a condensed course that is apparently taught in LISP and I've never worked with LISP in my life so I had to learn the language over a weekend. I apologize in advance for the abysmal code. I'm just familiar enough with LISP's syntax to get the code working and not much more.
I'm currently working on a program that solves the map coloring problem. This code takes a sequence where the first element of each sub sequence is a state and the second element represents a color. ex: '((A R) (B G) (C G) (D Y) (E B) (F B)) and then checks to make sure that no state has the same color as a state it's constrained by (defined by the constraint list). I know there are probably a lot of cleaner and simpler ways to do this but what I'm currently struggling with is having my dolist loops immediately return the value T whenever the if statement is met. So far I've been unable to get the functions to simply return a value and had to resort to this really ugly/wrong method of setting a variable to true and waiting for the loop to finish in order to make the code work. I've tried using return and just having T inside the if statements but, in both cases, the loop would finish instead of returning a value and I have no idea why.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (f s)
(setf ans nil)
(dolist (state constraint)
(if (eq (first state) f)
(if (search (list s) (second state))
(setf ans T) ;;where I want it to just return T
)
)
)
ans
)
;;ex: ((A R) (B R) (C B) (D R) (E B) (F G))
(defun check_conflict (lst)
(setf anb nil)
(dolist (state lst)
(dolist (neighbor (remove state lst))
(if (check_constraint (first state) (first neighbor))
(if (eq (second state) (second neighbor))
(setf anb T)) ;;where I want it to just return T
)
)
)
anb
)
EDIT: I ended up just fixing this with recursion. The code is cleaner now but I'd still love to know what my issue was. This is the recursive code.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (lst f s)
(COND
((null lst) nil)
((search (list (car (car lst))) f)
(if (search s (second (car lst))) T))
(t (check_constraint (cdr lst) f s))
)
)
(defun check_neighbor (check lst)
(COND
((null lst) nil)
((check_constraint constraint (list (car check)) (list (first (first lst))))
(if (eq (second check) (second (car lst))) T))
(t (check_neighbor check (cdr lst)))
)
)
;;(check_state '((A R) (B R) (C B) (D R) (E B) (F G)))
(defun check_state (lst)
(COND
((null lst) nil)
((check_neighbor (car lst) (cdr lst)) T)
(t (check_state (cdr lst)))
)
)
First a few style issues. You should use DEFVAR or DEFPARAMETER to declare global variables. Those should also have asterisks around the name to show that they are global (or special actually).
(defparameter *constraint*
'((A (B C E))
(B (A E F))
(C (A E F))
(D (F))
(E (A B C F))
(F (B C D E))))
The lisp convention for naming things is to use dashes between words (CHECK-CONSTRAINT instead of CHECK_CONSTRAINT). You should also prefer full words for variable names instead of abbreviations (LIST instead of LST). The closing parentheses should not be written on their own line.
Then the actual problem. You can use RETURN to return a value from a block named NIL. Loops establish such a block, so you can write the first function like
(defun check-constraint (first second)
(dolist (state *constraint*)
(when (and (eq first (first state))
(member second (second state)))
(return t))))
It's better to use WHEN instead of IF when there's only a then-branch. I also combined the two IFs into one using AND. Since you were wrapping S in a list for using SEARCH, I figured you probably want to use MEMBER instead (although I'm not sure since I don't exactly know what the code is supposed to do). You can change that back if it's wrong.
You probably could also simplify it to
(defun check-constraint (first second)
(member second (second (find first *constraint* :key #'first))))
In the second function you have two loops. If you use RETURN to return from the inner one, you just end up continuing the outer loop and ignoring the return value. So you have to use RETURN-FROM to return from the function instead of the inner loop.
(defun check-conflict (list)
(dolist (state list)
(dolist (neighbor (remove state list))
(when (and (check-constraint (first state) (first neighbor))
(eq (second state) (second neighbor)))
(return-from check-conflict t)))))
What's wrong with this code?
(defun f (l)
(funcall #'(lambda (ff)
(cond
((null l)nil)
((listp (car l)) (append ff (f (cdr l)) (car ff)))
(t (list (car l)))))
(f (car l))))
If I enter (f '(( 1 2 3))) it gives me an error:
"Cannot take car of 1".
What's wrong?
Here is a more detailed explanation of the comment of #Sylwester, that answers correctly to the question.
If you write (f '((1 2 3)) then the function f is called, l is bound to ((1 2 3)), and the result is the application of the internal function (lambda (ff) (cond ...)) to the value of (f (car l)).
To perform this application, first (f (car l)) is evaluated to produce a value, and since l is bound to ((1 2 3)), its car is (1 2 3).
So, f is applied to the list (1 2 3), which is bound to l in the recursive call. This evaluation again means that fshould apply the internal function (lambda (ff) (cond ...)) to the value of (f (car l)), that is to (f 1).
The process is reapeated, l is bound this time to 1, and again fshould apply the internal function (lambda (ff) (cond ...)) to the value of (f (car l)), but, since l is now 1, the function tries to evaluate the (car 1), which produces the error that you have found.
Can anyone help me with this please?
(define f (lambda (x)
(cond
((null? x) 0)
(#t (+ (* (car x) (car x)) (f (cdr x)))))))
I couldn't understand if this function is tail recursive or not?
If it is, what is the reason?
It's not tail recursive because the last thing the function does before returning is to evaluate (+ ...). In order to be tail recursive the last operation before returning has to be the recursive call.
Making a function tail recursive usually involves a helper function which takes an accumulator parameter:
(define f0 (lambda (x acc)
(if (null? x)
acc
(f0 (cdr x) (+ acc (* (car x)(car x)))))))
(define f (lambda (x)
(f0 x 0)))
Please, help me with one simple exercise on the Scheme.
Write function, that return count of atoms on the each level in the
list. For example:
(a (b (c (d e (f) k 1 5) e))) –> ((1 1) (2 1) (3 2) (4 5) (5 1))
My Solution:
(define (atom? x)
(and (not (pair? x)) (not (null? x))))
(define (count L)
(cond ((null? L) 0)
((pair? (car L))
(count (cdr L)))
(else
(+ 1 (count (cdr L))))))
(define (fun L level)
(cons
(list level (count L))
(ololo L level)))
(define (ololo L level)
(if (null? L)
'()
(if (atom? (car L))
(ololo (cdr L) level)
(fun (car L) (+ level 1)))))
(fun '(a (b (c (d e (f) k 1 5) e))) 1)
It's work fine, but give not correctly answer for this list:
(a (b (c (d e (f) (k) 1 5) e)))
is:
((1 1) (2 1) (3 2) (4 4) (5 1))
But we assume that 'f' and 'k' on the one level, and answer must be:
((1 1) (2 1) (3 2) (4 4) (5 2))
How should I edit the code to make it work right?
UPD (29.10.12):
My final solution:
(define A '(a (b (c (d e (f) k 1 5) e))))
(define (atom? x)
(and (not (pair? x)) (not (null? x))))
(define (unite L res)
(if (null? L) (reverse res)
(unite (cdr L) (cons (car L) res))))
(define (count-atoms L answ)
(cond ((null? L) answ)
((pair? (car L))
(count-atoms (cdr L) answ))
(else
(count-atoms (cdr L) (+ answ 1)))))
(define (del-atoms L answ)
(cond ((null? L) answ)
((list? (car L))
(begin
(del-atoms (cdr L) (unite (car L) answ))))
(else
(del-atoms (cdr L) answ))))
(define (count L)
(define (countme L level answ)
(if (null? L) (reverse answ)
(countme (del-atoms L '()) (+ level 1) (cons (cons level (cons (count-atoms L 0) '())) answ))))
(countme L 1 '()))
(count A)
What can you say about this?
Do you know what you get if you run this?
(fun '(a (b (c (d e (f) k 1 5) e)) (a (b (c)))) 1)
You get this:
((1 1) (2 1) (3 2) (4 5) (5 1))
The whole extra nested structure that I added on the right has been ignored. Here is why...
Each recursion of your function does two things:
Count all the atoms at the current "level"
Move down the level till you find an s-expression that is a pair (well, not an atom)
Once it finds a nested pair, it calls itself on that. And so on
What happens in oLoLo when fun returns from the first nested pair? Why, it returns! It does not keep going down the list to find another.
Your function will never find more than the first list at any level. And if it did, what would you to do add the count from the first list at that level to the second? You need to think carefully about how you recur completely through a list containing multiple nested lists and about how you could preserve information at each level. There's more than one way to do it, but you haven't hit on any of them yet.
Note that depending on your implementation, the library used here may need to be imported in some other way. It might be painstakingly difficult to find the way it has to be imported and what are the exact names of the functions you want to use. Some would have it as filter and reduce-left instead. require-extension may or may not be Guile-specific, I don't really know.
(require-extension (srfi 1))
(define (count-atoms source-list)
(define (%atom? x) (not (or (pair? x) (null? x))))
(define (%count-atoms source-list level)
(if (not (null? source-list))
(cons (list level (count %atom? source-list))
(%count-atoms (reduce append '()
(filter-map
(lambda (x) (if (%atom? x) '() x))
source-list)) (1+ level))) '()))
(%count-atoms source-list 1))
And, of course, as I mentioned before, it would be best to do this with hash-tables. Doing it with lists may have some didactic effect. But I have a very strong opposition to didactic effects that make you write essentially bad code.