Scheme Function to Count Atomic Elements in a List - list

I am trying to write a simple recursive definition in Scheme (LISP).
The goal is to count the number of atomic elements in a list and recursively count internal list atoms as well.
For example:
(num_items '((a b) c d))
should return:
4
because "a", "b", "c", and "d" are the four atomic elements in the lists/sub-lists.
My code so far is as follows:
(define (num_items X)
(cond
((null? X) 0)
(list? (car X) (+ (num_items(car X)) (num_items(cdr X))))
(else (+ 1 (num_items(cdr X))))
))
(display(num_items '((a b) c d)))
The error is thrown on the 4th line:
(list? (car X) (+ (num_items(car X)) (num_items(cdr X))))
As far as I can tell, the (num_items(car X)) recursion in the addition seems to be causing the error. If I replace that part of the line with a 1 for example to get:
(list? (car X) (+ 1 (num_items(cdr X))))
Then the code compiles and runs, but then it doesn't solve the problem.
I am using Compile Online to test/run my code. The error it throws is:
$gosh main.scheme
gosh: "error": pair required, but got a

A pair of parentheses are missing in the fourth line, try this:
(define (num_items X)
(cond
((null? X) 0)
((list? (car X)) (+ (num_items (car X)) (num_items (cdr X))))
(else (+ 1 (num_items (cdr X))))))
Other than that, the code is fine. Just a minor suggestion: don't close parentheses in a separate line, close them all at the end. Also, notice that you can replace list? with pair? (or cons?, depending on which one is available in your interpreter). This is cheaper than testing if the value is a list.

Related

Why does this arithmetic code return lists?

I'm currently working my way through exercise 3.17 of SICP. I know that I'm messing it up and I intend to fix that later. I will not link the exercise, as it is not relevant. This was one of my attempts:
#lang sicp
(define (count-pairs x)
(define encountered '())
(define counter 0)
(define (loop x)
(set! counter (+
(cond
((null? x) 0)
((not (pair? x)) 0)
((null? encountered) (set! encountered (list (car x))) 1)
((eq? (car x) (car encountered)) 0)
(else 1))
counter))
(if (not (pair? x)) counter (begin (loop (car x))
loop (cdr x))))
(loop x))
(count-pairs (list 'a 'b 'c))
(define second (cons 'a 'b))
(define third (cons 'a 'b))
(define first (cons second third))
(set-car! third second)
(count-pairs first)
(define 3rd (cons 'a 'b))
(define 2nd (cons 3rd 3rd))
(define 1st (cons 2nd 2nd))
(count-pairs 1st)
To my shock, this returned:
(b c)
((a . b) . b)
((a . b) a . b)
How is this possible? I know that this code isn't even close to doing as intended, but as far as I can see it should only do arithmetic and therefore return numbers. How is it possible for this code to return list structures?
Get a new IDE. Stack Overflow's syntax highlighting makes this a dead giveaway.
(begin (loop (car x))
loop (cdr x))))

Appending reversed list in Scheme

I am learning Scheme and wanted to write a recursive program that reverses a given list.
In one test case however, I noticed that a (b c) e -> e (b c) a.
What I'm trying to get is a (b c) e -> e (c b) a.
This is what I have:
(define (deep-reverse lst)
(if (null? lst)
'()
(begin
(display (car lst))
(display "\n")
(if (null? (cdr lst))
'()
(append (deep-reverse (cdr lst)) (list (reverse (car lst))))
) //End of inner if
))) //End of begin, outer if, define
When I attempt to run the code with
(deep-reverse '(1 (b c) (a b)))
I get:
1
(b c)
(a b)
mcdr: contract violation
expected: mpair?
given: 1
The issue is with (list (reverse (car lst))), although in an isolated test case it works fine. Which leads me to believe that the issue may have to do with append.
Thank you in advance.
Edit: Going from (list (reverse (car lst))) to (reverse (list(car lst))) makes the code run without an error but doesn't reverse (a b) to (b a).
As the error message explains, your problem is that you are trying to reverse a number. Firstly, let's remove some of the unnecessary conditions and debugging stuff in your program, arriving at this simpler program. Let's step through this program to see what's going on:
(define (deep-reverse lst)
(if (null? lst)
'()
(append (deep-reverse (cdr lst)) (list (reverse (car lst))))))
We start with
(deep-reverse '(1 (b c) (a b)))
Substituting the argument we get
(if (null? '(1 (b c) (a b)))
'()
(append (deep-reverse (cdr '(1 (b c) (a b))))
(list (reverse (car '(1 (b c) (a b)))))))
Because the condition is #f, this simplifies to
(append (deep-reverse (cdr '(1 (b c) (a b))))
(list (reverse (car '(1 (b c) (a b))))))
To evaluate the first argument, first find the cdr, and call deep-reverse on that. I will skip the steps here but you should easily be able to test that it works correctly.
(append '((b a) (c b)) (list (reverse (car '(1 (b c) (a b))))))
Next we evaluate the car:
(append '((b a) (c b)) (list (reverse 1)))
And here we see what the problem is: we can't reverse a single number!
The issue is that your deep-reverse should have two distinct behaviours recursively:
on a number, or symbol, or other non-list entity, don't do anything, because it does not make sense to reverse a number
on a list, deep reverse it
There are two reasons why your current program does not do this properly:
it only does a shallow reverse on the elements of the list; that is, it won't deep reverse '(((a b) (c d)) ((e f) (g h))) correctly
it fails if it ever encounters a number or other non-list, like a symbol
The easy fix is to add a condition to check if it's a pair? first before attempting to reverse it. If it's not pair?, then lst must either be nil (which we may leave as-is) or a non-list object (which we may also leave as-is)
(define (deep-reverse lst)
(if (pair? lst)
(append (deep-reverse (cdr lst)) (list (deep-reverse (car lst))))
lst))
Finally, I should note that the pattern we are using here is really a foldr pattern. We can abstract away this pattern with foldr:
(define (deep-reverse xs)
(cond ((pair? xs)
(foldr (lambda (x y) (append y (list (deep-reverse x)))) '() xs))
(else xs)))
But we note also that this is inefficient, because append is an expensive operation. Modifying the algorithm to a tail recursive one makes it clear that this is actually a foldl:
(define (deep-reverse xs)
(cond ((pair? xs)
(foldl (lambda (x y) (cons (deep-reverse x) y)) '() xs))
(else xs)))
which is how such a function might be written in typical idiomatic Scheme, or as pointed out by Will Ness,
(define (deep-reverse xs)
(cond ((pair? xs) (reverse (map deep-reverse xs)))
(else xs)))

How to transform a list into a set in LISP?

I have been trying to transform a linear list into a set but with no avail. Everytime I run this, I get some weird compilation errors like "badly formed lambda" which points to the way I use append. Here is my code:
(defun mem(e l)
(cond
((null l) nil)
((equal e (car l)) t)
((listp (car l)) (mem e (car l)))
(t(mem e (cdr l)))
)
)
(defun st(l k)
(cond
((null l) nil)
(( mem '(car l) 'k) (st (cdr l) k))
((listp (car l)) (st (car l) k))
( t (st (cdr l) (append((car l) k)) ))
(t(mem e (cdr l)))
)
)
EDIT: frankly I just want to remove the duplicates from list l
Prefer Standard Library Functions
EDIT: frankly I just want to remove the duplicates from list l
Common Lisp has a remove-duplicates function. The documentation inclues examples:
Examples:
(remove-duplicates "aBcDAbCd" :test #'char-equal :from-end t) => "aBcD"
(remove-duplicates '(a b c b d d e)) => (A C B D E)
(remove-duplicates '(a b c b d d e) :from-end t) => (A B C D E)
(remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
:test #'char-equal :key #'cadr) => ((BAR #\%) (BAZ #\A))
(remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
:test #'char-equal :key #'cadr :from-end t) => ((FOO #\a) (BAR #\%))
Are you trying to flatten the list too?
From your code for mem, where you do:
((listp (car l)) (mem e (car l)))
it looks like you want your member function to also recurse into sublists. That's a bit questionable, even when working with sets, since sets can traditionally include other sets. E.g., {{3},{4},5} is a set containing 5, the set {3}, and the set {4}. It's not the same as the set {3,4,5}. Your st function also looks like it's trying to recurse into lists, which makes it seem like you want to flatten you lists, too. Again, that's a bit questionable, but if you want to do that, then your conversion to a set would be easier as a "flatten, then remove duplicates" process:
(defun flatten (list)
"Returns a fresh list containing the leaf elements of LIST."
(if (listp list)
(mapcan 'flatten list)
(list list)))
;; CL-USER> (flatten '(1 2 (3 4) 5 ((6))))
;; (1 2 3 4 5 6)
(defun to-set (list)
"Returns a set based on the elements of LIST. The result
is a flat list containing the leaf elements of LIST, but
with any duplicate elements removed."
(delete-duplicates (flatten list)))
;; CL-USER> (to-set '(1 3 (3 4) ((4) 5)))
;; (1 3 4 5)
Notes
I get some weird compilation errors like "badly formed lambda" which points to the way I use append.
Yes, you're trying to call append like: (append((car l) k)). That's actually not a problem for append. Remember, the syntax for a function call in Lisp is (function argument…). That means that you've got:
(append ((car l) k))
<function> <argument1>
But your argument1 is also a function call:
((car l) k )
<function> <argument1>
In Common Lisp, you can't use (car l) as a function. The only thing that can appear for a function is a symbol (e.g., car, append) or a lambda expression (e.g., (lambda (x) (+ x 1)).
You want to call (append (car l) k) instead.
First, CL does not have a set data type.
Lists, however, can be used as sets, you do not need to write any special code for that.
Second, I don't understand what your st function is supposed to do, but I bet that in the second cond clause you should not quote (car l) and k. You should use meaningful names for your functions and avoid abbreviations. As per your explanation in the comment, you should use pushnew instead.
Third, your mem function is quite weird, I am pretty sure you do not mean what you wrote: e is searched along a path in the tree l, not in the list l. As per your explanation in the comment, you should check both car and cdr:
(defun tree-member (tree element &key (test #'eql))
(if (consp tree)
(or (tree-member (car tree) element :test test)
(tree-member (cdr tree) element :test test))
(funcall test element tree)))

Procedures on lists (scheme)

I am writing a procedure which returns a list with all of the negative odd and positive
even integers removed (strings can stay), by using lambda in the primitive filter procedure. I also am avoiding using recursion, but that is what's stumping me.
What I have so far is:
(define (f2b lst)
(cond ((null? lst)'()) ; if the list is empty, return the empty list
((pair? (car lst)) ; if the current element isn't a list
(filter (lambda (x) (or (even? x) (positive? x))) (car lst))
(filter (lambda (x) (or (odd? x) (negative? x))) (car lst)))
(else (string? (car lst)) ;otherwise, if the current element is a string,
(car lst) ; then return that element
(f2b (cdr lst)))))
I'm also not sure how I can apply both of the filter procedures at the same time.
It's way simpler than that. All you have to do is filter the list. You just need the appropriate predicate.
When do you want to keep an element? You phrased it in terms of what you want to remove, so let's start with that. You want to remove if it's a negative odd or a positive even integer, and leave everything else in. It's easier to break it down into smaller functions.
(define (positive-even? x) (and (positive? x) (even? x)))
(define (negative-odd? x) (and (negative? x) (odd? x)))
(define (remove-num? x) (or (positive-even? x) (negative-odd? x)))
This defines whether to keep a number. But the list element might not be a number. So we
keep it if it's not a number, or if it doesn't match remove-num?:
(define (keep-element? x) (or (not (number? x)) (not (remove-num? x))
Then your function just has to call filter:
(define (f2b lst) (filter keep-element? lst))
Seems to work:
(f2b '(-4 -3 -2 -1 0 1 2 3 4 "a string" "another"))
=> (-4 -2 0 1 3 "a string" "another")
Here's how it would look as one big honkin' function:
(define (f2b lst)
(filter
(lambda (x)
(or (not (number? x))
(not (or (and (positive? x) (even? x))
(and (negative? x) (odd? x))))))
lst)
Personally, the nested or not or and gets a bit hard to read for my taste...
Ok, apparently you have nested lists. All you have to do here is map the result of the filter with a function which:
when given a list, returns (f2b lst)
otherwise, returns the element unchanged.
I will leave it as an exercise for you since, if you thought my function could possibly work on a nested list, clearly you have a lot of learning to do...

(Scheme) Find out if some of the numbers in a list add up to a certain number?

I'm making a program that takes a list and a sum. If some of the numbers in the list add up to the sum, it returns true. Else, return false. It seems to be working for some cases but not for others. For example,
if I input this:
(numlist-sum '(5 9) 9)
It should return true because one of the numbers (9) equals the sum (9). But, for some reason, its returning false.
I can't figure out what the problem is. Help please?
(define (numlist-sum? ls sum)
(if (null? ls) #t
(if (and (null? (cdr ls)) (equal? (car ls) sum)) #t
(if (equal? (car ls) sum) #t
(if (equal? (cdr ls) sum) #t
(if (equal? (apply + (car ls) (cdr ls)) sum) #t
#f))))))
I'll give you some hints for solving this problem (looks like homework). First write a procedure that generates all the possible subsets of the list (e.g., the power set of the list). For example:
(powerset '(1 2 3))
=> '(() (1) (2) (3) (1 2) (1 3) (2 3) (1 2 3))
With the above procedure in hand (and it's easy to find the algorithm, Google is your best friend), simply iterate over each of the sublists and sum its values:
(apply + '(2 3))
=> 5
If one of the sublists' sum equals the expected value, return #t. If none of the sums satisfy the expected value, return #f.
EDIT:
I forgot to mention, this is a well-known problem - it's the subset sum problem, which can be efficiently solved (at least, more efficiently than generating the power set) using dynamic programming. But I don't think that's the goal of this homework in particular.
Here is a solution that checks each element one by one and then recurses down the list if the first element isn't the sum.
(define (numlist-sum list sum)
(and (not (null? list))
(let ((head (car list)))
(cond ((number? head)
(or (= sum head)
(numlist-sum (cdr list) sum)))
((list? head)
(or (= sum (apply + head))
(numlist-sum (cdr list) sum)))
(else 'ill-formed-list)))))
Also, note that your code can be rewritten as:
(define (numlist-sum? ls sum)
(or (null? ls)
(if (and (null? (cdr ls)) (equal? (car ls) sum))
(equal? (car ls) sum)
(equal? (cdr ls) sum)
(equal? (apply + (car ls) (cdr ls)) sum)))
I'd say the use of '(if pred #t else ...) is a bit awkward and hides the true logic of the code.