Given a list L=(M,A1,A2,...,An). Find sublist if they exist L1=(Ai,Ai+1,...,Ai+k), i+k<=N, i>=1, for which M=Ai+Ai+1+...Ai+k
For example 1: L=(12 1 3 -16 5 7 8 2 2), M=12
Result: L=((1 3 -16)(5 7)(8 2 2))
for 1+3-16=12, 5+7=12, 8+2+2=12
Exemple L=(14 1 15 -1 14 5 6)
Result: L=((15 -1)(14))
for 1=14->no, 1+15=14->no, 1+15-1=14->no, 1+15-1+14=14->no, 1+15-1+14+5=14->no, 1+15-1+14+5+6=14->no
we move on to the next item 15=14->no, 15-1=14->YES! extract (15 -1)
we move on to the next item 14=14->YES! extract (14)
we move on to the next item 5=14->no, 5+6=14->no
Finish Result (15 -1) (14)
How resolve it in Lisp?
My code
(setq l '(6 1 2 3 6 14 3))
(setq comb nil)
(setq rez nil)
(defun sublist (lst)
(secondfunction (car lst) (cdr lst))
)
(defun pairnil (list1)
(mapcar #'(lambda (x) (cons x nil)) list1)
)
(defun pair (a list1)
(mapcar #'(lambda (x) (append x (list a))) list1)
)
(defun secondfunction (head other)
(run (cdr other) (cdr other) (pairnil other) (cdr(pairnil other)) (pairnil(car(pairnil other))))
(final comb head nil)
)
(defun final (lst el result)
(if (>(length lst) 0)
(progn
(if(eq(loop for x in (car lst) sum x) el) (final (cdr lst) el (append result (cons (car lst) nil)))
(if(>(length lst) 0)(final (cdr lst) el result )))
)
(setq rez result)
))
(final comb (car l) nil)
(defun run (lst1 ilst1 lst2 ilst2 temp)
(if (eq(car ilst1) nil) (setq comb lst2))
(when (>(length lst1)0)
(if (>(length ilst1)0) (run lst1 (cdr ilst1) (append lst2 (pair (car ilst1) temp)) ilst2 (append temp (pair (car ilst1) temp))))
(if (=(length ilst1)0) (run (cdr lst1) (cdr lst1) lst2 (cdr ilst2) (pairnil(car ilst2))))
))
(sublist l)
Result ((6) (1 2 3) (1 2 3) (3 3)), but this doesn't work correctly. In example I have explained how it should work.
A simple approach:
map over all sublists of list and append the results
map over all sublists of this reversed sublist and append the results
when the sum of the items is M then collect a list of the reverse sublist
Functions needed:
mapcon for mapping
reverse for reversing
reduce for summing
Solution:
(setq l '(6 1 2 3 4 5 6 7 -1))
(setq comb nil)
(setq rez nil)
(defun sublist (lst)
(secondfunction (car lst) (cdr lst))
)
(defun secondfunction (head other)
(run (cdr other) (cdr other) (list(car other)) (list(list(car other))))
(final comb head nil)
)
(defun final (lst el result)
(if (>(length lst) 0)
(progn
(if(eq(loop for x in (car lst) sum x) el) (final (cdr lst) el (append result (cons (car lst) nil)))
(if(>(length lst) 0)(final (cdr lst) el result )))
)
(setq rez result)
)
)
(final comb (car l) nil)
(defun run (lst1 lst2 temp r)
(if (not(eq(car lst1) nil))
(if (not(eq(car lst2) nil))
(run lst1 (cdr lst2) (append temp (list (car lst2))) (append r (list (append temp (list (car lst2))))))
(run (cdr lst1) (cdr lst1) (list(car lst1)) (append r (list(list (car lst1)))))
)
(setq comb r)
)
)
(sublist l)
Related
I need a function that will do this:
Odd Length list
Input '(1 2 3 4 5) = '(1 (2 (3) 4) 5)
Even length list
Input '(1 2 3 4) = '(1 (2 () 3) 4)
It needs to use very minimal built in functions. I have spent hours trying to figure this out and I am completely out of ideas at this point.
Here is what I have:
(define (listInList L)
(define length (listLength L))
(define L2 (listInListHelper length L '() '()))
(define L3 (listInListHelper (- length 2) L L2 '()))
L3
)
(define (listInListHelper N L NL)
(cond
((= N 0) '()
((= N 1) (cons (list (car L)) NL))
(else (cons (cons (car L) (list (lastItem L))) NL)
(remove 1 L)))
)
)
(define (lastItem L)
(if (null? (cdr L))(car L)
(lastItem (cdr L)))
)
(define (remove N L)
(cond ((eq? N 0) (cdr L))
(else (cons (car L) (remove (- N 1)(cdr L))))))
This would be one way to do it, you need to tell me if it's minimal enough:
(define (f lst)
(define (helper lst rlst half)
(cond
((= half 0 ) null)
((= half 1/2) (list (car lst)))
(else (list (car lst)
(helper (cdr lst) (cdr rlst) (sub1 half))
(car rlst)))))
(helper lst (reverse lst) (/ (length lst) 2)))
testing:
> (f '(1 2 3 4 5))
'(1 (2 (3) 4) 5)
> (f '(1 2 3 4))
'(1 (2 () 3) 4)
I'm new to Scheme and I'm trying to write a procedure which combines n list into a list of n-tuples. If the lists are of different size, the tuples should contain the empty list () when the corresponding list ran out of elements.
My current implementation is the following:
(define (comb list1 list2)
(cond [(empty? list1) empty]
[(empty? list2) empty]
[else (cons (list (first list1) (first list2))
(comb (rest list1) (rest list2)))]))
However, this program doesn't produce another tuple when there are no more items in the list to combine. For instance, (comb '(1 2 3 ) '(3 4)) produces only ((1 3) (2 4))
How do I solve it?
This is a bit tricky, and I believe it's not an appropriate exercise for someone who is just learning the basics of the language. Anyway, here's my proposed solution, in terms of higher-order procedures:
; helper procedure for filling a list with arbitrary values at the end
(define (fill lst val num)
(append lst
(build-list num (const val))))
; helper procedure for transposing a list of lists
(define (transpose lsts)
(apply map list lsts))
; main procedure
(define (list-tuples lsts)
(let* ((lengths (map length lsts)) ; obtain the length of each sublist
(max-length (apply max lengths))) ; find out the maximum length
(transpose ; build new sublists element-wise
(map (lambda (lst len) ; build sublists of the right length
(fill lst '() (- max-length len))) ; fill sublists with '()
lsts
lengths))))
The trick was to find the maximum length of the lists and then build new lists with that length, filling them with '() at the end. After that, it's a simple matter of building the answer by taking one element from each sublist. It works as expected:
(list-tuples '((m n o) (1) (x y)))
=> '((m 1 x) (n () y) (o () ()))
You need to specifically deal with the situation where one of the lists is empty. The following does what I think you want with two lists.
(define (comb l1 l2)
(cond
((empty? l1)
(cond
((empty? l2) '())
(else (cons (list '() (car l2)) (comb l1 (cdr l2))))))
(else
(cond
((empty? l2) (cons (list (car l1) '()) (comb (cdr l1) l2)))
(else (cons (list (car l1) (car l2)) (comb (cdr l1) (cdr l2))))))))
Let's split the problem into 2 parts.
First let's assume a procedure that will take a list, and return the following results:
a list containing the first items of each sublist
a list containing the remainder of each sublist
the number of non-empty lists encountered
An example implementation could be:
(define (split-tuples lst)
(let loop ((lst lst) (fst null) (rst null) (cnt 0))
(if (null? lst)
(values (reverse fst) (reverse rst) cnt)
(let ((c (car lst)))
(if (null? c)
(loop (cdr lst) (cons c fst) (cons c rst) cnt)
(loop (cdr lst) (cons (car c) fst) (cons (cdr c) rst) (add1 cnt)))))))
Testing:
> (split-tuples '((m n o) (1) (x y)))
'(m 1 x)
'((n o) () (y))
3
> (split-tuples '((n o) () (y)))
'(n () y)
'((o) () ())
2
> (split-tuples '((o) () ()))
'(o () ())
'(() () ())
1
> (split-tuples '(() () ()))
'(() () ())
'(() () ())
0
Now using this procedure we create the main procedure that will just loop until all sublists are empty:
(define (list-tuples lst)
(let loop ((lst lst) (res null))
(let-values (((fst rst cnt) (split-tuples lst)))
(if (zero? cnt)
(reverse res)
(loop rst (cons fst res))))))
Testing:
> (list-tuples '((m n o) (1) (x y)))
'((m 1 x) (n () y) (o () ()))
> (list-tuples '())
'()
This program takes a list where elements are repeated, e.g L = (a a a b b b c c c d), and output a list of items and number of repetition e.g ((a 3)(b 3)(c 3) d)
(define counter 0)
(define (compress liste)
(if (or (null? liste) (null? (cdr liste)))
liste
(let ((compressed-cdr (compress (cdr liste))))
(if (equal? (car liste) (car compressed-cdr))
((+ counter 1) compressed-cdr)
((cons (car liste) counter) (= counter 0) (compressed-cdr))))
))
However, I get this error:
Error: application: not a procedure; expected a procedure that can be applied to arguments
given: 1 arguments ...
The error is at the true predicate of the second if condition.
Building the result list in a top-down manner, with the "head-sentinel trick", for simplicity:
(define (rle lst)
(if (null? lst)
'()
(let ((res (list 1))) ; head sentinel
(let loop ((p res) ; result's last cons cell
(elt (car lst))
(cnt 1)
(lst (cdr lst)))
(if (and (not (null? lst))
(equal? elt (car lst)))
(loop p elt (+ cnt 1) (cdr lst))
(begin
(set-cdr! p (list (if (= 1 cnt) elt (list elt cnt))))
(if (null? lst)
(cdr res) ; skip the head in result, on return
(loop (cdr p) (car lst) 1 (cdr lst)))))))))
As #uselpa explained, this is called run-length encoding; for the uniformity of the result I'd suggest using (x 1) representation for non-repeating elements.
And the error "Error: application: not a procedure; expected a procedure", as others have said, means that the system expected to find a procedure but found something else, so can't apply it. Scheme expects to find a procedure as the first form in a list: (proc args ...), and tries to apply it to the arguments. But in your code it is not a procedure, but some other type of data.
If your Scheme has left fold, or reduce, you can run through it twice - first collecting the uniform results, and then applying your special format while reversing (left fold's results are usually built in reversed order):
(define (fold f init lst) ; if fold is not defined,
(reduce f init (cons init lst))) ; define it in terms of reduce
(define (rle lst)
(fold (lambda (x acc) ; NB! MIT-Scheme: (acc x)
(if (= 1 (cadr x)) (cons (car x) acc) (cons x acc)))
'()
(fold (lambda (x acc) ; NB! MIT-Scheme: (acc x)
(if (or (null? acc) (not (equal? (caar acc) x)))
(cons (list x 1) acc)
(cons (list x (+ (cadar acc) 1)) (cdr acc))))
'()
lst)))
As the error message says, the problem is located "at the true predicate of the second if condition":
((+ counter 1) compressed-cdr)
In this case, (+ counter 1) should evaluate to a procedure but it evaluates to a number. I think the problem is that you don't know how to increment the counter.
Your false predicate has the same problem:
((cons (car liste) counter) (= counter 0) (compressed-cdr))))))
where (cons (car liste) counter) yields a list and not a procedure.
I don't think we could really work with this code. I suggest looking at R Sahu's answer, which is close. Alternatively, I can show you a tail-recursive version which you could also have a look at. BTW, this is called run-length encoding, hence I've called my procedure rle:
(define (rle lst)
(define (newres prv cnt res)
(case cnt
((0) res)
((1) (cons prv res))
(else (cons (list prv cnt) res))))
(let loop ((lst lst) (prv null) (cnt 0) (res null))
(if (null? lst)
(if (zero? cnt)
(reverse res)
(loop null null 0 (newres prv cnt res)))
(let ((c (car lst)))
(if (eq? c prv)
(loop (cdr lst) prv (add1 cnt) res)
(loop (cdr lst) c 1 (newres prv cnt res)))))))
It was hard for me to figure out where the problem is in your code. I tried the following that seems to work.
(define (compress liste)
(define (helper in prev out)
(if (null? in)
(list (list (car out) (length out)))
(if (equal? prev (car in))
(helper (cdr in) prev (append out (list (car in))))
(cons (list (car out) (length out)) (compress in)))))
(if (null? liste)
'()
(helper (cdr liste) (car liste) (list (car liste))))
)
It uses helper to gather the output for matching items. When it finds a mismatch, it calls the main function to process the rest of the list. helper simply prepends its results to the results obtained from the main function.
A slightly improved version:
(define (compress liste)
(define (helper in prev out)
(if (null? in)
(list (list prev out))
(if (equal? prev (car in))
(helper (cdr in) prev (+ 1 out))
(cons (list prev out) (compress in)))))
(if (null? liste)
'()
(helper (cdr liste) (car liste) 1))
)
Here's tail-recursive version:
(define (compress liste)
(define (helper-1 in out)
(if (null? in)
'()
(helper-2 (cdr in) (car in) 1 out)))
(define (helper-2 in prev count out)
(if (null? in)
(append out (list (list prev count)))
(if (equal? prev (car in))
(helper-2 (cdr in) prev (+ 1 count) out)
(helper-1 in (append out (list (list prev count)))))))
(helper-1 liste '()))
I have a list '(1 2 1 1 4 5) and want output list as '((1 3)(2 1)(4 1)(5 1)). I have written a small code but I am stuck with how to calculate the cardinality for each number and then put it as pair in list. Can anyone please look at my code and give some ideas?
(define set2bags
(lambda (randlist)
(cond ((null? randlist) '())
(else
(sort randlist)
(makepairs randlist)))))
(define makepairs
(lambda (inlist)
(let ((x 0)) ((newlist '()))
(cond ((zero? (car inlist)) '())
(else
(eq? (car inlist)(car (cdr inlist)))
(+ x 1)
(makepairs (cdr inlist))
(append newlist (cons (car inlist) x)))))))
Your current solution is incorrect - it doesn't even compile. Let's start again from scratch, using a named let for traversing the input list:
(define set2bags
(lambda (randlist)
(cond ((null? randlist) '())
(else (makepairs (sort randlist >))))))
(define makepairs
(lambda (inlist)
(let loop ((lst inlist)
(prv (car inlist))
(num 0)
(acc '()))
(cond ((null? lst)
(cons (list prv num) acc))
((= (car lst) prv)
(loop (cdr lst) prv (add1 num) acc))
(else
(loop (cdr lst) (car lst) 1 (cons (list prv num) acc)))))))
Now it works as expected:
(set2bags '(1 2 1 1 4 5))
=> '((1 3) (2 1) (4 1) (5 1))
The trick is keeping a counter for the cardinality (I called it num), and incrementing it as long as the same previous element (I named it prv) equals the current element. Whenever we find a different element, we add a new pair to the output list (called acc) and reset the previous element and the counter.
Your code is fairly hard to read without proper formating.
I notice a two branch cond, which is easier to read as an if.
In your else clause of set2bags, you call (sort randlist) but leave it as is. You actually want to use this in the next s-expression (makepairs (sort randlist))
So far a pretty good idea.
Now in makepairs you should have better abstraction, say let variables like-first and unlike-first. If the inlist is null, then the function should be the null list, else it's the pair with the car being the list of the car of like-first and the length of like-first and the cdr being the result of calling makepairs on the unlike-first list
(define (makepairs inlist)
(let ((like-first (filter (lambda (x) (equal? x (car inlist)) inlist))
(unlike-first (filter (lambda (x) (not (equal? x (car inlist))) inlist)))
(if (null? inlist)
'()
(cons (list (car inlist) (length like-first)) (makepairs unlike-first)))))
more effecient version
(define (makepairs inlist)
(if (null? inlist)
'()
(let loop ((firsts (list (car inlist)))
(but-firsts (cdr inlist)))
(if (or (null? but-firsts)
(not (equal? (car firsts) (car but-firsts))))
(cons (list (car firsts) (length firsts))
(makepairs but-firsts))
(loop (cons (car but-firsts) firsts) (cdr but-firsts))))))
]=> (makepairs (list 1 1 1 2 4 5))
;Value 17: ((1 3) (2 1) (4 1) (5 1))
If you have your own implementation of sort, say a mergesort you could write this right into the merge part for the best effeciency.
(define (set2bags lst)
(mergesort2bags lst <))
(define (mergesort2bags lst pred)
(let* ((halves (divide-evenly lst))
(first-half (car halves))
(other-half (cadr halves)))
(cond ((null? lst) '())
((null? (cdr lst)) (list (list (car lst) 1)))
(else
(merge-bags
(mergesort2bags first-half pred)
(mergesort2bags other-half pred)
pred)))))
(define (divide-evenly lst)
(let loop
((to-go lst)
(L1 '())
(l2 '()))
(if (null? to-go)
(list L1 L2)
(loop (cdr to-go) (cons (car to-go) L2) L1))))
(define (merge-bags L1 L2 pred)
(cond ((null? L1) L2)
((null? L2) L1)
((pred (caar L1) (caar L2))
(cons (car L1) (merge-bags (cdr L1) L2 pred)))
((equal? (caar L1) (caar L2))
(cons (list (caar L1) (+ (cadar L1) (cadar L2)))
(merge-bags (cdr L1) (cdr L2) pred)))
(else (cons (car L2) (merge-bags L1 (cdr L2) pred)))))
(mergesort2bags (list 1 2 1 1 4 5) <)
;Value 46: ((1 3) (2 1) (4 1) (5 1))
I'm thinking for very large datasets with a lot of repetition this method would pay off.
How do I get elements from 2nd to 7th from a list, using only the following three functions:
cons
car
cdr
Example;
> (two-to-seven (list 8 9 5 1 0 3 6 2 4))
> (9 5 1 0 3 6)
Thanks.
> (define (t2s xs)
(cons (car (cdr xs)) (cons (car (cdr (cdr xs))) (cons (car (cdr (cdr (cdr xs)))) (cons (car (cdr (cdr (cdr (cdr xs))))) (cons (car (cdr (cdr (cdr (cdr (cdr xs)))))) (cons (car (cdr (cdr (cdr (cdr (cdr (cdr xs))))))) (list))))))))
> (t2s (list 8 2 5 4 0 3 6 1 1))
(2 5 4 0 3 6)
My solution. You might want to initialize the acumulator ( acum ) with 1, and/or use >= and <=. You provided no output.
(define (test-get start stop tlst)
(define acum 0)
(define (get-elems lst)
(cond ((null? lst) empty)
((and (symbol? (car lst))
(< acum stop)
(> acum start))
(set! acum (+ 1 acum))
(cons (car lst) (get-elems (cdr lst))))
((symbol? (car lst))
(set! acum (+ 1 acum))
(get-elems (cdr lst)))
(else (append (get-elems (car lst)) (get-elems (cdr lst))))))
(get-elems tlst))
Sample output
> (test-get 0 3 '(a (b) (c (d)) e (((f))) (h (i (j))) (k l)))
(b c)
> (test-get 2 6 '(a (b) (c (d)) e (((f))) (h (i (j))) (k l)))
(d e f)
> (test-get 2 7 '(a (b) (c (d)) e (((f))) (h (i (j))) (k l)))
(d e f h)
And if you're bothered by the append showing there you could replace it with your own using cons, cdr, car
(define (my-append l1 l2)
(if (null? l1)
l2
(cons (car l1) (my-append (cdr l1) l2))))
To also get rid of the set! so we'll be more in the bounds of functional programming (not tested):
(define (test-get start stop tlst)
(define (liniarize lst)
(cond ((null? lst) empty)
((symbol? (car lst)) (cons (car lst) (liniarize (cdr lst))))
(else (my-append (liniarize (car lst)) (liniarize (cdr lst))))))
(define (take-elems lst acum)
(cond ((null? lst) empty)
((and (< acum stop)
(> acum start)) (cons (car lst) (take-elems (cdr lst) (+ 1 acum))))
(else (take-elems lst (+ 1 acum)))))
(take-elems (liniarize tlst) 0))