I tried making a mutable function with intersect, but I think I'm severely messing it up with how I implemented intersect into the function and I'm not sure about the best way to fix the function.
(define (intersect-mutable)
(let ((lst '()))
(let ((lst2 '()))
(define (insert x)
(set! lst (cons x lst)))
(define (intersect)
(define (helper lst lst2)
(define contains member)
(cond ((null? set) '())
((contains (car lst) lst2)
(cons (car lst) (intersect (cdr lst) lst)))
(else
(intersect (cdr lst) lst2))))
(helper lst lst2))
(lambda (function)
(cond ((eq? function 'intersect) intersect)
((eq? function 'insert) insert)
(else
'undefined))))))
A test case for the recursive function would be:
>(intersection '(2 4 7 10) '(2 9 0 10))
(2 10)
>(intersection '(1 4 10) '(83 1 48 2 4))
(1 4)
Test cases for insert:
(define mut (intersect-mutable))
((mut 'insert) 'intersect)
((mut 'insert) 'mutable)
To clarify, I'm trying to intersect two separate lists into one list. I added an insert function.
Use list->mlist in order to convert a list of immutable cons cells into a list of mutable cons (mcons cells).
See more here: docs
If the mutation is only to housekeep the two lists:
(define (intersect-mutable (lst1 '()) (lst2 '()))
(define (method-insert lst1? value)
(if lst1?
(set! lst1 (cons value lst1))
(set! lst2 (cons value lst2)))
message-handler)
(define (method-intersect)
;; intersect is a working intersect without mutation
(intersect lst1 lst2))
(define (message-handler msg)
(case msg
((insert) method-insert)
((insert1) (lambda (v) (method-insert #t v)))
((insert2) (lambda (v) (method-insert #f v)))
((lst1) lst1)
((lst2) lst2)
((intersect) method-intersect)
(else (error "No such method" msg))))
message-handler)
(define obj (intersect-mutable '(10) '(30)))
((obj 'insert) #t 5)
((obj 'insert2) 10)
(obj 'lst1) ; ==> (5 10)
(obj 'lst2) ; ==> (10 30)
((obj 'intersect)) ; ==> (10)
However notice that intersect doesn't really mutate anything. I think perhaps the whole point with this is OO so I imagine we can make operate on one list like this:
(define (list-object (lst '()))
(define (method-insert . values)
(set! lst (foldl cons lst values))
message-handler)
(define (method-intersect lst2)
;; intersect is a working intersect without mutation
(set! lst (intersect lst lst2))
message-handler)
(define (method-member? value)
(member value lst))
(define (message-handler msg)
(case msg
((insert) method-insert)
((intersect) method-intersect)
((member?) method-member?)
((lst) lst)
(else (error "No such method" msg))))
message-handler)
(define obj (((list-object '(5)) 'insert) 10 20 30))
(obj 'lst) ; ==> (30 20 10 5)
((obj 'intersect) '(10 30 60))
(obj 'lst) ; ==> (20 30)
Imagine you make many objects like this, then you can make (tiny)CLOS type generic methods:
;; generic. Works on any object that has
;; member? method and lists
(define (member? value obj)
(if (procedure? obj)
((obj 'member?) value)
(member value obj)))
;; Another object type that has member?
;; only that it means the values binary bits
;; are set on the object
(define (number-object value)
(define (method-member? value2)
(= value2 (bitwise-and value value2)))
(define (message-handler msg)
(case msg
((member?) method-member?)))
message-handler)
;; test objects
(define num1 (number-object 24))
(define lst1 (list-object '(1 8)))
;; some test
(member? 2 num1); ==> #f
(member? 8 num1); ==> #t
(member? 8 lst1); ==> (8) (true)
(member? 9 lst1); ==> #f
(member? 9 '(1 3 5 9 10)) ; ==> (9 10)
;; map is the ultimate test
(map (lambda (o) (member? 8 o)) (list num1 lst1))
; ==> (#t (8))
Related
I need to check if a given list of numbers(all of them) are divisible by 4
(divisible4 '(4,12,20))
#t
(divisible4 '(12 5 13))
#f
I have written this but it does not return #f. How can i fix this
(define (div2? list)
(if (= (modulo (car list) 4) 0)
#t
(div2? cdr list)))
A simple way would be to use built-ins, such as andmap that checks whether a condition holds for all elements in a list:
(define (divisible4 lst)
(andmap (lambda (e) (zero? (modulo e 4)))
lst))
We can do the same process by hand, albeit less elegantly:
(define (divisible4 lst)
(if (null? lst)
#t
(and (zero? (modulo (car lst) 4))
(divisible4 (cdr lst)))))
Equivalently:
(define (divisible4 lst)
(or (null? lst)
(and (zero? (modulo (car lst) 4))
(divisible4 (cdr lst)))))
Anyway, it works as expected:
(divisible4 '(4 12 20))
=> #t
(divisible4 '(12 5 13))
=> #f
Named let recursion may be more easy to understand:
(define (div4 L)
(let loop ((ll L)) ; set up recursion and initial value;
(cond
[(empty? ll) #t] ; if full list tested, return true;
[(not(= 0 (modulo (car ll) 4))) #f] ; if first item is not divisible, return false;
[else (loop (rest ll))] ; else goto rest of list;
)))
I need to write a scheme function that returns as a function which then takes another argument, eg a list and in turn return the desired result. In this example (c?r "arg") would return -- (car(cdr -- which then subsequently takes the list argument to return 2
> ((c?r "ar") '(1 2 3 4))
2
> ((c?r "ara") '((1 2) 3 4))
2
The problem I have is how can I return a function that accepts another arg in petite?
Here's how you might write such a function:
(define (c?r cmds)
(lambda (lst)
(let recur ((cmds (string->list cmds)))
(if (null? cmds)
lst
(case (car cmds)
((#\a) (car (recur (cdr cmds))))
((#\d) (cdr (recur (cdr cmds))))
(else (recur (cdr cmds))))))))
Note that I'm using d to signify cdr, not r (which makes no sense, to me). You can also write this more succinctly using string-fold-right (requires SRFI 13):
(define (c?r cmds)
(lambda (lst)
(string-fold-right (lambda (cmd x)
(case cmd
((#\a) (car x))
((#\d) (cdr x))
(else x)))
lst cmds)))
Just wanted to add my playing with this. Uses SRFI-1.
(import (rnrs)
(only (srfi :1) fold)) ;; require fold from SRFI-1
(define (c?r str)
(define ops (reverse (string->list str)))
(lambda (lst)
(fold (lambda (x acc)
((if (eq? x #\a) car cdr) ; choose car or cdr for application
acc))
lst
ops)))
Its very similar to Chris' version (more the previous fold-right) but I do the reverseso i can use fold in the returned procedure. I choose which of car or cdr to call by looking at the character.
EDIT
Here is an alternative version with much more preprocessing. It uses tail-ref and list-tail as shortcuts when there are runs of #\d's.
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (reverse
(if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs)))))
(lambda (lst)
(fold (lambda (fun lst)
(fun lst))
lst
funs))))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
This can be made even simpler in #!racket. we skip the reverse and just do (apply compose1 funs).
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs))))
(apply compose1 funs)))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
Assuming a compose procedure:
(define (compose funs . args)
(if (null? funs)
(apply values args)
(compose (cdr funs) (apply (car funs) args))))
(compose (list cdr car) '(1 2 3 4))
=> 2
c?r can be defined in terms of compose like so:
(define (c?r funs)
(lambda (e)
(compose
(map
(lambda (f) (if (char=? f #\a) car cdr))
(reverse (string->list funs)))
e)))
then
((c?r "ar") '(1 2 3 4))
=> 2
((c?r "ara") '((1 2) 3 4))
=> 2
how to implement this function
if get two list (a b c), (d e)
and return list (a+d b+d c+d a+e b+e c+e)
list element is all integer and result list's element order is free
I tried this like
(define (addlist L1 L2)
(define l1 (length L1))
(define l2 (length L2))
(let ((result '()))
(for ((i (in-range l1)))
(for ((j (in-range l2)))
(append result (list (+ (list-ref L1 i) (list-ref L2 j))))))))
but it return error because result is '()
I don't know how to solve this problem please help me
A data-transformational approach:
(a b c ...) (x y ...)
1. ==> ( ((a x) (b x) (c x) ...) ((a y) (b y) (c y) ...) ...)
2. ==> ( (a x) (b x) (c x) ... (a y) (b y) (c y) ... ...)
3. ==> ( (a+x) (b+x) ... )
(define (addlist L1 L2)
(map (lambda (r) (apply + r)) ; 3. sum the pairs up
(reduce append '() ; 2. concatenate the lists
(map (lambda (e2) ; 1. pair-up the elements
(map (lambda (e1)
(list e1 e2)) ; combine two elements with `list`
L1))
L2))))
testing (in MIT-Scheme):
(addlist '(1 2 3) '(10 20))
;Value 23: (11 12 13 21 22 23)
Can you simplify this so there's no separate step #3?
We can further separate out the different bits and pieces in play here, as
(define (bind L f) (join (map f L)))
(define (join L) (reduce append '() L))
(define yield list)
then,
(bind '(1 2 3) (lambda (x) (bind '(10 20) (lambda (y) (yield (+ x y))))))
;Value 13: (11 21 12 22 13 23)
(bind '(10 20) (lambda (x) (bind '(1 2 3) (lambda (y) (yield (+ x y))))))
;Value 14: (11 12 13 21 22 23)
Here you go:
(define (addlist L1 L2)
(for*/list ((i (in-list L1)) (j (in-list L2)))
(+ i j)))
> (addlist '(1 2 3) '(10 20))
'(11 21 12 22 13 23)
The trick is to use for/list (or for*/list in case of nested fors) , which will automatically do the append for you. Also, note that you can just iterate over the lists, no need to work with indexes.
To get the result "the other way round", invert L1 and L2:
(define (addlist L1 L2)
(for*/list ((i (in-list L2)) (j (in-list L1)))
(+ i j)))
> (addlist '(1 2 3) '(10 20))
'(11 12 13 21 22 23)
In scheme, it's not recommended using function like set! or append!.
because it cause data changed or Variable, not as Funcitonal Programming Style.
should like this:
(define (add-one-list val lst)
(if (null? lst) '()
(cons (list val (car lst)) (add-one-list val (cdr lst)))))
(define (add-list lst0 lst1)
(if (null? lst0) '()
(append (add-one-list (car lst0) lst1)
(add-list (cdr lst0) lst1))))
first understanding function add-one-list, it recursively call itself, and every time build val and fist element of lst to a list, and CONS/accumulate it as final answer.
add-list function just like add-one-list.
(define (addlist L1 L2)
(flatmap (lambda (x) (map (lambda (y) (+ x y)) L1)) L2))
(define (flatmap f L)
(if (null? L)
'()
(append (f (car L)) (flatmap f (cdr L)))))
1 ]=> (addlist '(1 2 3) '(10 20))
;Value 2: (11 12 13 21 22 23)
Going with Will and Procras on this one. If you're going to use scheme, might as well use idiomatic scheme.
Using for to build a list is a bit weird to me. (list comprehensions would fit better) For is usually used to induce sequential side effects. That and RSR5 does not define a for/list or for*/list.
Flatmap is a fairly common functional paradigm where you use append instead of cons to build a list to avoid nested and empty sublists
It doesn't work because functions like append don't mutate the containers. You could fix your problem with a mutating function like append!. Usually functions that mutate have a ! in their name like set! etc.
But it's possible to achieve that without doing mutation. You'd have to change your algorithm to send the result to your next iteration. Like this:
(let loop ((result '()))
(loop (append result '(1)))
As you can see, when loop will get called, result will be:
'()
'(1)
'(1 1)
'(1 1 1)
....
Following this logic you should be able to change your algorithm to use this method instead of for loop. You'll have to pass some more parameters to know when you have to exit and return result.
I'll try to add a more complete answer later today.
Here's an implementation of append! I just wrote:
(define (append! lst1 lst2)
(if (null? (cdr lst1))
(set-cdr! lst1 lst2)
(append! (cdr lst1) lst2)))
I'm trying to reverse a list, here's my code:
(define (reverse list)
(if (null? list)
list
(list (reverse (cdr list)) (car list))))
so if i enter (reverse '(1 2 3 4)), I want it to come out as (4 3 2 1), but right now it's not giving me that. What am I doing wrong and how can I fix it?
The natural way to recur over a list is not the best way to solve this problem. Using append, as suggested in the accepted answer pointed by #lancery, is not a good idea either - and anyway if you're learning your way in Scheme it's best if you try to implement the solution yourself, I'll show you what to do, but first a tip - don't use list as a parameter name, that's a built-in procedure and you'd be overwriting it. Use other name, say, lst.
It's simpler to reverse a list by means of a helper procedure that accumulates the result of consing each element at the head of the result, this will have the effect of reversing the list - incidentally, the helper procedure is tail-recursive. Here's the general idea, fill-in the blanks:
(define (reverse lst)
(<???> lst '())) ; call the helper procedure
(define (reverse-aux lst acc)
(if <???> ; if the list is empty
<???> ; return the accumulator
(reverse-aux <???> ; advance the recursion over the list
(cons <???> <???>)))) ; cons current element with accumulator
Of course, in real-life you wouldn't implement reverse from scratch, there's a built-in procedure for that.
Here is a recursive procedure that describes an iterative process (tail recursive) of reversing a list in Scheme
(define (reverse lst)
(define (go lst tail)
(if (null? lst) tail
(go (cdr lst) (cons (car lst) tail))))
(go lst ())))
Using substitution model for (reverse (list 1 2 3 4))
;; (reverse (list 1 2 3 4))
;; (go (list 1 2 3 4) ())
;; (go (list 2 3 4) (list 1))
;; (go (list 3 4) (list 2 1))
;; (go (list 4) (list 3 2 1))
;; (go () (list 4 3 2 1))
;; (list 4 3 2 1)
Here is a recursive procedure that describes a recursive process (not tail recursive) of reversing a list in Scheme
(define (reverse2 lst)
(if (null? lst) ()
(append (reverse2 (cdr lst)) (list (car lst)))))
(define (append l1 l2)
(if (null? l1) l2
(cons (car l1) (append (cdr l1) l2))))
Using substitution model for (reverse2 (list 1 2 3 4))
;; (reverse2 (list 1 2 3 4))
;; (append (reverse2 (list 2 3 4)) (list 1))
;; (append (append (reverse2 (list 3 4)) (list 2)) (list 1))
;; (append (append (append (reverse2 (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (append (reverse2 ()) (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (append () (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (list 4) (list 3)) (list 2)) (list 1))
;; (append (append (list 4 3) (list 2)) (list 1))
;; (append (list 4 3 2) (list 1))
;; (list 4 3 2 1)
Tail recursive approach using a named let:
(define (reverse lst)
(let loop ([lst lst] [lst-reversed '()])
(if (empty? lst)
lst-reversed
(loop (rest lst) (cons (first lst) lst-reversed)))))
This is basically the same approach as having a helper function with an accumulator argument as in Oscar's answer, where the loop binding after let makes the let into an inner function you can call.
Here's a solution using build-list procedure:
(define reverse
(lambda (l)
(let ((len (length l)))
(build-list len
(lambda (i)
(list-ref l (- len i 1)))))))
This one works but it is not a tail recursive procedure:
(define (rev lst)
(if (null? lst)
'()
(append (rev (cdr lst)) (car lst))))
Tail recursive solution:
(define (reverse oldlist)
(define (t-reverse oldlist newlist)
(if (null? oldlist)
newlist
(t-reverse (cdr oldlist) (cons (car oldlist) newest))))
(t-reverse oldlist '()))
Just left fold the list using cons:
(define (reverse list) (foldl cons null list))
This is also efficient because foldl is tail recursive and there is no need for append. This can also be done point-free (using curry from racket):
(define reverse (curry foldl cons null))
(define reverse?
(lambda (l)
(define reverse-aux?
(lambda (l col)
(cond
((null? l) (col ))
(else
(reverse-aux? (cdr l)
(lambda ()
(cons (car l) (col))))))))
(reverse-aux? l (lambda () (quote ())))))
(reverse? '(1 2 3 4) )
One more answer similar to Oscar's. I have just started learning scheme, so excuse me in case you find issues :).
There's actually no need for appending or filling the body with a bunch of lambdas.
(define (reverse items)
(if (null? items)
'()
(cons (reverse (cdr items)) (car items))))
I think it would be better to use append instead of cons
(define (myrev l)
(if (null? l)
'()
(append (myrev (cdr l)) (list (car l)))
)
)
this another version with tail recursion
(define (myrev2 l)
(define (loop l acc)
(if (null? l)
acc
(loop (cdr l) (append (list (car l)) acc ))
)
)
(loop l '())
)
In an application I'm working on in Racket I need to take a list of numbers and partition the list into sub-lists of consecutive numbers:
(In the actual application, I'll actually be partitioning pairs consisting of a number and some data, but the principle is the same.)
i.e. if my procedure is called chunkify then:
(chunkify '(1 2 3 5 6 7 9 10 11)) -> '((1 2 3) (5 6 7) (9 10 11))
(chunkify '(1 2 3)) -> '((1 2 3))
(chunkify '(1 3 4 5 7 9 10 11 13)) -> '((1) (3 4 5) (7) (9 10 11) (13))
(chunkify '(1)) -> '((1))
(chunkify '()) -> '(())
etc.
I've come up with the following in Racket:
#lang racket
(define (chunkify lst)
(call-with-values
(lambda ()
(for/fold ([chunk '()] [tail '()]) ([cell (reverse lst)])
(cond
[(empty? chunk) (values (cons cell chunk) tail)]
[(equal? (add1 cell) (first chunk)) (values (cons cell chunk) tail)]
[else (values (list cell) (cons chunk tail))])))
cons))
This works just fine, but I'm wondering given the expressiveness of Racket if there isn't a more straightforward simpler way of doing this, some way to get rid of the "call-with-values" and the need to reverse the list in the procedure etc., perhaps some way comepletely different.
My first attempt was based very loosely on a pattern with a collector in "The Little Schemer" and that was even less straightforward than the above:
(define (chunkify-list lst)
(define (lambda-to-chunkify-list chunk) (list chunk))
(let chunkify1 ([list-of-chunks '()]
[lst lst]
[collector lambda-to-chunkify-list])
(cond
[(empty? (rest lst)) (append list-of-chunks (collector (list (first lst))))]
[(equal? (add1 (first lst)) (second lst))
(chunkify1 list-of-chunks (rest lst)
(lambda (chunk) (collector (cons (first lst) chunk))))]
[else
(chunkify1 (append list-of-chunks
(collector (list (first lst)))) (rest lst) list)])))
What I'm looking for is something simple, concise and straightforward.
Here's how I'd do it:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else (chunkify/chunk (cdr lst) (list (car lst)))]))
;; chunkify/chunk : (listof number) (non-empty-listof number)
;; -> (listof (non-empty-listof number)
;; Continues chunkifying a list, given a partial chunk.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (chunkify/chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(chunkify/chunk (cdr lst)
(cons (car lst) rchunk))]
[else (cons (reverse rchunk) (chunkify lst))]))
It disagrees with your final test case, though:
(chunkify '()) -> '() ;; not '(()), as you have
I consider my answer more natural; if you really want the answer to be '(()), then I'd rename chunkify and write a wrapper that handles the empty case specially.
If you prefer to avoid the mutual recursion, you could make the auxiliary function return the leftover list as a second value instead of calling chunkify on it, like so:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else
(let-values ([(chunk tail) (get-chunk (cdr lst) (list (car lst)))])
(cons chunk (chunkify tail)))]))
;; get-chunk : (listof number) (non-empty-listof number)
;; -> (values (non-empty-listof number) (listof number))
;; Consumes a single chunk, returns chunk and unused tail.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (get-chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(get-chunk (cdr lst)
(cons (car lst) rchunk))]
[else (values (reverse rchunk) lst)]))
I can think of a simple, straightforward solution using a single procedure with only primitive list operations and tail recursion (no values, let-values, call-with-values) - and it's pretty efficient. It works with all of your test cases, at the cost of adding a couple of if expressions during initialization for handling the empty list case. It's up to you to decide if this is concise:
(define (chunkify lst)
(let ((lst (reverse lst))) ; it's easier if we reverse the input list first
(let loop ((lst (if (null? lst) '() (cdr lst))) ; list to chunkify
(cur (if (null? lst) '() (list (car lst)))) ; current sub-list
(acc '())) ; accumulated answer
(cond ((null? lst) ; is the input list empty?
(cons cur acc))
((= (add1 (car lst)) (car cur)) ; is this a consecutive number?
(loop (cdr lst) (cons (car lst) cur) acc))
(else ; time to create a new sub-list
(loop (cdr lst) (list (car lst)) (cons cur acc)))))))
Yet another way to do it.
#lang racket
(define (split-between pred xs)
(let loop ([xs xs]
[ys '()]
[xss '()])
(match xs
[(list) (reverse (cons (reverse ys) xss))]
[(list x) (reverse (cons (reverse (cons x ys)) xss))]
[(list x1 x2 more ...) (if (pred x1 x2)
(loop more (list x2) (cons (reverse (cons x1 ys)) xss))
(loop (cons x2 more) (cons x1 ys) xss))])))
(define (consecutive? x y)
(= (+ x 1) y))
(define (group-consecutives xs)
(split-between (λ (x y) (not (consecutive? x y)))
xs))
(group-consecutives '(1 2 3 5 6 7 9 10 11))
(group-consecutives '(1 2 3))
(group-consecutives '(1 3 4 5 7 9 10 11 13))
(group-consecutives '(1))
(group-consecutives '())
I want to play.
At the core this isn't really anything that's much different from what's
been offered but it does put it in terms of the for/fold loop. I've
grown to like the for loops as I think they make for much
more "viewable" (not necessarily readable) code. However, (IMO --
oops) during the early stages of getting comfortable with
racket/scheme I think it's best to stick to recursive expressions.
(define (chunkify lst)
(define-syntax-rule (consecutive? n chunk)
(= (add1 (car chunk)) n))
(if (null? lst)
'special-case:no-chunks
(reverse
(map reverse
(for/fold ([store `((,(car lst)))])
([n (cdr lst)])
(let*([chunk (car store)])
(cond
[(consecutive? n chunk)
(cons (cons n chunk) (cdr store))]
[else
(cons (list n) (cons chunk (cdr store)))])))))))
(for-each
(ƛ (lst)
(printf "input : ~s~n" lst)
(printf "output : ~s~n~n" (chunkify lst)))
'((1 2 3 5 6 7 9 10 11)
(1 2 3)
(1 3 4 5 7 9 10 11 13)
(1)
()))
Here's my version:
(define (chunkify lst)
(let loop ([lst lst] [last #f] [resint '()] [resall '()])
(if (empty? lst)
(append resall (list (reverse resint)))
(begin
(let ([ca (car lst)] [cd (cdr lst)])
(if (or (not last) (= last (sub1 ca)))
(loop cd ca (cons ca resint) resall)
(loop cd ca (list ca) (append resall (list (reverse resint))))))))))
It also works for the last test case.