I need to have a recursive function that uses a custom filter function to return the mode of a list. If there is more than 1 mode, it should return both.
For example: L = (1 3 5 2 3 5) --> ((3 2) (5 2))
Where the first number is the element from the list and the second number is the number of occurrences in the list.
I have the functions that compute the occurrences:
;;; FUNCTION NAME: occr2
;;; DESCRIPTION: function counts all occurrences of an element in a list
;;; NOTES: helper function for model
(defun occr2 (k L)
(cond ((null L) 0)
((eql k (first L)) (+ 1 (occr2 k (rest L))))
(t (occr2 k (rest L)))))
;;; FUNCTION NAME: occr
;;; DESCRIPTION: function returns list of occurrence of each element in a list
;;; NOTES: helper function for model
(defun occr (L)
(cond ((null L) NIL)
(t (cons (cons (first L) (cons (occr2 (first L) L) NIL)) (occr (remv (first L) L))))))
When I run this on the list '(1 3 5 2 3 5) --> ((1 1) (3 2) (5 2) (2 1))
Now, how can I use a recursive filter function to return only the (3 2) and (5 2)?
Beyond homework it might look like this:
(defun mode (l &aux (table (make-hash-table)))
(loop for e in l do (incf (gethash e table 0)))
(let ((max (loop for v being the hash-value of table maximize v)))
(loop for key being the hash-keys of table using (hash-value value)
when (eql value max)
collect (list key value))))
There may be a more direct way to compute the mode of a list, but since you've already a "histogram" function that returns a list of each element and its frequency, you can just use an argmax function to find the elemens that maximize the frequency:
(defun argmax (function list)
"ARGMAX returns a list of the elements of LIST that maximize
FUNCTION."
(if (endp list)
(error "Cannot maximize over an empty list.")
(destructuring-bind (best &rest list) list
(do* ((bests (list best))
(max (funcall function best)))
((endp list) bests)
(let* ((x (pop list))
(val (funcall function x)))
(cond
((> val max)
(setf bests (list x)
max val))
((= val max)
(push x bests))))))))
CL-USER> (argmax 'second '((1 1) (3 2) (5 2) (2 1)))
((5 2) (3 2))
Here is what I was able to finally come up with. For my class, we are not allowed to use built-in functions. I basically find the highest occurrence of any value, and compare each elements occurrence to that value, filtering out any element that is less than the mode value. This way if 2+ elements have the same occurrence, the filter still keeps them.
;;; FUNCTION NAME: occr2
;;; DESCRIPTION: function counts all occurrences of an element in a list
;;; NOTES: helper function for model
(defun occr2 (k L)
(cond ((null L) 0)
((eql k (first L)) (+ 1 (occr2 k (rest L))))
(t (occr2 k (rest L)))))
;;; FUNCTION NAME: occr
;;; DESCRIPTION: function returns list of occurrence of each element in a list
;;; NOTES: helper function for model
(defun occr (L)
(cond ((null L) NIL)
(t (cons (cons (first L) (cons (occr2 (first L) L) NIL)) (occr (remv (first L) L))))))
;;; FUNCTION NAME: filter
;;; DESCRIPTION: function filters elements out of a list based on a boolean function parameter
;;; NOTES: helper function for model
(defun filter (F L)
(cond ((null L) NIL)
((funcall F (first L)) (cons (first L) (filter F (rest L))))
(t (filter F (rest L)))))
;;; FUNCTION NAME: findmax
;;; DESCRIPTION: function finds the max occurrence of elements in a list
;;; NOTES: helper function for model
(defun findmax (L)
(cond ((null (rest L)) (second (first L)))
((> (second (first L)) (second (second L)))
(findmax (cons (first L) (rest (rest L)))))
(t (findmax (cons (second L) (rest (rest L)))))))
;;; FUNCTION NAME: model
;;; DESCRIPTION: function uses filter to return the mode(s) of a list of elements
;;; NOTES: uses occr, occr2, filter, and findmax helper functions
(defun model (L)
(filter (lambda (x)
(>= (second x) (findmax (occr L))))
(occr L)))
(model '(1 3 5 2 3 5)) --> ((3 2) (5 2))
(model '(1 3 5 2 4 5)) --> ((5 2))
There may be a simpler way to do this, but this does work.
Related
I'm trying to write a function in Scheme that returns the first n elements in a list. I'm want to do that without loops, just with this basic structure below.
What I've tried is:
(define n-first
(lambda (lst n)
(if (or(empty? lst) (= n 0))
(list)
(append (car lst) (n-first (cdr lst) (- n 1))))))
But I'm getting an error:
append: contract violation
expected: list?
given: 'in
I've tried to debug it and it looks that the tail of the recursion crashes it, meaning, just after returning the empty list the program crashes.
When replacing "append" operator with "list" I get:
Input: (n-first '(the cat in the hat) 3)
Output:
'(the (cat (in ())))
But I want to get an appended list.
A list that looks like (1 2 3) i constructed like (1 . (2 . (3 . ()))) or if you're more familiar with cons (cons 1 (cons 2 (cons 3 '()))). Thus (list 1 2 3)) does exactly that under the hood. This is crucial information in order to be good at procedures that works on them. Notice that the first cons cannot be applied before the (cons 2 (cons 3 '())) is finished so a list is always created from end to beginning. Also a list is iterated from beginning to end.
So you want:
(define lst '(1 2 3 4 5))
(n-first lst 0) ; == '()
(n-first lst 1) ; == (cons (car lst) (n-first (- 1 1) (cdr lst)))
(n-first lst 2) ; == (cons (car lst) (n-first (- 2 1) (cdr lst)))
append works like this:
(define (append lst1 lst2)
(if (null? lst1)
lst2
(cons (car lst1)
(append (cdr lst1) lst2))))
append is O(n) time complexity so if you use that each iteration of n parts of a list then you get O(n^2). For small lists you won't notice it but even a medium sized lists of a hundred thousand elements you'll notice append uses about 50 times longer to complete than the cons one and for large lists you don't want to wait for the result since it grows exponentially.
try so
(define first-n
(lambda (l)
(lambda (n)
((lambda (s)
(s s l n (lambda (x) x)))
(lambda (s l n k)
(if (or (zero? n)
(null? l))
(k '())
(s s (cdr l) (- n 1)
(lambda (rest)
(k (cons (car l) rest))))))))))
(display ((first-n '(a b c d e f)) 4))
(display ((first-n '(a b)) 4))
In scheme you must compute mentally the types of each expression, as it does not have a type checker/ type inference included.
This seems straightforward, but I can't seem to find a solution. I want to replace an item within a list of a list with something, but if that item appears multiple times then you randomly replace one of them, but not both. I want to do this in ISL+.
I created the function flatten which appends all sublists :
(check-expect (flatten '((a b) (c) (d e f g) (h i j)))
(list 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j))
(define (flatten lol)
(foldr append empty lol))
I also made rewrite, which replaces the value at index n with whatever you choose
(check-expect (rewrite '(x x x - x x x x) 3 'x)
(list 'x 'x 'x 'x 'x 'x 'x 'x))
(define (rewrite ls n val)
(cond
[(empty? ls) (error "error")]
[(= n 0) (cons val (rest ls))]
[else (cons (first ls) (rewrite (rest ls) (sub1 n) val))]))
The problem is I don't know how to apply this to a list of list and I also don't know how to randomly replace one of items if it occurs more than once. This is what I have for the final product, but it's probably not the way to go:
(define (fullreplace b)
(local [
;makes a list of nested lists of each index the element occurs
;problem is that it makes a list of nested lists so I can't use flatten either
(define (position ls ele n)
(cond [(empty? ls) 0]
[(equal? ele (first ls)) (list n (position (rest ls) ele (add1 n))) ]
[else (position (rest ls) ele (+ 1 n))]))]
;lol-full? checks if the item occurs in the list of lists at all
(if (lol-full? b) b (rewrite (flatten b)
(position (flatten b) '- 0)
"item replaced"))))
;just used for testing
(define lol2 (list
(list 2 2 2 2)
(list 4 '- 4 '-)
(list '- 8 8 8)
(list 16 '- '- 16)))
(fullreplace lol2) may return this or where any of the other '- are located:
(list
(list 2 2 2 2)
(list 4 '- 4 2)
(list '- 8 8 8)
(list 16 '- '- 16))
I've been working on this awhile so any new insight would go a long way. Thank you
The "random" part is what makes this problem pathological. If you could just replace the first occurrence, it would be easy. But to replace a random occurence, you must first know how many occurrences there are. So before you go replacing stuff, you have to go a-counting:
(define (count/recursive val tree)
(cond ((equal? val tree)
1)
(else (foldl (λ (next-value total)
(cond ((equal? val next-value)
(add1 total))
((list? next-value)
(+ total (count/recursive val next-value)))
(else total))) 0 tree))))
Then you need a function that can replace the nth occurrence of a value:
(define (replace/recursive val replace-with n tree)
(cond ((equal? val tree)
replace-with)
(else
(cdr
(foldl (λ (next-value total/output-tree)
(local ((define total (car total/output-tree))
(define output-tree (cdr total/output-tree)))
(cond ((equal? next-value val)
(cons (add1 total)
(cons (if (= total n) replace-with next-value) output-tree)))
((list? next-value)
(cons (+ total (count/recursive val next-value))
(cons (replace/recursive val replace-with (- n total) next-value)
output-tree)))
(else (cons total (cons next-value output-tree)))))) (cons 0 empty) tree)))))
Finally, you use random to pick the instance you will replace, using count/recursive to limit how high of a number random picks:
(define original '((x x (x y x) a b (((c x z x) x) y x x))))
(replace/recursive 'x '- (random (count/recursive 'x original)) original)
How to replace all occurences of a value with another value:
(define (replace-all needle new-value haystack)
(cond ((equal? needle haystack) new-value)
((pair? haystack)
(cons (replace-all needle new-value (car haystack))
(replace-all needle new-value (cdr haystack))))
(else haystack)))
The only thing to change is to check if the first part constituted a change. If it did you don't do the replace on the other half. Use equal? to compare structure.
It's not random. It will replace the first occurence it finds either by doing car before cdr or cdr before car.
This is what I want:
(delete-third1 '(3 7 5)) ==> (3 7)
(delete-third1 '(a b c d)) ==> (a b d)
so I did something like:
(define (delete-third1 LS ) (list(cdr LS)))
which returns
(delete-third1 '(3 7 5))
((7 5))
when it should be (3 7). What am I doing wrong?
Think about what cdr is doing. cdr says that "given a list, chop off the first value and return the rest of the list". So it's removing only the first value, then returning you the rest of that list (which is exactly what you are seeing). Since it returns a list, you don't need a list (cdr LS) there either.
What you want is something like this:
(define (delete-n l n)
(if (= n 0)
(cdr l)
(append (list (car l)) (delete-n (cdr l) (- n 1)))))
(define (delete-third l)
(delete-n l 2))
So how does this work? delete-n will delete the nth element of a list by keeping a running count of what element we are up to. If we're not up to the nth element, then add that element to the list. If we are, then skip that element and add the rest of the elements to our list.
Then we simply define delete-third as delete-n where it removes the 3rd element (which is element 2 when we start counting at 0).
The simplest way would be: cons the first element, the second element and the rest of the list starting from the fourth position. Because this looks like homework I'll only give you the general idea, so you can fill-in the blanks:
(define (delete-third1 lst)
(cons <???> ; first element of the list
(cons <???> ; second element of the list
<???>))) ; rest of the list starting from the fourth element
The above assumes that the list has at least three elements. If that's not always the case, validate first the size of the list and return an appropriate value for that case.
A couple more of hints: in Racket there's a direct procedure for accessing the first element of a list. And another for accessing the second element. Finally, you can always use a sequence of cdrs to reach the rest of the rest of the ... list (but even that can be written more compactly)
From a practical standpoint, and if this weren't a homework, you could implement this functionality easily in terms of other existing procedures, and even make it general enough to remove elements at any given position. For example, for removing the third element (and again assuming there are enough elements in the list):
(append (take lst 2) (drop lst 3))
Or as a general procedure for removing an element from a given 0-based index:
(define (remove-ref lst idx)
(append (take lst idx) (drop lst (add1 idx))))
Here's how we would remove the third element:
(remove-ref '(3 7 5) 2)
=> '(3 7)
This works:
(define (delete-third! l)
(unless (or (null? l)
(null? (cdr l))
(null? (cddr l)))
(set-cdr! (cdr l) (cdddr l)))
l)
if you want a version that does not modify the list:
(define (delete-third l)
(if (not (or (null? l)
(null? (cdr l))
(null? (cddr l))))
(cons (car l) (cons (cadr l) (cdddr l)))
l))
and if you want to do it for any nth element:
(define (list-take list k)
(assert (not (negative? k)))
(let taking ((l list) (n k) (r '()))
(if (or (zero? n) (null? l))
(reverse r)
(taking (cdr l) (- n 1) (cons (car l) r)))))
(define (delete-nth l n)
(assert (positive? n))
(append (list-take l (- n 1))
(if (> n (length l))
'()
(list-tail l n))))
(define (nth-deleter n)
(lambda (l) (delete-nth l n)))
(define delete-3rd (nth-deleter 3))
I am a beginner in scheme and I want to know how you find the location of an element in a list. For example, in this given list,
(list 1 2 13)
I found the maximum using accumulative recursion, but I need to also find the location of the maximum, so if the function is:
(max-with-location (list 1 2 13)), I need to get: (list 13 (list 3))
Please help me out.
This sounds like homework, and if this is the case then any of these solutions won't help. What you're likely expected to do is to revise the code that you wrote to find the maximum: instead of a single accumulator input to the loop, add one more for the position of the maximum-so-far. That will not be too hard given that you already have implemented max.
I don't use Scheme, but in CL it's (position 13 (list 1 2 13))
Maybe it's the same...
So for your code, you'd want something like this:
(list (max (list 1 2 13)) (position (max (list 1 2 13)))
which would return (13 2)
edit: max is supposed to be your max algorithm, though I imagine there might already be a function for this
double edit: if that still doesn't work, you could always use a counter that increments each time through your recursive function, then return that as well...
first you have to determinate the max number:
(define max_list1
(lambda (l)
(cond
((empty? (rest l)) l)
(else (max_aux_list (first l) (rest l))))))
(define (max_aux_list n lista)
(cond
((empty? lista) n)
((> n (first lista)) (max_aux_list n (rest lista)))
(else (max_aux_list (first lista) (rest lista)))))
then you have to count the position number of an element.
(define find_in_position
(lambda (n lista)
(cond
((empty? lista) 0)
((= n (first lista)) 1)
(else (+ 1 (find_in_position n (rest lista)))))))
finally, list both resoults.
(define (the_max_in_position lista)
(list (max_list1 lista)
(list (find_in_position (max_list1 lista) lista))))
This should do the trick:
(define (find-position list element #!optional (pred eq?))
(letrec ((loop (lambda (list count)
(if (null? list) #f ;No such element found
(if (pred (car list) element) count
(loop (cdr list) (+ count 1)))))))
(loop list 0)))
Then:
(find-position (list 1 3 13) 13)
>>> 2
Use list-ref like so:
(define tlist '(a b c d))
(list-ref tlist 2)
>> c
I am trying to write some code that will loop through a list and add like terms. I'm trying to cons the cdr of the input list to a null list and then just compare the car of the list to the car of the new list and traverse down the list but my code just isn't working. What am I doing wrong here?
(define loop-add
(lambda (l temp outputList)
(if (or (equal? (cdr l) '()) (equal? (pair? (car l)) #f))
outputList
(if (equal? l '())
outputList
(let ((temp (cdr l)))
(if (equal? temp '())
(loop-add (cdr l) outputList)
(if (equal? (cdr (car l)) (cdr (car temp)))
(loop-add l (cdr temp) (cons (append (cdr (car l)) (cdr (car (cdr l)))) outputList))
(loop-add l temp outputList))))))))
but the problem now is at the end line its just going to be an infinite loop. I need a way to recur with the input list but with temp being the cdr of the previous temp list.
Start by writing a procedure that can transform your input list into a new list of the unique terms in the original list, so
(get-unique-terms '((2 1) (3 4) (5 3) (2 4)))
(1 4 3) ; or something like that
Call this new list TERMS. Now for each element in TERMS you can search the original list for matching elements, and get a sum of the coefficients:
(define (collect-like-terms l)
(let ((terms (get-unique-terms l)))
;; For each element of TERMS,
;; Find all elements of L which have a matching term,
;; Sum the coefficients of those elements,
;; Make a record of the sum and the term a la L.
;; Collect the results into a list and return.
Here's a simple solution in Racket:
(define (loop-add l)
(define table
(for/fold ([h (hash)]) ([i l])
(dict-update h (cadr i) (lambda (v) (+ v (car i))) 0)))
(dict-map table (lambda (key val) (list val key))))
(loop-add '((2 1) (3 4) (5 3) (2 4)))