Depth of atoms in list - list

I am trying to find depth of each element in a list and simultaneously create a output where flattened output is written with their depth level , so far i came up with following logic -
(define nestingDepth
(lambda (lst1)
(cond ((null? lst1) 1)
((list? (car lst1))
(cons(+ 1(nestingDepth (car lst1)))) (nestingDepth (cdr lst1)))
((null? (cdr lst1)) (cons (1 (cdr lst1))) (nestingDepth (cdr lst1))))))
But this is not printing anything in output. Please update where i am going wrong.
Expected result will look like -
input - '(a (b) c)
output - (1 a 2 b 1 c)

As some other answers have mentioned, it's important to make sure that each case retursn something of the proper type. If the input is the empty list, then the output should be the empty list. If the input is a pair, then you need to handle the car and the cdr of the pair and connect them. If the input is neither the empty list nor a pair, then the result is a list of the depth and the input.
Now, it may be handy to build the result incrementally. You can build from the right to the left, and add each element and its depth using an approach like the following:
(define (depths tree)
(let depths ((tree tree)
(depth 0)
(results '()))
(cond
((null? tree) results)
((pair? tree) (depths (car tree)
(+ 1 depth)
(depths (cdr tree)
depth
results)))
(else (cons depth (cons tree results))))))
> (depths '(a ((b) c ((d))) e))
(1 a 3 b 2 c 4 d 1 e)

Here's one possible solution (I have changed the output format a little to make the solution easier to code). append-map is defined in SRFI 1.
(define (depths x)
(cond ((list? x)
(append-map (lambda (y)
(map (lambda (z)
(cons (car z) (+ (cdr z) 1)))
(depths y)))
x))
(else `((,x . 0)))))
(I write the code as a seasoned Schemer would write it, not as someone would write a homework assignment. If that's your situation, try to understand what my code does, then reformulate it into something homework-acceptable.)

All the previous solutions work well for proper (nested) lists, for those who work for improper lists I am not sure if they are correct.
For example, (depths '(a . b)) yields (1 a 0 b) for Joshua's, and (((a . b) . 0)) for Chris', but I'd say it should be (1 a 1 b).
I'd therefore go for
(define (depths sxp)
(let loop ((sxp sxp) (res null) (level (if (cons? sxp) 1 0)))
(cond
((null? sxp) res)
((pair? sxp) (let ((ca (car sxp)))
(loop ca
(loop (cdr sxp) res level)
(if (pair? ca) (add1 level) level))))
(else (cons level (cons sxp res))))))
and my test cases are:
(check-equal? (depths '(a . b)) '(1 a 1 b))
(check-equal? (depths 'a) '(0 a)) ; 0
(check-equal? (depths '(a)) '(1 a))
(check-equal? (depths '(a a)) '(1 a 1 a))
(check-equal? (depths '(a (b . c) d (e (f (g h . i) . j)))) '(1 a 2 b 2 c 1 d 2 e 3 f 4 g 4 h 4 i 3 j))
(check-equal? (depths '(a (b) c)) '(1 a 2 b 1 c))
(check-equal? (depths '(a ((b) c ((d))) e)) '(1 a 3 b 2 c 4 d 1 e))
(check-equal? (depths '(a (b (c (d e))) f g)) '(1 a 2 b 3 c 4 d 4 e 1 f 1 g))

The base case is wrong (you can't return 1 if you intend to output a list as a result), the way the recursion is being advanced doesn't build a list as output … a complete rewrite is needed; the following solution is portable and should work on any Scheme interpreter, making use only of basic procedures:
(define (nestingDepth lst)
(let depth ((lst lst) (n 1))
(cond ((null? lst) '())
((not (pair? (car lst)))
(cons n
(cons (car lst)
(depth (cdr lst) n))))
(else
(append (depth (car lst) (+ 1 n))
(depth (cdr lst) n))))))
The output is as expected:
(nestingDepth '(a (b (c (d e))) f g))
=> '(1 a 2 b 3 c 4 d 4 e 1 f 1 g)

Related

Merging jumping pairs

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.

Matching elements on a specific position of lists

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")

Flatten top-level sublists in Scheme

I am working my first project in scheme and have come across an issue. In part of my requirements, I am required to append all top-level sublists
(e.g. '((1 2)(3 4 (5 6))) -> (1 2 3 4 (5 6)) and '((1 2 3)(4 5)) -> (1 2 3 4 5)
I've managed to get it working down to a single list, but this flattens all levels:
(cond
((null? lst)
lst)
((list? lst)
(append2(append-subs(car lst))(append-subs(cdr lst))))
(else
(cons lst '())))
Variations of this (eg. (else lst) run the error "object 6, passed as first arg to cdr, is not correct type". Another method I attempted is as follows:
(cond
((null? lst)
lst)
((>= (len (cdr lst)) 0)
(append2(append-subs(car (list lst)))(append-subs(cdr (list lst)))))
(else
lst)
Which infinitely loops. I'm at a bit of a stand still, so any help would be greatly appreciated. (Note: Use of functions other than those used here is forbidden. Limited to list, list?, if, cond, null? ...)
Your list '(e1 e2 e3) would be like this:
(cons e1 (cons e2 (cons e3 '())))
or if you like dotted notation:
'(e1 . (e2 . (e3 . ())))
Where en is eiter #f or #t for (list? en) Your assignment is to cons en onto the recursion with the same level while with a list you need to append the two.
Here is a general idea how to implement it with level as an input parameter:
;;; flatten a list a certain levels
;;; level of zero is identity
(define (flatten-level level lst)
(cond ((or (zero? level)
(null? lst))
lst)
;; pair? is faster but will fall through for dotted
((list? (car lst))
(append (flatten-level <??> <??>)
(flatten-level <??> <??>)))
(else
(cons <??>
(flatten-level <??> <??>)))))
(flatten-level 0 '((1 2)(3 (((4 . 3))) (5 (6))) . 7))
; ==> ((1 2) (3 (((4 . 3))) (5 (6))) . 7) (aka identity)
(flatten-level 1 '((1 2)(3 (((4 . 3))) (5 (6))) . 7))
; ==> (1 2 3 (((4 . 3))) (5 (6)) . 7)
(flatten-level 99 '((1 2)(3 (((4 . 3))) (5 (6))) . 7))
; ==> (1 2 3 (4 . 3) 5 6 . 7)
How about appending all elements of the top list:
(define (flatten-top-level lst)
(apply append lst))
Which is practically the definition of append*
If '(a (b) (c f)) is a valid input, (first element not a list) then you can try:
(define (flatten-top-level lst)
(apply append
(map (lambda (e) (if (list? e)
e
(list e))) ;make a list from the non-list element
lst)))
2nd option: Fold it!
(define (flatten-top-level lst)
(foldr append '() lst))
For a list (a b c d) where a, b, c, d are sub-lists; it is equal to:
(append a (append b (append c (append d '()))))
Extra: this is tail recurssive and therefore runs in linear time :)

Function in lisp that displays a list in a specific way

I need to make a function in lisp that displays a list like this:
(a b (c d) (e f g) h) ->
(a
b
(c
d)
(e
f
g)
h)
So far i managed to make a function that displays a list like this.
(defun print1-lista(l)
(princ pard)
(do ((lst l (cdr lst)))
((null (cdr lst)) (princ (car lst)) (princ par))
(princ (car lst))
(terpri)))
PRINT1-LISTA
> (print1-lista '(1 (1 2) 3 4))
{1
(1 2)
3
4}
}
In Common Lisp, you can customize the printer in many ways. For instance, the variables *print-case* and *print-margin-right* will control the case that symbols are printed in, and the right margin as used by the pretty printer. Thus you can do something like this:
(let ((*print-case* :downcase)
(*print-right-margin* 2))
(pprint '(a b (c d) (e f g) h)))
to get output like this:
(a
b
(c
d)
(e
f
g)
h)
Here is a quick and dirty sketch of such a scheme for pretty printing in PLT-Scheme
(define (deep-ppr lst depth)
(let ((elt (car lst)))
(if (list? elt)
(begin
(printf "~a(~a\n" (make-string depth #\ ) (car elt))
(deep-ppr (cdr elt) (+ 1 depth)))
;; not a list
(begin
(printf "~a~a" (make-string depth #\ ) elt)))
(if (empty? (cdr lst)) (printf ")")
(begin
(printf "\n")
(deep-ppr (cdr lst) depth)))))
Which yields this. You can change the scheme for introducing newlines however you'd like.
sicp.rkt> (deep-pp '(1 (1 2 4) 3 4 5 6 (1 2 3 5) 7) 0)
(1
(1
2
4)
3
4
5
6
(1
2
3
5)
7)

Deleting Second last ATOM

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)))))