How do I recursively merge jumping pairs of elements of a list of lists? I need to have
'((a b c) (e d f) (g h i))
from
'((a b) c (e d) f (g h) i)
My attempt
(define (f lst)
(if (or (null? lst)
(null? (cdr lst)))
'()
(cons (append (car lst) (list (cadr lst)))
(list (append (caddr lst) (cdddr lst))))))
works if I define
(define listi '((a b) c (d e) f))
from which I obtain
((a b c) (d e f))
by doing simply
(f listi)
but it does not work for longer lists. I know I need recursion but I don't know where to insert f again in the last sentence of my code.
A simpler case that your algorithm fails: (f '((1 2) 3)) should result in '((1 2 3)), but yours results in an error.
We will define some terms first:
An "element" is a regular element, like 1 or 'a.
A "plain list" is simply a list of "element"s with no nested list.
E.g., '(1 2 3) is a plain list. '((1 2) 3) is not a plain list.
A "plain list" is either:
an empty list
a cons of an "element" and the next "plain list"
A "list of jumping pairs" is a list of even length where the odd index has a "plain list", and the even index has an element. E.g., '((1) 2 (a) 4) is a "list of jumping pairs". A "list of jumping pairs" is either:
an empty list
a cons of
a "plain list"
a cons of an "element" and the next "list of jumping pairs"
We are done with terminology. Before writing the function, let's start with some examples:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
(f '((1 2) 3 (4) a)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
(cons (cons 4 empty)
(cons 'a
empty)))))
should output '((1 2 3) (4 a))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
(cons (cons 4 (cons 'a empty))
empty))
So, f is a function that consumes a "list of jumping pairs" and returns a list of "plain list".
Now we will write the function f:
(define (f lst)
???)
Note that the type of lst is a "list of jumping pairs", so we will perform a case analysis on it straightforwardly:
(define (f lst)
(cond
[(empty? lst) ???] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
we know that the empty case should return an empty list, so let's fill in the hole accordingly:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
we know that we definitely want to put the "element" into the back of the "plain list" to obtain the resulting "plain list" that we want:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the next "list of jumping pairs"
(rest (rest lst))
;; that are available for us to use
???]))
There's still the next "list of jumping pairs" left that we need to deal with, but we have a way to deal with it already: f!
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the list of "plain list"
(f (rest (rest lst)))
;; that are available for us to use
???]))
And then we can return the answer:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case returns
;; the resulting list of "plain list" that we want
(cons (append (first lst) (cons (first (rest lst)) empty))
(f (rest (rest lst))))]))
Pattern matching (using match below) is insanely useful for this kind of problem -
(define (f xs)
(match xs
;; '((a b) c . rest)
[(list (list a b) c rest ...)
(cons (list a b c)
(f rest))]
;; otherwise
[_
empty]))
define/match offers some syntax sugar for this common procedure style making things even nicer -
(define/match (f xs)
[((list (list a b) c rest ...))
(cons (list a b c)
(f rest))]
[(_)
empty])
And a tail-recursive revision -
(define (f xs)
(define/match (loop acc xs)
[(acc (list (list a b) c rest ...))
(loop (cons (list a b c) acc)
rest)]
[(acc _)
acc])
(reverse (loop empty xs)))
Output for each program is the same -
(f '((a b) c (e d) f (g h) i))
;; '((a b c) (e d f) (g h i))
(f '((a b) c))
;; '((a b c))
(f '((a b) c x y z))
;; '((a b c))
(f '(x y z))
;; '()
(f '())
;; '()
As an added bonus, this answer does not use the costly append operation
There is no recursive case in your code so it will just work statically for a 4 element list. You need to support the following:
(f '()) ; ==> ()
(f '((a b c) d (e f g) h)) ; ==> (cons (append '(a b c) (list 'd)) (f '((e f g) h)))
Now this requires exactly even number of elements and that every odd element is a proper list. There is nothing wrong with that, but onw might want to ensure this by type checking or by adding code for what should happen when it isn't.
Related
I've just started to learn Racket.
I have this code:
#lang racket
(define l1 '(1 2 3 4))
(car l1)
(cdr l1)
(car l1) returns 1.
(cdr l1) returns '(2 3 4)
Is there a function that returns '(1 2 3)?
I've tried this:
#lang racket
(define l1 '(1 2 3 4))
(map
(lambda (l i)
(if (not (= i (sub1 (length l1)))) l '()))
l1 (range 0 (length l1)))
But, it returns: '(1 2 3 ())
And I have also tried:
#lang racket
(define l1 '(1 2 3 4))
(map
(lambda (l i)
(cond ((not (= i (sub1 (length l1)))) l )))
l1 (range 0 (length l1)))
But, it returns: '(1 2 3 #<void>)
The map function always returns a list the same length as its input. You want an output list that is shorter than its input. The function you are looking for is traditionally called but-last:
(define (but-last xs) (reverse (cdr (reverse xs))))
What about something like this ?
(define (myCdr l)
(if (not (pair? (cdr l)))
'()
(cons (car l) (myCdr (cdr l)))
)
)
length is generally an anti-pattern in Scheme because the entire list needs to be read in order to get the result. W. Ness remarks that map does not alter the structure of the list, and the behavior of filter is based on the list's values, neither of which suit your needs.
Instead of making potentially expensive computations first or awkwardly applying the library functions, you can compute the init of a list using direct recursion -
(define (init l)
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
null)
(else
(cons (car l)
(init (cdr l))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
Or a tail-recursive form that only uses one reverse -
(define (init l)
(let loop ((acc null)
(l l))
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
(reverse acc))
(else
(loop (cons (car l) acc)
(cdr l))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
And lastly a tail-recursive form that does not use length or reverse. For more intuition on how this works, see "How do collector functions work in Scheme?" -
(define (init l (return identity))
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
(return null))
(else
(init (cdr l)
(lambda (r)
(return (cons (car l) r)))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
Here's one more, via zipping:
#lang racket
(require srfi/1)
(define (but-last-zip xs)
(if (null xs)
xs ; or error, you choose
(map (lambda (x y) x)
xs
(cdr xs))))
Here's another, emulating filtering via lists with appending, where empty lists disappear by themselves:
(define (but-last-app xs)
(if (null? xs)
xs
(let ((n (length xs)))
(apply append ; the magic
(map (lambda (x i)
(if (= i (- n 1)) '() (list x)))
xs
(range n))))))
Or we could use the decorate--filter--undecorate directly, it's even more code!
(define (but-last-fil xs)
(if (null? xs)
xs
(let ((n (length xs)))
(map car
(filter (lambda (x) (not (null? x)))
(map (lambda (x i)
(if (= i (- n 1)) '() (list x)))
xs
(range n)))))))
Here's yet another alternative, assuming that the list is non-empty. It's efficient (it performs a single pass over the list), and it doesn't get any simpler than this!
(define (delete-last lst)
(drop-right lst 1))
(delete-last '(1 2 3 4))
=> '(1 2 3)
Here is an equivalent of Will Ness's beautiful but-last-zip which does not rely on srfi/1 in Racket: without srfi/1 Racket's map insists that all its arguments are the same length (as does the R5RS version in fact) but it is common in other Lisps to have the function terminate at the end of the shortest list.
This function uses Racket's for/list and also wires in the assumption that the result for the empty list is the empty list.
#lang racket
(define (but-last-zip xs)
(for/list ([x xs] [y (if (null? xs) xs (rest xs))])
x))
I think Will's version is purer: mapping functions over things is a very Lisp thing to do I think, while for/list feels less Lispy to me. This version's only advantage is that it does not require a module.
My own solution using recursion:
#lang racket
(define but-last
(lambda (l)
(cond ((null? (cdr l)) '())
(else (cons (car l) (but-last (cdr l)))))))
And another solution using filter-not and map:
#lang racket
(define l1 '(1 2 3 4))
(filter-not empty? (map
(lambda (l i)
(if (not (= i (sub1 (length l1)))) l empty))
l1 (range 0 (length l1))))
Related to this question I would like to count the number of matches between the elements of two different lists of lists in a certain position.
For instance:
'((a b c) (d e c) (f g h)) '((a e k) (l f c) (g p c))
would return 2 whenever we specify the matching position as the third one on every list (no matter what the other positions contain).
Is there a function doing this operation? I cannot find it. Thank you.
Solution
I don't know of any readily made functions. So I wrote own.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; filter list of list by inner list element position
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (position-filter lol pos)
(map (lambda (l) (list-ref l pos)) lol))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; intersect two lists (duplicate-preserved)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; without duplicates would be `set-intersect`
(define (list-intersect l1 l2 (acc '()) (test equal?))
(cond ((or (null? l1) (null? l2)) (reverse acc))
((member (car l1) l2 test)
(list-intersect (cdr l1) (remove (car l1) l2) (cons (car l1) acc) test))
(else (list-intersect (cdr l1) l2 acc test))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; intersect two position-filtered lols
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (lol-intersect-at-pos lol-1 lol-2 pos)
(let ((l1 (position-filter lol-1 pos))
(l2 (position-filter lol-2 pos)))
(list-intersect l1 l2)))
;; you can count then how many elements are common by `length`
That's it.
Testing
Since I was too "lazy" to write lol with strings, I wrote a convenience function:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; convert lol elements to strings
;; convenience function
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require racket/format) ;; for ~a
(define to-string ~a)
(define (as-strings nested-list (acc '()))
(cond ((null? nested-list) (reverse acc))
((list? (car nested-list))
(as-strings (cdr nested-list)
(cons (as-strings (car nested-list))
acc)))
(else
(as-strings (cdr nested-list)
(cons (to-string (car nested-list))
acc)))))
Equipped with this, we can try out lols with symbols:
(lol-intersect-at-pos '((a b c) (d e c) (f g h))
'((a e k) (l f c) (g p c))
2)
;;'(c c) ;; length is 2
lols with numbers as elements:
(lol-intersect-at-pos '((1 2 3) (4 5 3) (6 7 8))
'((1 5 19) (18 7 3) (29 39 3))
2)
;;'(3 3) ;; length is 2
and lols with strings as elements:
(lol-intersect-at-pos (as-strings '((a b c) (d e c) (f g h)))
(as-strings '((a e k) (l f c) (g p c)))
2)
;;'("c" "c") ;; length is 2
even mixed lols:
(lol-intersect-at-pos '((a b c) (a b "c") (d e 3) (f g "3"))
'((d c c) ("a" "b" c) (1 3 3) (2 4 3))
2)
;;'(c 3) ;; length of that is 2
More complicated Solution with sorting (requires conversion symbol->string with all its complications)
Before that, I wrote this. I leave it for history.
#lang racket
(define (get-position-values lol pos) ; to extract elements at pos in inner lists
(map (lambda (l) (list-ref l pos)) lol))
; to determine all elements common between two lists
; set-intersect would remove duplicates, so I had to write an list-intersect
(define (list-intersect l1 l2 (acc '()) (test-equality equal?) (test-smaller <))
(let ((lst1 (sort l1 test-smaller))
(lst2 (sort l2 test-smaller)))
(cond ((or (null? lst1) (null? lst2)) (reverse acc))
((test-equality (car lst1) (car lst2))
(list-intersect (cdr lst1) (cdr lst2) (cons (car lst1) acc) test-equality test-smaller))
((test-smaller (car lst1) (car lst2))
(list-intersect (cdr lst1) lst2 acc test-equality test-smaller))
(else
(list-intersect lst1 (cdr lst2) acc test-equality test-smaller)))))
; to determine all elements common between two list of lists at position pos
; transformer is the function applied to the extracted list elements (necessary when symbols are used,
; since symbols don't have a test-smaller test, only equality test, but sorting would improve performance ...
; so this function doesn't allow to mixup strings and symbols, because symbols would be converted to strings
; so indistinguishable from strings when applying equality test.
; if one wants better equality test, then one has to construct a more complex test-smaller test function which
; can handle strings, symbols, numbers etc. - and one needs also such a more complex test-equality function -
; and then the transformer can be the identity function.
(define (match-element-lol-pos lol-1 lol-2 pos (test-equality string=?) (test-smaller string<?) (transformer symbol->string))
(let* ((l1 (get-position-values lol-1 pos))
(l2 (get-position-values lol-2 pos))
(sl1 (map transformer l1))
(sl2 (map transformer l2))
(commons (list-intersect sl1 sl2 '() test-equality test-smaller)))
(values (length commons) commons)))
This you can apply then to your example pair of list of lists.
(match-element-lol-pos '((a b c) (d e c) (f g h)) '((a e k) (l f c) (g p c)) 2)
; 2 for third element of inner lists!
Which gives:
;; 2
;; '("c" "c")
List of lists with numbers as elements, one can call like this:
(match-element-lol-pos '((1 2 3) (4 5 3) (6 7 8)) '((1 5 19) (18 7 3) (29 39 3)) 2 = < identity)
;; 2
;; '(3 3)
List of lists with strings as elements, one calls like this.
For convenient reasons, I wrote a function as-strings which converts all elements in a nested list into strings. I was just too lazy to wrap "" around each symbol ...
;; convert all list elements of any nested-list into strings
(require racket/format) ;; for ~a
(define to-string ~a)
(define (as-strings nested-list (acc '()))
(cond ((null? nested-list) (reverse acc))
((list? (car nested-list)) (as-strings (cdr nested-list) (cons (as-strings (car nested-list)) acc)))
(else (as-strings (cdr nested-list) (cons (to-string (car nested-list)) acc)))))
So this can be used then like this:
(match-element-lol-pos (as-strings '((a b c) (d e c) (f g h))) (as-strings '((a e k) (l f c) (g p c))) 2 string=? string<? identity)
;; 2
;; '("c" "c")
I wish to create a function in Scheme that takes in a predicate and a list of elements, and then outputs two separate lists. One with elements of the original list that MATCH the given predicate, and one with elements that DON'T match it.
The code I have right now I believe should isolate those which match the predicate and output a list of them but the code will not work.
(define tear
(lambda (pred xs)
(cond[(null? xs) '()]
[(list? (car xs))(cons((tear (pred (car xs)))(tear (pred (cdr xs)))))]
[(pred (car xs))(cons((car xs)(tear (pred (cdr xs)))))]
[else tear (pred (cdr xs))])))
(tear number? '(1 2 3 a b c))
The resulting output on my compiler is:
tear: arity mismatch;
the expected number of arguments does not match the given number
expected: 2
given: 1
arguments...:
#f
context...:
/home/jdoodle.rkt:2:4: tear
Command exited with non-zero status 1
Any help/info that you can give would be much appreciated.
Lets fix your code step by step. Adding indentation and whitespace to make it readable:
(define tear
(lambda (pred xs)
(cond
[(null? xs)
'()]
[(list? (car xs))
(cons ((tear (pred (car xs))) (tear (pred (cdr xs)))))]
[(pred (car xs))
(cons ((car xs) (tear (pred (cdr xs)))))]
[else
tear (pred (cdr xs))])))
(tear number? '(1 2 3 a b c))
The first problem I see is a problem of putting parentheses on the inside (around the arguments) of a function call instead on the outside. You do this with cons and with the recursive calls to tear. For instance in tear (pred (cdr xs)) you should move the first paren to before the function. Remember that parentheses in an expression almost always mean a function call in the shape of (function argument ...).
(cons (A B)) should be rewritten to (cons A B)
(tear (Pred Xs)) should be rewritten to (tear Pred Xs)
tear (Pred Xs) should be rewritten to (tear Pred Xs)
With these fixes your code looks like this:
(define tear
(lambda (pred xs)
(cond
[(null? xs)
'()]
[(list? (car xs))
(cons (tear pred (car xs)) (tear pred (cdr xs)))]
[(pred (car xs))
(cons (car xs) (tear pred (cdr xs)))]
[else
(tear pred (cdr xs))])))
(tear number? '(1 2 3 a b c))
;=> (1 2 3)
(tear number? '(1 2 "not a number" 3 4))
;=> (1 2 3 4)
However, it still does something weird when there's a nested list:
(tear list? (list '(1 2 3) "not a list" '(4 5)))
;=error> (() ())
To be consistent it should put the two lists into a list: ((1 2 3) (4 5)). To do that just remove the second cond case:
(define tear
(lambda (pred xs)
(cond
[(null? xs)
'()]
[(pred (car xs))
(cons (car xs) (tear pred (cdr xs)))]
[else
(tear pred (cdr xs))])))
(tear number? '(1 2 3 a b c))
;=> (1 2 3)
(tear list? (list '(1 2 3) "not a list" '(4 5)))
;=> ((1 2 3) (4 5))
It now seems to do exactly half of what you want. You want it to return two lists: one for elements that passed, and one for the elements that failed. It currently is returning just the first list.
The first thing you should do is document how it returns those two lists. Since there are always exactly two, you can return them as multiple values.
;; tear returns two values:
;; - a list of the elements of `xs` that passed `pred`
;; - a list of the elements of `xs` that failed `pred`
There are two parts of using multiple values: returning them and receiving them. Use (values A B) to return them, and (let-values ([(A B) ....]) ....) to match on a result, like the result of a recursive call.
That means every recursive call like this (f .... (tear ....) ....) should become
(let-values ([(A B) (tear ....)])
(values (f .... A ....)
???))
Applying that to your code:
;; tear returns two values:
;; - a list of the elements of `xs` that passed `pred`
;; - a list of the elements of `xs` that failed `pred`
(define tear
(lambda (pred xs)
(cond
[(null? xs)
(values '()
???)]
[(pred (car xs))
(let-values ([(A B) (tear pred (cdr xs))])
(values (cons (car xs) A)
???))]
[else
(let-values ([(A B) (tear pred (cdr xs))])
(values A
???))])))
Now to fill in the ??? holes, use examples.
(tear number? '()) should return two empty lists: () ()
(tear number? '(1 2)) should return a full list and an empty list: (1 2) ()
(tear number? '(a b)) should return an empty list and a full list: () (a b)
The first example corresponds to the first ??? hole, the second example corresponds to the second hole, and so on.
This tells us that the first hole should be filled in with '(), the second hole should be filled in with B, and the third hole should be filled in with (cons (car xs) B).
(define tear
(lambda (pred xs)
(cond
[(null? xs)
(values '() '())]
[(pred (car xs))
(let-values ([(A B) (tear pred (cdr xs))])
(values (cons (car xs) A)
B))]
[else
(let-values ([(A B) (tear pred (cdr xs))])
(values A
(cons (car xs) B)))])))
(tear number? '(1 2 3 a b c))
;=> (1 2 3)
; (a b c)
(tear list? (list '(1 2 3) "not a list" '(4 5)))
;=> ((1 2 3) (4 5))
; ("not a list")
This is a classic fold use-case. You're aggregating the list into two lists :
(define tear (lambda (pred lst)
(fold-right ; Aggregate over lst
(lambda (elem agg)
(let ((accepted (car agg))
(rejected (cadr agg)))
(if (pred elem)
; Create a new agg by adding the current element to the accepted list
`(,(cons elem accepted) ,rejected)
; Or, if the predicate rejected the element,
; Create a new agg by adding the current element to the rejected list
`(,accepted ,(cons elem rejected)))))
`(() ())
lst)))
So, if you use even? as your predicate, you can get:
> (tear even? `(1 2 3 4 5 6 7 8))
((2 4 6 8) (1 3 5 7))
Here's another way you can do it using continuation-passing style; this puts the recursive call in tail position.
(define (partition p xs (return list))
(if (null? xs)
(return null null)
(partition p
(cdr xs)
(lambda (t f)
(if (p (car xs))
(return (cons (car xs) t)
f)
(return t
(cons (car xs) f)))))))
(partition number? '())
;; => '(() ())
(partition number? '(a 1 b 2 c 3))
;; => '((1 2 3) (a b c))
(partition list? '(1 2 (3 4) (5 6) 7 8))
;; => '(((3 4) (5 6)) (1 2 7 8))
Above, we make use of Racket's default arguments. Below we show how to define partition using a helper function instead
;; procedure above, renamed to partition-helper
(define (partition-helper p xs return)
...)
;; new procedure without optional parameter
(define (partition p xs)
;; call helper with default continuation, list
(partition-helper p xs list))
Comments may help distill some of the style's mysterious nature
;; default continuation is `list`, the list constructor procedure
(define (partition p xs (return list))
(if (null? xs)
;; base case: empty list; return the empty result
(return null null)
;; inductive case: at least one x; recur on the tail...
(partition p
(cdr xs)
;; ...specifying how to continue the pending computation
(lambda (t f)
(if (p (car xs))
;; if predicate passes, cons x onto the t result
(return (cons (car xs) t)
f)
;; otherwise cons x onto the f result
(return t
(cons (car xs) f)))))))
#WillNess asks why we delay evaluating the predicate; I don't have a reason other than I think the readability above is pretty good. We can alter the implementation to check the predicate right away, if we please. The impact here is very subtle. If you don't see it, I encourage you to play pen-and-paper evaluator and compare the two processes to understand it.
;; default continuation is `list`, the list constructor procedure
(define (partition p xs (return list))
(if (null? xs)
;; base case: empty list; return the empty result
(return null null)
;; inductive case: at least one x; recur on the tail...
(partition p
(cdr xs)
;; ...specifying how to continue the pending computation
(if (p (car xs))
(lambda (t f)
;; if predicate passes, cons x onto the t result
(return (cons (car xs) t)
f))
(lambda (t f)
;; otherwise cons x onto the f result
(return t
(cons (car xs) f)))))))
I am trying to delete second last ATOM from the given list -
(define (butSecondLastAtom lst1)
(cond
((null? lst1) '())
((null? (cdr lst1)) lst1)
((null? (cddr lst1))
(cond((not(pair? (car lst1))) (cdr lst1))
(else (cons(butLastAtom (car lst1)) (cdr lst1)))))
(else (cons (car lst1) (butSecondLastAtom(cdr lst1))))))
(define (butLastAtom x)
(cond ((null? (cdr x))
(cond ((not(pair? (car x))) '())
(else (cons (butLastAtom(car x)) '()))))
(else (cons (car x) (butLastAtom(cdr x))))))
This code do delete the second last atom but fails for following condition -
if input is like (a (b (c (d)))) then output should result in (a (b ((d)))).
Please update where i am being wrong or with a solution.
Here's a solution that's basically copying a tree. The trick to removing an element at a given position from the right is to decrement n each time we process a leaf. The element that we want to remove must be the car of some pair, so the part of the copying routine that rebuilds a pair just needs to be able to watch for when that happens. We can "signal" it by returning some special value instead of the nth item. What special value can we use? We've already defined an internal function that nothing else will have access to, so we can use it.
(define (rem n tree)
;; Returns a new tree similar to the input,
;; but without the nth leaf from the right.
(let rem ((tree tree))
(cond
;; Copy the empty tree by returning the empty tree.
((null? tree)
'())
;; Copy a pair by copying the right and left subtrees,
;; and then putting them back together. The exception
;; is when the car is the nth element (and the "copy" of
;; it is the special value). In that case, we just
;; return the copy of the right subtree.
((pair? tree)
(let ((r (rem (cdr tree))) ; copy the right subtree
(l (rem (car tree)))) ; copy the left subtree
(if (eq? l rem)
r
(cons l r))))
;; When we encounter a leaf, decrement the counter.
;; If it's zero (which means we want to discard this leaf),
;; then return the special value. Otherwise, return
;; the leaf.
(else
(set! n (- n 1))
(if (= n 0) rem tree)))))
> (rem 2 '(a (b (c (d)))))
(a (b ((d))))
After that, it's easy to define your more specific version:
(define (butSecondLastAtom lst1)
(rem 2 lst1))
> (butSecondLastAtom '(a b (c d) ((e f) (g))))
(a b (c d) ((e) (g)))
The following works for my understanding of the problem, but since you provide only one testcase please make sure this is what you want.
The solution has 2 passes:
pass 1 - count the number of atoms
Fairly classical, count how many atoms we have so that we can compute which one to drop later on:
(define (count-atoms sexp)
(cond
((null? sexp) 0)
((pair? sexp) (+ (count-atoms (car sexp)) (count-atoms (cdr sexp))))
(else 1)))
pass 2 - copy without the second last
First, I need an atom? predicate here:
(define (atom? x)
(not (or (pair? x) (null? x))))
Copying without dropping any element is very similar to the previous function:
(define (copy sexp)
(cond
((or (null? sexp) (atom? sexp)) sexp)
(else (cons (copy (car sexp)) (copy (cdr sexp))))))
In order to drop an element, we need to change the second clause, and introduce a counter so that we know when we meet the element to drop:
(define (butSecondLastAtom sexp)
(define n 1) ; counter of atoms
(define ignore (count-atoms sexp)) ; index of element to ignore
(define (sub sexp) ; the copy subroutine
(cond
((null? sexp) null)
((atom? sexp)
(set! n (add1 n)) ; increase n
sexp)
(else
(let* ((left (sub (car sexp))) ; process car of cons cell
(leftn n) ; keep track of n after processing car
(right (sub (cdr sexp))) ; process cdr of cons cell
(rightn n)) ; keep track of n after processing cdr
(cond
((and (atom? left) (= leftn ignore)) right)
((and (atom? right) (= rightn ignore)) left)
(else (cons left right)))))))
(sub sexp))
Here are my test cases:
(require rackunit)
(check-equal? (butSecondLastAtom null) null)
(check-equal? (butSecondLastAtom 1) 1)
(check-equal? (butSecondLastAtom '(a b)) '(b))
(check-equal? (butSecondLastAtom '(a . b)) 'b)
(check-equal? (butSecondLastAtom '(a (b . c))) '(a c))
(check-equal? (butSecondLastAtom '(1 2 (3 (4 5 (6 . 7))))) '(1 2 (3 (4 5 7))))
(check-equal? (butSecondLastAtom '(a (b (c) d))) '(a (b () d)))
(check-equal? (butSecondLastAtom '(a (c d) e)) '(a (c) e))
(check-equal? (butSecondLastAtom '(a (b (c (d))))) '(a (b ((d)))))
I know this question has been asked before, and my solution is the same as many of the answers but I have a special test case that won't work correctly with the common solution to this problem.
The solution that I have found for the zip problem like many others is
(define (zip l1 l2)(map list l1 l2))
. . .which works great with given arguments such as
(zip '(a b c) '(1 2 3)) => ((a 1) (b 2) (c 3))
but I also want the zip function to work for cases where my arguments do not match length like
(zip '(a b c) '(1)) => ((a 1) (b ()) (c ()))
I have not found a solution to this problem and not really sure how to approach it where each list can be any length.
First, a simple iterative version that works for 2 lists only:
(define (zip lst1 lst2 (placeholder '()))
(define (my-car lst)
(if (empty? lst) placeholder (car lst)))
(define (my-cdr lst)
(if (empty? lst) lst (cdr lst)))
(let loop ((lst1 lst1) (lst2 lst2) (res '()))
(if (and (empty? lst1) (empty? lst2))
(reverse res)
(loop (my-cdr lst1) (my-cdr lst2)
(cons (list (my-car lst1) (my-car lst2)) res)))))
such as
(zip '(a b c) '(1 2 3))
=> '((a 1) (b 2) (c 3))
(zip '(a b c) '(1))
=> '((a 1) (b ()) (c ()))
From this, you can generalise to n lists, but to avoid keyword parameters you have to put the placeholder parameter first:
(define (zip placeholder . lsts)
(define (my-car lst)
(if (empty? lst) placeholder (car lst)))
(define (my-cdr lst)
(if (empty? lst) lst (cdr lst)))
(let loop ((lsts lsts) (res '()))
(if (andmap empty? lsts)
(reverse res)
(loop (map my-cdr lsts)
(cons (apply list (map my-car lsts)) res)))))
such as
(zip '() '(a b c) '(1 2 3))
==> '((a 1) (b 2) (c 3))
(zip '() '(a b c) '(1))
==> '((a 1) (b ()) (c ()))
(zip '() '(a b c) '(1) '(x y))
=> '((a 1 x) (b () y) (c () ()))
I believe that andmap is the only Racket-specific function here, which probably has some Scheme or SRFI equivalent depending on your implementation.
EDIT
Since the solution is based on creating lists of equal length, instead of duplicating the zip algorithm, you can also first add the placeholders to the lists before doing the classic map-list stuff:
(define (zip placeholder . lsts)
(let* ((max-len (apply max (map length lsts))) ; the length of the longest lists
(equal-length-lists ; adjusts all lists to the same length,
(map ; filling with placeholder
(lambda (lst) (append lst (make-list (- max-len (length lst)) placeholder)))
lsts)))
(apply map list equal-length-lists))) ; classical zip
It's not semantically correct to have (zip '(a b c) '(1)) => ((a 1) (b ()) (c ())) (unless you're specifically using () as a placeholder value); it's more sensible to have ((a 1) (b) (c)). Here's an implementation that achieves that:
(define (zip-with-uneven . lists)
(define (advance lst)
(if (null? lst)
lst
(cdr lst)))
(define (firsts lists)
(let loop ((lists lists)
(result '()))
(cond ((null? lists) (reverse result))
((null? (car lists)) (loop (cdr lists) result))
(else (loop (cdr lists) (cons (caar lists) result))))))
(let loop ((lists lists)
(results '()))
(if (andmap null? lists)
(reverse results)
(loop (map advance lists)
(cons (firsts lists) results)))))
andmap is from Racket. If you're not using Racket, you can use every from SRFI 1 instead.
If you really want to use a placeholder, here's a (Racket-specific) version that supports placeholders. The default placeholder is (void), which I presume is never a valid value you'd want to put in your result list.
(define (zip-with-uneven #:placeholder (ph (void)) . lists)
(define (advance lst)
(if (null? lst)
lst
(cdr lst)))
(define (cons-with-placeholder a d)
(if (void? a)
d
(cons a d)))
(define (firsts lists)
(let loop ((lists lists)
(result '()))
(cond ((null? lists) (reverse result))
((null? (car lists))
(loop (cdr lists) (cons-with-placeholder ph result)))
(else (loop (cdr lists) (cons (caar lists) result))))))
(let loop ((lists lists)
(results '()))
(if (andmap null? lists)
(reverse results)
(loop (map advance lists)
(cons (firsts lists) results)))))