This seems straightforward, but I can't seem to find a solution. I want to replace an item within a list of a list with something, but if that item appears multiple times then you randomly replace one of them, but not both. I want to do this in ISL+.
I created the function flatten which appends all sublists :
(check-expect (flatten '((a b) (c) (d e f g) (h i j)))
(list 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j))
(define (flatten lol)
(foldr append empty lol))
I also made rewrite, which replaces the value at index n with whatever you choose
(check-expect (rewrite '(x x x - x x x x) 3 'x)
(list 'x 'x 'x 'x 'x 'x 'x 'x))
(define (rewrite ls n val)
(cond
[(empty? ls) (error "error")]
[(= n 0) (cons val (rest ls))]
[else (cons (first ls) (rewrite (rest ls) (sub1 n) val))]))
The problem is I don't know how to apply this to a list of list and I also don't know how to randomly replace one of items if it occurs more than once. This is what I have for the final product, but it's probably not the way to go:
(define (fullreplace b)
(local [
;makes a list of nested lists of each index the element occurs
;problem is that it makes a list of nested lists so I can't use flatten either
(define (position ls ele n)
(cond [(empty? ls) 0]
[(equal? ele (first ls)) (list n (position (rest ls) ele (add1 n))) ]
[else (position (rest ls) ele (+ 1 n))]))]
;lol-full? checks if the item occurs in the list of lists at all
(if (lol-full? b) b (rewrite (flatten b)
(position (flatten b) '- 0)
"item replaced"))))
;just used for testing
(define lol2 (list
(list 2 2 2 2)
(list 4 '- 4 '-)
(list '- 8 8 8)
(list 16 '- '- 16)))
(fullreplace lol2) may return this or where any of the other '- are located:
(list
(list 2 2 2 2)
(list 4 '- 4 2)
(list '- 8 8 8)
(list 16 '- '- 16))
I've been working on this awhile so any new insight would go a long way. Thank you
The "random" part is what makes this problem pathological. If you could just replace the first occurrence, it would be easy. But to replace a random occurence, you must first know how many occurrences there are. So before you go replacing stuff, you have to go a-counting:
(define (count/recursive val tree)
(cond ((equal? val tree)
1)
(else (foldl (λ (next-value total)
(cond ((equal? val next-value)
(add1 total))
((list? next-value)
(+ total (count/recursive val next-value)))
(else total))) 0 tree))))
Then you need a function that can replace the nth occurrence of a value:
(define (replace/recursive val replace-with n tree)
(cond ((equal? val tree)
replace-with)
(else
(cdr
(foldl (λ (next-value total/output-tree)
(local ((define total (car total/output-tree))
(define output-tree (cdr total/output-tree)))
(cond ((equal? next-value val)
(cons (add1 total)
(cons (if (= total n) replace-with next-value) output-tree)))
((list? next-value)
(cons (+ total (count/recursive val next-value))
(cons (replace/recursive val replace-with (- n total) next-value)
output-tree)))
(else (cons total (cons next-value output-tree)))))) (cons 0 empty) tree)))))
Finally, you use random to pick the instance you will replace, using count/recursive to limit how high of a number random picks:
(define original '((x x (x y x) a b (((c x z x) x) y x x))))
(replace/recursive 'x '- (random (count/recursive 'x original)) original)
How to replace all occurences of a value with another value:
(define (replace-all needle new-value haystack)
(cond ((equal? needle haystack) new-value)
((pair? haystack)
(cons (replace-all needle new-value (car haystack))
(replace-all needle new-value (cdr haystack))))
(else haystack)))
The only thing to change is to check if the first part constituted a change. If it did you don't do the replace on the other half. Use equal? to compare structure.
It's not random. It will replace the first occurence it finds either by doing car before cdr or cdr before car.
Related
I'm trying to write a function in Scheme that returns the first n elements in a list. I'm want to do that without loops, just with this basic structure below.
What I've tried is:
(define n-first
(lambda (lst n)
(if (or(empty? lst) (= n 0))
(list)
(append (car lst) (n-first (cdr lst) (- n 1))))))
But I'm getting an error:
append: contract violation
expected: list?
given: 'in
I've tried to debug it and it looks that the tail of the recursion crashes it, meaning, just after returning the empty list the program crashes.
When replacing "append" operator with "list" I get:
Input: (n-first '(the cat in the hat) 3)
Output:
'(the (cat (in ())))
But I want to get an appended list.
A list that looks like (1 2 3) i constructed like (1 . (2 . (3 . ()))) or if you're more familiar with cons (cons 1 (cons 2 (cons 3 '()))). Thus (list 1 2 3)) does exactly that under the hood. This is crucial information in order to be good at procedures that works on them. Notice that the first cons cannot be applied before the (cons 2 (cons 3 '())) is finished so a list is always created from end to beginning. Also a list is iterated from beginning to end.
So you want:
(define lst '(1 2 3 4 5))
(n-first lst 0) ; == '()
(n-first lst 1) ; == (cons (car lst) (n-first (- 1 1) (cdr lst)))
(n-first lst 2) ; == (cons (car lst) (n-first (- 2 1) (cdr lst)))
append works like this:
(define (append lst1 lst2)
(if (null? lst1)
lst2
(cons (car lst1)
(append (cdr lst1) lst2))))
append is O(n) time complexity so if you use that each iteration of n parts of a list then you get O(n^2). For small lists you won't notice it but even a medium sized lists of a hundred thousand elements you'll notice append uses about 50 times longer to complete than the cons one and for large lists you don't want to wait for the result since it grows exponentially.
try so
(define first-n
(lambda (l)
(lambda (n)
((lambda (s)
(s s l n (lambda (x) x)))
(lambda (s l n k)
(if (or (zero? n)
(null? l))
(k '())
(s s (cdr l) (- n 1)
(lambda (rest)
(k (cons (car l) rest))))))))))
(display ((first-n '(a b c d e f)) 4))
(display ((first-n '(a b)) 4))
In scheme you must compute mentally the types of each expression, as it does not have a type checker/ type inference included.
I am encountering a issue that I need to add up the second number of each list. For example, suppose I have a list of lists like below,
(list (list -4
(list (list -1 4) (list 1 7)))
(list 1 (list (list -2 5) (list 3 3)))
(list 3 12))
Then my job is to add up 4 + 7 + 5 + 3 + 12 = 31. However, the list can have multiple sub lists. But the second item inside a list can either be a number or a list. If it is a list, then we need to dig deeper into this list until we get a number.
Thanks!
Solution
(define (atom? x)
(and (not (null? x))
(not (pair? x))))
(define (my-and x y)
(and x y))
(define (every? l)
(foldr my-and #t l))
(define (flat-list? l)
(cond ((null? l) #t)
((every? (map atom? l)) #t)
(else #f)))
(define (add-only-seconds l)
(define (l-sec-add l acc)
(cond ((null? l) acc)
((atom? l) acc)
((flat-list? l) (+ (second l) acc))
((list? l) (apply + acc (map (lambda (x) (l-sec-add x 0)) l)))))
(l-sec-add l 0))
Example test
(define example-list (list (list -4
(list (list -1 4) (list 1 7)))
(list 1 (list (list -2 5) (list 3 3)))
(list 3 12)))
(add-only-seconds example-list) ;; 31
I used common-lisp-typical functions atom? and every?.
Since and cannot be used in foldr, I defined my-add to make add a function which can be used infoldr`.
I'm trying to use direct recursion to sort a list into a list of sublists of even and odd positions.
So (split '(1 2 3 4 5 6)) returns ((1 3 5) (2 4 6))
and (split '(a 2 b 3)) returns ((a b) (2 3))
So far, I have the following code:
(define split
(lambda (ls)
(if (or (null? ls) (null? (cdr ls)))
(values ls '())
(call-with-values
(lambda () (split (cddr ls)))
(lambda (odds evens)
(values (cons (car ls) odds)
(cons (cadr ls) evens)))))))
However, now I'm stumped on how to store multiple outputs into a single list.
I know that calling it like this:
(call-with-values (lambda () (split '(a b c d e f))) list)
returns a list of sublists, however I would like the function itself to return a list of sublists. Is there a better way to do this that doesn't involve the use of values and call-with-values?
Sure. Here's an adapted version of your code:
(define (split ls)
(if (or (null? ls) (null? (cdr ls)))
(list ls '())
(let ((next (split (cddr ls))))
(list (cons (car ls) (car next))
(cons (cadr ls) (cadr next))))))
One thing that I like about the code in the question is that it uses odds and evens in a way that reflects the specification.
The objectives of this solution are:
Readability.
To reflect the language of the specification in the code.
To use O(n) space during execution.
It uses an internal function with accumulators and a trampoline.
#lang racket
;; List(Any) -> List(List(Any) List(Any))
(define (split list-of-x)
(define end-of-list (length list-of-x))
;; List(Any) List(Any) List(Any) Integer -> List(List(Any) List(Any))
(define (looper working-list odds evens index)
(cond [(> index end-of-list)
(list (reverse odds)
(reverse evens))]
[(odd? index)
(looper (rest working-list)
(cons (car working-list) odds)
evens
(add1 index))]
[(even? index)
(looper (rest working-list)
odds
(cons (car working-list) evens)
(add1 index))]
[else
(error "split: unhandled index condition")]))
(looper list-of-x null null 1))
Here's an answer that should be clear if you are familiar with match syntax. It is identical in form and function to Chris Jester-Young's answer, but uses match to clarify list manipulation.
#lang racket
(define (split ls)
(match ls
[`(,first ,second ,rest ...)
(match (split rest)
[`(,evens ,odds) (list (cons first evens)
(cons second odds))])]
[_ (list ls '())]))
(: split ((list-of natural) -> (list-of (list-of natural))))
(define split
(lambda (xs)
(list (filter even? xs) (filter odd? xs))))
(: filter ((%a -> boolean) (list-of %a) -> (list-of %a)))
(define filter
(lambda (p xs)
(fold empty (lambda (first result)
(if (p first)
(make-pair first result)
result)) xs)))
(check-expect (split (list 1 2 3 4 5 6)) (list (list 2 4 6) (list 1 3 5)))
i think this one is also really easy to understand..
I have found a recursive problem in one page that says the following:
If a person enter a string with two consecutive letters that are the same, it should put a 5 between them. For example if I enter "hello"
it should print "hel5lo"
I have done the following program in Scheme:
(define (function listT)
(if (empty? listT)
'()
(begin
(if (eq? (car listT) (car (cdr listT)))
(display 5)
(display (car listT))
)))
(function (cdr listT)))
and tested with:
(function'( 'h 'e 'l 'l 'o))
and the problem I got is
car: contract violation
expected: pair?
given: ()
I suppose that is because at one moment (car (cdr listT)) will face an empty list, have tried with a conditional before, but still with some issues.
Is it possible to do it only using recursion over the list of characters with cdr and car? I mean not with new variables, strings, using reverse or loops?
Any help?
Thanks
This happens when there is only one character left in the list; (cdr listT) will be the empty list '() and the car of the empty list is undefined.
So you either need to check that the cdr isn't empty, for example:
(define (f str)
(let loop ((lst (string->list str)) (res '()))
(if (null? lst)
(list->string (reverse res))
(let ((c (car lst)))
(loop (cdr lst)
(cons c
(if (and (not (null? res)) (char=? c (car res)))
(cons #\5 res)
res)))))))
or, instead of looking one character ahead, turn around your logic and keep track of the last character, which is initialised to some value that will be different in every case (not as elegant as the first solution though IMO):
(define (f str)
(list->string
(let loop ((prev #f) (lst (string->list str)))
(if (null? lst)
'()
(let ((c (car lst)))
(if (equal? c prev)
(cons #\5 (cons c (loop c (cdr lst))))
(cons c (loop c (cdr lst)))))))))
[EDIT alternatively, with an explicit inner procedure:
(define (f str)
(define (inner prev lst)
(if (null? lst)
'()
(let ((c (car lst)))
(if (equal? c prev)
(cons #\5 (cons c (inner c (cdr lst))))
(cons c (inner c (cdr lst)))))))
(list->string (inner #f (string->list str))))
]
Testing:
> (f "hello")
"hel5lo"
> (f "helo")
"helo"
> (f "heloo")
"helo5o"
Side note: don't double quote:
> '('h 'e 'l 'l 'o)
'('h 'e 'l 'l 'o)
> (car '('h 'e 'l 'l 'o))
''h
This is probably not what you expected. Instead:
> '(h e l l o)
'(h e l l o)
> (car '(h e l l o))
'h
or
> (list 'h 'e 'l 'l 'o)
'(h e l l o)
> (car (list 'h 'e 'l 'l 'o))
'h
Also note that these are symbols, whereas, since you start from a string, you want characters:
> (string->list "hello")
'(#\h #\e #\l #\l #\o)
EDIT 2
I see you are still struggling with my answer. Here's a solution that should be as minimal as you requested, I hope this is it:
(define (f lst (prev #f))
(unless (null? lst)
(when (equal? (car lst) prev) (display "5"))
(display (car lst))
(f (cdr lst) (car lst))))
or even
(define (f lst)
(unless (null? lst)
(display (car lst))
(when (and (not (null? (cdr lst))) (equal? (car lst) (cadr lst)))
(display "5"))
(f (cdr lst))))
Testing:
> (f '(h e l l o))
hel5lo
> (f '(h e l o))
helo
> (f '(h e l o o))
helo5o
I have found a solution:
(define (func lisT)
(if (empty? (cdr lisT))
(display (car lisT))
(begin
(if (eq? (car lisT) (car (cdr lisT)))
(begin
(display (car lisT))
(display 5)
)
(display (car lisT))
)
(func (cdr lisT))
)
))
Here's a solution including just one, top-level recursive function:
(define (insert list item)
(if (< (length list) 2) ;; not enough elements to compare?
list ;; then just return the input
(let ((first (car list)) ;; capture the first element,
(second (cadr list)) ;; the second element,
(rest (insert (cdr list) item))) ;; and the recursively processed tail
(cons first ;; construct a list with the first element
(if (eq? first second) ;; compare the first two and return either
(cons item rest) ;; the item before the rest
rest))))) ;; or just the rest
It takes as input a list and an item to be inserted between each two consecutive identical elements. It does not display anything, but rather returns another list with the result of the insertion. For example,
(insert '(1 2 2 3 3 3 2 2 1) 0)
results in
(1 2 0 2 3 0 3 0 3 2 0 2 1)
This hopefully solves your problem and seeds further experimentation.
Here is a straightforward function from a list to a list:
(define (add5s s)
(cond ((null? s) s)
((null? (cdr s)) s)
((equal? (car s) (cadr s)) (cons (car s) (cons 5 (add5s (cdr s)))))
(else (cons (car s) (add5s (cdr s))))
)
)
A list either:
is null
has one element
begins with two equal elements
begins with two unequal elements
A list with a 5 put between consecutive equal elements is respectively:
the list
the list
the first element followed by a 5 followed by the rest of it with a 5 put between consecutive equal elements
the first element followed by the rest of it with a 5 put between consecutive equal elements
A Scheme string is not a list of characters or a list of symbols. If you want to input and output strings then you should use the corresponding string operators. Or write a function that defines this one, calls it with string->list of an input string and outputs list->string of this one's result list. Or a function like this one but that branches on string->list of its input string and outputs list->string of what this one returns.
(It is really not clear what code is to be written. You say "enters a string", but your "tested" code is a function that takes a list as argument, rather than reading from a port. And you say "put a 5" but you print argument list elements or a 5 via display to a port, rather than returning a value of the type of the argument. And you give an example passing an argument that is a list of quoted symbols rather than just symbols let alone characters. (If you want to pass a list of symbols then use '(h e l l o) or (list 'h 'e 'l 'l 'o).) Say exactly what is to be produced, eg, a function with what arguments, return value and effect on ports.)
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.