I'm doing a project for college in Common Lisp
And I need to compare a 4x4 list
Example:
(
((white full circle) (black empty circle) (black full circle) (white empty circle))
(0 0 0 0)
(0 0 0 0)
(0 0 0 0)
)
I need to compare if a line have 4 lists that share an element, in this case "circle"
and I can't use any defvar like intersection, need to use it recursively, and I can't find a way to do it
Try this:
(defun find-common (x)
(labels ((compare (items lst)
(cond ((null items) nil)
((not (remove-if #'(lambda (k) (member (car items) k)) lst))
(cons (car items) (compare (cdr items) lst)))
(t (compare (cdr items) lst)))))
(cond ((null x) nil)
(t (cons (compare (caar x) (car x))
(find-common (cdr x)))))))
To see if a list of list shares a common element, we have to check if each element in the car of that list also occurs in each list of its cdr. That's what the compare function does. It checks if an element occurs in all the lists recursively.
The find-common function recursively searches for all common occurrences in the list of lists.
Let's assume table is your 4 x 4 list:
(setf table
'(((white full circle) (black empty circle) (black full circle) (white empty circle))
((3 2 8 5) (2 9 1 8) (23 8 2 1) (3 8 0 2))
((one five six) (six one five) (five one six) (one six five))
((green blue red) (green red blue) (silver red white) (green yellow blue))))
Calling the find-common function:
>(find-common table)
((CIRCLE) (2 8) (ONE FIVE SIX) NIL)
Related
We need a Scheme function called nondecreaselist, which takes in a list of numbers and outputs a list of lists, which overall has the same numbers in the same order, but grouped into lists that are non-decreasing.
For example, if we have input (1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1), the output should be:
((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))
How would you implement this? I know we have to use recursion.
My attempt so far:
(define (nondecreaselist s)
(cond ((null? s) '())
((cons (cons (car s)
((if (and (not (null? (cadr s)))
(not (> (car s) (cadr s))))
((cadr s))
('()))))
(nondecreaselist (cdr s))))))
However, this gives me the error:
(int) is not callable:
(define decrease-list
(lambda (l)
((lambda (s) (s s l cons))
(lambda (s l col)
;; limitcase1: ()
(if (null? l)
(col '() '())
;; limitcase2: (a1)
(if (null? (cdr l))
(col l '())
(let ((a1 (car l)) (a2 (cadr l)))
;; limitcase3: (a1 a2)
(if (null? (cddr l))
(if (>= a2 a1)
(col l '())
(col (list a1) (list (cdr l))))
;; most usual case: (a1 a2 ...)
(s s (cdr l)
(lambda (g l*)
(if (>= a2 a1)
(col (cons a1 g) l*)
(col (list a1) (cons g l*)))))))))))))
1 ]=> (decrease-list '(1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1))
;Value: ((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))
I did not comment it, if you have questions you can ask but I think you can also study yourself the code I wrote for you now.
Note also that one can consider the limit cases () and (a1) out of the loop and check these cases only once:
(define decrease-list
(lambda (l)
;; limitcase1: ()
(if (null? l)
'()
;; limitcase2: (a1)
(if (null? (cdr l))
(list l)
((lambda (s) (s s l cons))
(lambda (s l col)
(let ((a1 (car l)) (a2 (cadr l)))
;; limitcase3: (a1 a2)
(if (null? (cddr l))
(if (>= a2 a1)
(col l '())
(col (list a1) (list (cdr l))))
;; most usual case: (a1 a2 ...)
(s s (cdr l)
(lambda (g l*)
(if (>= a2 a1)
(col (cons a1 g) l*)
(col (list a1) (cons g l*)))))))))))))
There are a few problems with the posted code. There is no test expression in the second cond clause; there are too many parentheses around the if and its clauses. Perhaps the most significant problem is that the code is attempting to build a non-decreasing list, which is to be consed to the result of (nondecreaselist (cdr s)), but when the non-decreasing sequence is more than one number long this starts again too soon in the input list by going all the way back to (cdr s).
Fixing Up OP Code
The logic can be cleaned up. OP code already is returning an empty list when input is an empty list. Instead of testing (null? (cadr s)) (when (cdr s) is '(), cadr won't work on s), one could test (null? (cdr s)) before code attempts a (cadr s). But it is even better to move this logic; when the input list contains one element, just return a list containing the input list: ((null? (cdr s)) (list s)).
Instead of (and (not (> ;... the logic can be made more clear by testing for > and executing the appropriate action. In this case, when (> (car s) (cadr s)) a new sublist should be started, and consed onto the list of sublists that is the result returned from nondecreaselist.
Otherwise, (car s) should be added to the first sublist in the result returned from nondecreaselist. To accomplish this, we need to construct the return list by consing s onto the first sublist, and then consing that new sublist back onto the cdr of the list of sublists that is the result returned from nondecreaselist.
Here is some revised code:
(define (nondecreaselist s)
(cond ((null? s) '())
((null? (cdr s)) (list s))
((> (car s) (cadr s))
(cons (list (car s))
(nondecreaselist (cdr s))))
(else
(let ((next (nondecreaselist (cdr s))))
(cons (cons (car s)
(car next))
(cdr next))))))
Using a Helper Function
Another approach would be to define a helper function that takes an input list and an accumulation list as arguments, returning a list of lists. The helper function would take numbers from the front of the input list and either add them to the accumulator, creating a non-decreasing list, or it would cons the accumulated non-decreasing list to the result from operating on the rest of the input.
If the input lst to the helper function ndl-helper is empty, then a list containing the accumulated non-decreasing list sublst should be returned. Note that sublst will need to be reversed before it is returned because of the way it is constructed, as described below.
If the accumulator sublst is empty, or if the next number in the input list is greater-than-or-equal-to the largest number in the sublst, then the next number should simply be added to the sublst. By consing the number onto the front of sublst, only the car of sublst needs to be checked, since this will always be the largest (or equal to the largest) value in sublst. But, since sublst is in reverse order, it will need to be reversed before adding it to the growing list of lists.
Otherwise, lst is not empty, and sublst is not empty, and the next number in the input list is less than the largest number in sublst. Thus, a new sublist needs to be started, so the old sublst is reversed and consed onto the result of the remaining computation done by calling the helper function on the remaining lst with an empty accumulator sublst:
(define (nondecreaselist-2 lst)
(define (ndl-helper lst sublst)
(cond ((null? lst) (list (reverse sublst)))
((or (null? sublst)
(>= (car lst) (car sublst)))
(ndl-helper (cdr lst) (cons (car lst) sublst)))
(else
(cons (reverse sublst) (ndl-helper lst '())))))
(ndl-helper lst '()))
Both functions work:
> (nondecreaselist '(1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1))
((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))
> (nondecreaselist-2 '(1 2 3 4 1 2 3 4 1 1 1 2 1 1 0 4 3 2 1))
((1 2 3 4) (1 2 3 4) (1 1 1 2) (1 1) (0 4) (3) (2) (1))
I want to make a function that given a list and a natural number, adds zeros onto the list so the length of the list equals the natural number. What is an efficient way of doing this so instead of making every element zero, it does what it's supposed to do
(define (zero-list loz alon)
(cond
[(empty? loz) empty]
[(= (-(length loz) 1) alon) (cons 0 loz)]
[else (cons 0 (zero-list (rest loz)))]))
Example:
(zero-list (list 1 2 3) 5)) -> (list 0 0) so (length (list 1 2 3)) + (length (list 0 0)) = 5
Use make-list to generate a list that has the appropriate number of 0s (i.e. difference between the number and the length of the input list):
(define (zero-list l n)
(make-list (- n (length l)) 0))
(zero-list (list 1 2 3) 5) ; -> (list 0 0)
I have a circular list, eg: #0=(1 2 3 4 . #0#).
What I want to do is to insert a new element (x) into this list so that the outcome is #0=(x 1 2 3 4 . #0#). I have been trying using this code (x is the circular list):
(define (insert! elm)
(let ((temp x))
(set-car! x elm)
(set-cdr! x temp)))
However, I think that set-cdr! is not working like I want it to. What am I missing here? Maybe I am way off?
The easiest way to prepend an element to a list is to modify the car of the list, and set the cdr of the list to a new cons whose car is the original first element of the list and whose cdr is the original tail of the list:
(define (prepend! x list) ; list = (a . (b ...))
(set-cdr! list (cons (car list) (cdr list))) ; list = (a . (a . (b ...)))
(set-car! list x)) ; list = (x . (a . (b ...)))
(let ((l (list 1 2 3)))
(prepend! 'x l)
(display l))
;=> (x 1 2 3)
Now, that will still work with circular lists, because the cons cell (i.e., pair) that is the beginning of the list remains the same, so the "final" cdr will still point back to object that is the beginning. To test this, though, we need some functions to create and sample from circular lists, since they're not included in the language (as far as I know).
(define (make-circular list)
(let loop ((tail list))
(cond
((null? (cdr tail))
(set-cdr! tail list)
list)
(else
(loop (cdr tail))))))
(define (take n list)
(if (= n 0)
'()
(cons (car list)
(take (- n 1)
(cdr list)))))
(display (take 10 (make-circular (list 1 2 3))))
;=> (1 2 3 1 2 3 1 2 3 1)
Now we can check what happens if we prepend to a circular list:
(let ((l (make-circular (list 1 2 3))))
(prepend! 'x l)
(display (take 15 l)))
;=> (x 1 2 3 x 1 2 3 x 1 2 3 x 1 2)
Since you're trying to prepend an element to a circular list, you need to do two things:
Insert a new cons cell at the front of the list containing the additional element. This is easy because you can just perform a simple (cons elm x).
You also need to modify the recursive portion of the circular list to point at the newly created cons cell, otherwise the circular portion will only include the old parts of the list.
To perform the latter, you need a way to figure out where the "end" of the circular list is. This doesn't actually exist, since the list is, of course, circular, but it can be determined by performing an eq? check on each element of the list until it finds an element equal to the head of the list.
Creating a helper function to do this, a simple implementation of insert! would look like this:
(define (find-cdr v lst)
(if (eq? v (cdr lst)) lst
(find-cdr v (cdr lst))))
(define (insert! elm)
(set! x (cons elm x))
(set-cdr! (find-cdr (cdr x) (cdr x)) x))
I'm trying to write a function that works like remove-duplicates, but it instead takes two lists as input, the first specifying characters for which duplication is not allowed, and the second being a list of various atoms which is to be pruned.
Currently I have this:
(defun like-remove-duplicates (lst1 lst2)
(if(member (first lst1) lst2)
(remove-if #'(lambda (a b)
(equals a b))lst1 lst2)))
I know it's not anywhere near right, but I can't figure out what I need to do to perform this function. I know I essentially need to check if the first item in list1 is in list2, and if so, remove its duplicates (but leave one) and then move onto the next item in the first list. I envisioned recursion, but it didn't turn out well. I've tried researching, but to no avail.
Any help?
CL-USER> (defun remove-duplicates-from-list (forbidden-list list)
(reduce (lambda (x y)
(let ((start (position y x)))
(if start
(remove y x :start (1+ start))
x)))
forbidden-list
:initial-value list))
REMOVE-DUPLICATES-FROM-LIST
CL-USER> (remove-duplicates-from-list '(1 2) '(1 2 1 3))
(1 2 3)
CL-USER> (remove-duplicates-from-list '(1 2) '(1 2 1 3 2))
(1 2 3)
CL-USER> (remove-duplicates-from-list '(1 2) '(1 2 1 3 2 4))
(1 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(1 2 1 3 2 4))
(1 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(0 1 2 1 3 2 4))
(0 1 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(0 2 3 2 4))
(0 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(0 2 2 3 4))
(0 2 3 4)
Recursion is performed by reduce (because here we have the most common recursion pattern: feed the result of previous iteration to the next) and removeing is done with the help of :start parameter, that is the offset after the first encounter (found by position) of the value being removed currently.
It's also important to account the case, when the value isn't found and position returns nil.
Something like this should work and have acceptable time-complexity (at the cost of soem space-complexity).
(defun like-remove-duplicates (only-once list)
"Remove all bar the first occurence of the elements in only-once from list."
(let ((only-once-table (make-hash-table))
(seen (make-hash-table)))
(loop for element in only-once
do (setf (gethash element only-once-table) t))
(loop for element in list
append (if (gethash element only-once-table)
(unless (gethash element seen)
(setf (gethash element seen) t)
(list element))
(list element)))))
This uses two state tables, both bounded by the size of the list of elements to include only once and should be roughly linear in the sum of the length of the two lists.
(defun remove-listed-dups (a b)
(reduce (lambda (x y) (if (and (find y a) (find y x)) x (cons y x)))
b :initial-value ()))
If we had a list A holding (1 2 1 1 2 3 3 4 4 4), how could we get a new list B with ((1 . 30) (2 . 20) (3 . 20) (4 . 30)) in it, such that the number_after_dot is the percentage of the number_before_dot in the list A.
For example 1 is 30% of list A, 2 is 20% of list A, etc..
(1 . 30) is a pair, which could be made by (cons 1 30)
I think what you want to do is calculate the percentage of the list that is equal to each element. You used the word "unique" but that a bit confusing since your list has no unique elements. This is based on your sample input and output, where the list (1 2 1 1 2 3 3 4 4 4) is composed of "30% ones".
You can break this down roughly into a recursive algorithm consisting of these steps:
If the input list is empty, return the empty list.
Otherwise, get the first element. Calculate how many times it occurs in the list.
Calculate the percentage, and cons the element with this percentage.
Remove all the occurrences of the first item from the cdr of the list.
Recurse on this new list, and cons up a list of (element . percentage) pairs.
To do the first part, let's use filter:
> (filter (lambda (x) (eq? (car A) x)) A)
(1 1 1)
With your list A, this will return the list (1 1 1). We can then use length to get the number of times it occurs:
> (length (filter (lambda (x) (eq? (car A) x)) A))
3
To calculate the percentage, divide by the number of elements in the whole list, or (length A) and multiply by 100:
> (* 100 (/ (length (filter (lambda (x) (eq? (car A) x)) A)) (length A)))
30
It's easy to cons this with the element (car A) to get the pair for the final list.
To do the second step, we can use remove which is the inverse of filter: it will return a list of all elements of the original list which do not satisfy the predicate function:
> (remove (lambda (x) (eq? (car A) x)) A)
(2 2 3 3 4 4 4)
This is the list we want to recurse on. Note that at each step, you need to have the original list (or the length of the original list) and this new list. So you would need to somehow make this available to the recursive procedure, either by having an extra argument, or defining an internal definition.
There might be more efficient ways I'm sure, or just other ways, but this was the solution I came up with when I read the question. Hope it helps!
(define (percentages all)
(let ((len (length all))) ; pre-calculate the length
;; this is an internal definition which is called at ***
(define (p rest)
(if (null? rest)
rest
;; equal-to is a list of all the elements equal to the first
;; ie something like (1 1 1)
(let ((equal-to (filter (lambda (x) (eq? (car rest) x))
rest))
;; not-equal-to is the rest of the list
;; ie something like (2 2 3 3 4 4 4)
(not-equal-to (remove (lambda (x) (eq? (car rest) x))
rest)))
(cons (cons (car rest) (* 100 (/ (length equal-to) len)))
;; recurse on the rest of the list
(p not-equal-to)))))
(p all))) ; ***
The question formulation is very close to the idea of run-length encoding. In terms of run-length encoding, you can use a simple strategy:
Sort.
Run-length encode.
Scale the run lengths to get percentages.
You can implement run-length encoding like this:
(define (run-length-encode lst)
(define (rle val-lst cur-val cur-cnt acc)
(if (pair? val-lst)
(let ((new-val (car val-lst)))
(if (eq? new-val cur-val)
(rle (cdr val-lst) cur-val (+ cur-cnt 1) acc)
(rle (cdr val-lst) new-val 1 (cons (cons cur-val cur-cnt) acc))))
(cons (cons cur-val cur-cnt) acc)))
(if (pair? lst)
(reverse (rle (cdr lst) (car lst) 1 '()))
'()))
and scaling looks like:
(define (scale-cdr count-list total-count)
(define (normalize pr)
(cons (car pr) (/ (* 100 (cdr pr)) total-count)))
(map normalize count-list))
Now we need something to sort a list. I'll just use the sort function in racket (adapt as needed). The function to calculate the percentages for each number in the list is then:
(define (elem-percent lst)
(scale-cdr (run-length-encode (sort lst <)) (length lst)))
Some examples of use:
> (elem-percent '())
'()
> (elem-percent (list 1 2 3 4 5))
'((1 . 20) (2 . 20) (3 . 20) (4 . 20) (5 . 20))
> (elem-percent (list 1 2 1 1))
'((1 . 75) (2 . 25))
> (elem-percent (list 1 2 1 1 2 3 3 4 4 4))
'((1 . 30) (2 . 20) (3 . 20) (4 . 30))