I am trying to sort a (listof (listof Str Str)) using insertion sort, but I don't know how to proceed from here. Firstly, it has to alphabetically sort by the first strings, then alphabetically by the second string.
For example:
(list (list "produce" "apple")
(list "seed" "rice")
(list "dairy" "milk" )
(list "seed" "pinto")
(list "produce" "potato")
(list "chips" "potato")
(list "seed" "wheat")
(list "produce" "banana")
(list "dairy" "cheese")
(list "chips" "banana")
(list "produce" "peach")
(list "seed" "lentil")
(list "produce" "corn")
(list "seed" "corn")) becomes
`(list (list "chips" "banana") (list "chips" "potato") (list "dairy" "cheese") (list "dairy" "kefir") (list "dairy" "milk")` (list "chips" "potato") (list "dairy" "cheese") (list "dairy" "kefir") (list "dairy" "milk") (list "produce" "apple") (list "produce" "banana" (list "produce" "corn")(list "produce" "peach")(list "produce" "potato")(list "seed" "corn")(list "seed" "lentil")(list "seed" "pinto"))
May I know what is the approach after I wrote the code that sorts the input list of lists by the first string? After sorting by the first string, the list looks like this:
(list ("chips" "potato") (list "chips" "banana") (list "dairy" "milk")(list "dairy" "cheese")(list "dairy" "kefir")(list "produce" "apple")(list "produce" "potato") (list "produce" "banana")(list "produce" "peach")(list "produce" "corn")(list "seed" "rice")(list "seed" "pinto")(list "seed" "wheat")(list "seed" "lentil")(list "seed" "corn"))
How can I sort the list by the second string? Greatly appreciated!
You can use sort function together with string-append
(define (sort-items lst)
(sort lst string<? #:key
(lambda (n)
(string-append (car n) (cadr n)))))
#Lahiru answer is great.
I show another version.
#lang racket
(define lst
'(("a" "a")
("b" "a")
("c" "z")
("c" "a")
("b" "z")
("d" "a")
("a" "z")
("d" "z")))
(define (sort-items-index lst)
(local [(define index-lst
(map (λ (s) (string-length (first s))) lst))
(define (combile-2-str s)
(string-append (first s) (second s)))
(define (spilt-str-by-index s n)
(list (substring s 0 n) (substring s n (string-length s))))]
(map spilt-str-by-index
(sort (map combile-2-str lst) string<?)
index-lst)))
(sort-items-index lst)
(define (sort-items-v2 lst)
(sort lst (λ (s1 s2)
(string<?
(string-append (first s1) (second s1))
(string-append (first s2) (second s2))))))
(sort-items-v2 lst)
Related
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`.
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.
(define mylist (list (list 'a (list 'b 'c)) (list 'b (list 'a 'd))
(list 'c (list 'a 'd)) (list 'd (list 'c 'b 'a))))
(define (total1 L)
(+ (length (cdr (car L))) (total1 (cdr L))))
My aim is count lengths of sublists and sum this values.
length (('b 'c) + ('a 'd) + ('a 'd) + ('c 'b 'a))
So my function should return 9. But when I call this function, I get this error:
car: contract violation
expected: pair?
given: ()
What I should do?
To solve the error, you should introduce a test to check if you are at the end of your list. Like this:
(define (total L)
(if (null? L)
0 ;has to be 0 because it will be +'ed in the recursion
(+ (length (cdr (car L))) ;should be (car (cdr (car L))) or (cadar L)
(total (cdr L)))))
This code still gives a wrong result though, because the (cdr (car L)) returns ((b c))for the first sublist and the length of this is 1, because is it a list with 1 element, the list (b c). What you want is the (car (cdr (car L)))
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.