Scheme: Counting Structures - list

(count-by-type
(list
(make-animal "Slytherin" "snake" (make-date 2013 8 23))
(make-animal "Toby" "dog" (make-date 2014 3 20))
(make-animal "Curly" "dog" (make-date 2014 1 18))
(make-animal "Maximus" "cat" (make-date 2013 10 7))
(make-animal "Mia" "cat" (make-date 2013 10 7))))
=> (list (list 2 "cat") (list 2 "dog") (list 1 "snake"))
;; A Date is a structure (make-date y m d), where
;; y is positive integer (year),
;; m is an integer between 1 and 12 (month),
;; d is an integer between 1 and 31 (day of the month).
(define-struct date (year month day))
;; An Animal is a structure (make-structure n t a), where
;; n is a nonempty string (name of animal),
;; t is a nonempty string (type of animal),
;; a is a Date (date animal arrived at the shelter).
(define-struct animal (name type arrival))
Note: The applicable data structures as at the top.
So I am trying to make a function (in Scheme using Dr. Racket) that consumes a list of Animal structures and produces a list of lists.
The elements in the produced lists are of the form (list number type) where type is the type of animal and number is the number of that animal type in the consumed list.
This much is doable for me, but here is where the issues comes in: -> The list needs to be in descending order -> Even worse, in the event of a tie between any number of pairs of lists, alphabetical sorting is utilized.
Note: I wish to only solve this using abstract list functions excluding build-list and lambda (as I wish to strengthen my ability to solve such problems without advanced abstract functions)
Keeping that in mind, I know this problem will use the abstract functions map, filter, and foldr, but can't quite think of how.
Any help is appreciated.

If you do (map animal-type list-of-animals) you get a list consisting just of the types like ("snake" "dog" "cat" "dog" "cat")
I imagine your list can be mixed (like in my example) so if you (sort list-of-animal-types string>?) you have a sorted list in descending order.
Given the list has at least one element:
(let rec ((cur (car sorted-list-of-animal-types))
(cnt 1)
(lst (cdr sorted-list-of-animal-types))
(acc '()))
(cond ((equal? cur <??>) (rec cur (add1 <??>) <??> acc))
(else (rec <??> 1 <??> (cons (list cnt cur) <??>)))))
This will produce a list in ascending order with counts. It's possible to do this with a fold, but it's probably not fewer lines than using a named let.
If you sort again:
(sort list-of-animal-types-and-counts (lambda (x y) (>= (car x) (car y)))
sort in Racket is stable. That means if you have two with equal counts in the list they will end up in their original order. The original order was the ascending animal order so the result is ordered by count descending, then name ascending.
I guess your procedure can be made by chaining these together using let to store intermediates to make expressions shorter and more readable.
Using a hash you could do it with only one pass through the unsorted list, then produced a list that then was sorted with a sepcial sort function that sorts by count, then animal type.

Related

How to get the cheapest fruit

I am practicing DrRacket. Here is the task description:
Recursion is not allowed, you must use filter or map/or/andmap or foldr/foldl to loop through lists. creat a function names cheapest-fruit=bundle and receive a list of fruits as parameter. you input lists of fruit-bundles and want to get the cheapest fruit-bundle. If two fruit-bundles are both the cheapest, then chose the one with more kinds of fruit.
(define-struct fruit (name price))
(define (cheapest-fruit-bundle fruits)...)
check-expected:
giving list: (list (list (make-fruit 'apple 3) (make-fruit 'banana 4) (make-fruit 'avocado 5))
(list (make-fruit 'apple 7)(make-fruit 'avocado 5))
(list (make-fruit 'apple 7)(make-fruit 'avocado 9) (make-fruit 'banana 2)))
results: (list (make-fruit 'apple 3) (make-fruit 'banane 4) (make-fruit 'avocado 5))
I have solved this problem a bit: I can sum up the price in list and find the smallest element. But I want to get the cheapest bundle and choose the bundle with more kinds of fruits. I get stucked in this step. Furthermore, my function to choose smallest element not meet requirement, because I use recursion of list itself, and I should use map/foldr/foll.filter.
Here is what I have tried;
(define (sum-price f) (foldl + 0 (map fruit-price f)))
(define (smallest l)
(cond [(empty? (rest l)) (first l)]
[else (local ((define smallest-in-rest (smallest (rest l))))
(if (< (first l) smallest-in-rest) (first l) smallest-in-rest))]))
(define (cheap-fruit-bundle myfruit)
(smallest (map (lambda (fruit-list) (sum-price fruit-list)) myfruit)))
my code give out at end only a number. I have spent hours on this task and can't think up new ideas. Thanks for help in advance.
cheapest-budle-and-max-optioin function process is:
If budle-1's price less than budle-2's price we choice budle-1.
Or budle-1's price might bigger or equal to budle-2's price. If budle-1's price bigger than budle-2 we choice budle-2.
Or two budle price is the same. Than we compare options.
Notice: In here if we have many budles have same price and same option number we still choice one budle.
After finish cheapest-budle-and-max-optioin process. Using foldlr to compare each budle element in list.
(define-struct fruit (name price) #:transparent #:mutable)
(define (filter-cheapest-budle-and-max-optioin budle-list)
(local [(define (budle-price budle-list)
(foldl + 0 (map fruit-price budle-list)))
(define (budle-option-n budle-list)
(foldl (lambda (x1 x2) (+ x2 1)) 0 budle-list))
(define (budle-option<? b1 b2)
(< (budle-option-n b1) (budle-option-n b2)))
(define (budle-price<? b1 b2)
(< (budle-price b1) (budle-price b2)))
(define (cheapest-budle-and-max-optioin b1 b2)
(cond
[(budle-price<? b1 b2) b1]
[(budle-price<? b2 b1) b2]
[(budle-option<? b1 b2) b2]
[else b1]))]
(foldr cheapest-budle-and-max-optioin (first budle-list) budle-list)))
;;; TEST
(define budle-list1
(list
(list (make-fruit 'apple 0.5)
(make-fruit 'banana 0.5))
(list (make-fruit 'apple 1))
(list (make-fruit 'avocado 1))))
(define budle-list2
(list
(list (make-fruit 'apple 1)
(make-fruit 'banana 1))
(list (make-fruit 'apple 2))
(list (make-fruit 'avocado 2))))
(filter-cheapest-budle-and-max-optioin budle-list1) ; should be (list (fruit 'apple 0.5) (fruit 'banana 0.5))
(filter-cheapest-budle-and-max-optioin budle-list2) ; should be (list (fruit 'apple 1) (fruit 'banana 1))
When you get stuck in a programming problem, a good strategy is to break that problem down into the smallest parts that make sense. You can focus on small problems that are easier to solve, and then combine those parts into the final solution. After you have a working solution, you can refactor if you wish, combining the smaller procedures into larger ones.
Here is one way that you can break your problem down into smaller parts.
You already have a working definition for sum-price, although I am going to change the name here:
(define-struct fruit (name price))
(define fruit-bundles (list (list (make-fruit 'apple 3)
(make-fruit 'banana 4)
(make-fruit 'avocado 5))
(list (make-fruit 'apple 7)
(make-fruit 'avocado 5))
(list (make-fruit 'apple 7)
(make-fruit 'avocado 9)
(make-fruit 'banana 2))))
(define (bundle-price bundle)
(foldl + 0 (map fruit-price bundle)))
Now, we want to be able to take a list of fruit-bundles and get to the largest, cheapest fruit bundle of the list. The first part of this problem seems to be that we want to get a list of all of the cheapest bundles; after that we can worry about getting the largest bundle.
I'd like to do something like this to get a list of the cheapest bundles, using filter with an anonymous procedure that returns true when the bundle price is equal to the minimum bundle price:
;; Takes a list of fruit-bundles and returns a list of the cheapest bundles.
(define (cheapest-bundles bundles)
(filter (lambda (b) (= (bundle-price b)
(min-bundle-price bundles)))
bundles))
I already have bundle-price, so I just need to write min-bundle-price. Since I know that I can map over a list of fruits to get a list of prices, I just need to apply the min procedure to that list:
;; Takes a list of fruit-bundles and returns the minimum bundle price.
(define (min-bundle-price bundles)
(apply min (map bundle-price bundles)))
Now I have a way to get a list of the cheapest fruit bundles. Now, lets test the cheapest-bundles procedure:
scratch.rkt> (cheapest-bundles fruit-bundles)
'((#<fruit> #<fruit> #<fruit>) (#<fruit> #<fruit>))
Well, that looks ok, but we can't really see what is in the fruit structs. Let's just write a couple of utility procedures to help us see inside the structs:
;; A couple of utility functions for inspecting fruits.
(define (inspect-fruit f)
(list (fruit-name f) (fruit-price f)))
(define (inspect-fruit-bundle bundle)
(map inspect-fruit bundle))
Now let's try again:
scratch.rkt> (map inspect-fruit-bundle (cheapest-bundles fruit-bundles))
'(((apple 3) (banana 4) (avocado 5)) ((apple 7) (avocado 5)))
That is what we expected; this is a list containing the two cheapest fruit bundles.
Now we need to devise a way to get the largest fruit bundle from this list of the cheapest fruit bundles. But, it could be the case that there are multiple fruit bundles that are the same size; in that case, let's agree to take the first bundle from a list of the largest bundles. So, we plan on creating a list of largest bundles, and we want the first element from that list:
;; Takes a list of bundles and returns the largest bundle.
;; If there are multiple largest bundles, the first one in the list is returned.
(define (largest-bundle bundles)
(car (largest-bundles bundles)))
We will need to write largest-bundles, which we can write in a way similar to the cheapest-bundles procedure by using filter to create a list of bundles with counts that are equal to the maximum count for all bundles:
;; Takes a list of fruit-bundles and returns a list of the largest bundles.
(define (largest-bundles bundles)
(filter (lambda (b) (= (bundle-count b)
(max-bundle-count bundles)))
bundles))
Before, we needed to get the price for a bundle, but now we will need to get a count of the number of kinds of fruits in a bundle:
;; Takes a fruit-bundle and returns the number of fruit elements.
(define (bundle-count bundle)
(length bundle))
Now we just need to write the max-bundle-count procedure. We can do this in a way similar to what we did for the min-bundle-price procedure, by applying the max procedure to a list of bundle counts:
;; Takes a list of fruit-bundles and returns the maximum bundle count.
(define (max-bundle-count bundles)
(apply max (map bundle-count bundles)))
Now we have a procedure that will get us a list of the largest fruit bundles, and another procedure that takes the first one from this list so that multiple hits are handled. Let's test them:
scratch.rkt> (map inspect-fruit-bundle (largest-bundles fruit-bundles))
'(((apple 3) (banana 4) (avocado 5)) ((apple 7) (avocado 9) (banana 2)))
scratch.rkt> (inspect-fruit-bundle (largest-bundle fruit-bundles))
'((apple 3) (banana 4) (avocado 5))
As expected, largest-bundles returns a list of the two largest fruit bundles, and largest-bundle returns the first fruit bundle in that list.
Now we just have to combine the above to create the cheapest-fruit-bundle procedure:
;; Takes a list of fruit-bundles and returns the largest, cheapest bundle.
(define (cheapest-fruit-bundle bundles)
(largest-bundle (cheapest-bundles bundles)))
Remembering to use inspect-fruit-bundle so that we can easily read the results, here is the final result:
scratch.rkt> (inspect-fruit-bundle (cheapest-fruit-bundle fruit-bundles))
'((apple 3) (banana 4) (avocado 5))

get the elements from a nested list in LISP

I am trying to figure out how to access the elements in a nested list in LISP. For example:
((3 (1 7) (((5)))) 4)
If I use dolist, i run into the brackets. Is there any method to just get the elements from the list?
This is actually a surprisingly subtle question! It's in some ways the equivalent of asking: how do I get the nested elements of an HTML DOM, by specifying a pattern. (more on that aspect later)
If you just want to get the non-list elements as a sequence, e.g.
((3 (1 7) (((5)))) 4) -->
(nth 3 (3 1 7 5 4)) -->
5
You can use the 'cheat' way: the flatten function in the CL alexandria library. (via quicklisp)
(ql:quicklisp :alexandria)
(nth 3 (alexandria:flatten '((3 (1 7) (((5)))) 4)))
Which gives us the sought after,
5
But, the alexandrian function is simple enough that we can take a look at the source code itself:
(defun flatten (list)
(cond
((null list)
nil)
((consp (car list))
(nconc (flatten (car list)) (flatten (cdr list))))
((null (cdr list))
(cons (car list) nil))
(t
(cons (car list) (flatten (cdr list))))))
As you can see, it's a recursive function -- at each level of recursion it asks the question: what is the object that I'm flattening? If it's the empty list, return nil. I'm done!
Otherwise it has to be a non empty list. If the first element of the list is also a list then flatten that and also flatten the cdr of the function argument list and concatenate the results.
If the first element is not a list and the second element is '(), that must mean we have a list with one element: return it.
The final case case, which exhausts our possibilities is that the first element in the list is an atom while the rest of the list is a list with at least one element. In that case concatenate the first element with the results of a flatten performed on the rest of the list.
The fact that the description in English is so ponderous shows the power of recursion, (and also my own lack of fluency when describing it).
But there's actually another way your question could interpreted: if I have a list that looks something like: ((n1 (n2 n3) (((n4)))) n5) How do I get at n2, even if n2 is itself a list? Our previous recursive algorithm won't work -- it depends on n2 not being a list to know when to stop. But, we can still use recursion and the very list we're searching as the basis for a pattern:
;; For each element in our pattern list look for a corresponding
;; element in the target, recursing on lists and skipping atoms that
;; don't match.
(defun extract-from-list (pattern target to-find)
(dotimes (i (length pattern))
(let ((ith-pattern (nth i pattern)))
(cond
((consp ith-pattern)
(let ((results
(extract-from-list (nth i pattern)
(nth i target)
to-find)))
(when results
(return results))))
(t
(if (eq to-find ith-pattern)
(return (nth i target))))))))
Note that,
(extract-from-list
'((n1 (n2 n3) (((n4)))) n5) ;; The pattern describing the list.
'((3 (1 7) (((5)))) 4) ;; The list itself.
'n4) ;; which of the elements we want.
still returns the old answer:
5
But,
(extract-from-list
'((n1 (n2 n3) (n4)) n5) ;; The pattern describing the list, note (n4) rather than (((n4)))
'((3 (1 7) (((5)))) 4) ;; The list itself.
'n4) ;; The element we want to pull from the list
Returns
((5))
Magic! One of the aspects of Lisp that makes it so extraordinarily powerful.

Predicate that checks whether a list contains duplicates

I'm trying to write a function that takes a list and returns true if it contains a duplicate entry and false otherwise. I know I'm supposed to use member. Here is my attempt so far (which fails):
(defun dupl (lst)
(if (null lst) '())
(if ((member (car lst) (cdr lst)) (cons (car lst) (dupes (cdr lst))))
(t (dupl (cdr lst)))))
You have a few problems in your code.
The first if should use return-from to actually return the value. It's also better to use nil instead of '().
In the second if you are trying to use cond syntax.
I'm not even sure what you were trying to achieve with the cons, but that doesn't seem necessary.
With these fixed, your code would look like this:
(defun dupl (lst)
(if (null lst) (return-from dupl nil))
(if (member (car lst) (cdr lst))
t
(dupl (cdr lst))))
It might be cleaner to turn the two ifs into a single cond:
(defun dupl (lst)
(cond ((null lst) nil)
((member (car lst) (cdr lst)) t)
(t (dupl (cdr lst)))))
If a function returns a boolean, it is likely to be expressible as a boolean expression. The following quadratic version is a possible implementation:
(defun duplicatesp (list &key (test #'eql))
(and list
(or (member (first list) (rest list) :test test)
(duplicatesp (rest list) :test test))))
The lazy-programmer version that follows also does the trick:
(defun duplicatesp (list)
(not (equal (remove-duplicates list) list)))
You could also sort a copy of your list first for a better time complexity of O(n.log(n)).
Just my two cents on efficiency. If you use memberp to test for duplicates, then you're comparing each element to each other element and the complexity is O(N^2). Joshua in his answer suggested using a hash table to test for duplicates, which will give a linear running time O(N) at the expense of space. It might also be slower for smaller lists. Finally, if your list can be sorted, then you should get O(N.log(N)) as coredump- mentions. Here is an example that tests for duplicates in numeric lists using sort. (This is a destructive function.)
(defun duplicatesp (list)
(mapl (lambda (cdr) (if (eql (first cdr) (second cdr))
(return-from duplicatesp T)))
(sort list '<)) nil)
UPDATE
Out of curiosity, I measured the performance of the suggested answers for worst-case scenarios (almost no duplicates). So, 1 mln tries of lists of 10 elements:
using member (Jan's answer): 1.139 seconds;
using hash-table (Joshua's answer): 1.436 seconds;
using sort (see above, but with first copying the list): 1.484 seconds.
So, no difference with small lists. Interestingly, using a hash table has some penalty but it is very small. Let's try 1000 tries of lists of 1000 elements:
using member: 9.968 seconds;
using hash-table: 0.234 seconds;
using sort: 0.390 seconds.
As expected, using member has higher complexity. The difference between sorting and hashing is non-visible at this list size. Let's do 10 tries of lists of 1,000,000 elements:
using hash-table: 3.214 seconds;
using sort: 9.296 seconds.
So, sort is still quite good but is slowing down. Here is a simple code I used to profile the functions:
(defun random-list (length)
(loop for i from 0 below length collecting
(random (expt 10 10))))
(defun random-collection (length tries)
(loop for i from 0 below tries collecting
(random-list length)))
(defun test-duplicates (function &key length tries)
(let ((rc (random-collection length tries)))
(time (mapc function rc))
nil))
(test-duplicates #'dp_hash :length 1000000 :tries 10)
;etc.
Many functions in Common Lisp uses generalized booleans, according to which nil (the empty list) is false, and everything else is true:
Type BOOLEAN
… Conditional operations, such as if, permit the use of generalized
booleans, not just booleans; any non-nil value, not just t, counts as
true for a generalized boolean. However, as a matter of convention,
the symbol t is considered the canonical value to use even for a
generalized boolean when no better choice presents itself.
Note the remark that t is used "when no better choice presents itself." It's often helpful to make functions that return a generalized boolean return some other piece of useful information as the true value. For instance, member returns the tail of the list whose first element is the element being checked for membership. In this case, it might be useful to return an association list mapping duplicated elements to the number of times that they appear in the list.
Here's an approach that does that. It first iterates through the list, building a hash table of the unique (as per test and key arguments) elements of the list, mapping each one to the number of times it appears. Then, a pass through the hash table is used to build an association list of all the elements that appear more than once.
(defun contains-duplicates (list &key (test 'eql) (key 'identity))
"Returns an association list mapping duplicated elements to the
number of times that they appear in LIST. TEST is a comparison
operator used to determine whether two elements are the same, and must
be acceptable as a test argument to MAKE-HASH-TABLE. KEY is used to
extract a value from the elements of LIST, and the extracted values
are compared and returned in the result."
(let ((table (make-hash-table :test test))
(result '()))
(dolist (x list)
(incf (gethash (funcall key x) table 0)))
(maphash #'(lambda (key count)
(unless (eql 1 count)
(push (cons key count) result)))
table)
result))
(contains-duplicates '(1 1 2 3 4 4 4))
;;=> ((4 . 3) (1 . 2))
(contains-duplicates '(1 2 3 4)) ; no duplicates
;;=> NIL
(contains-duplicates '("A" "a" b a) :test 'equal :key 'string)
;;=> (("A" . 2))
(contains-duplicates '("A" "a" b a) :test 'equal :key 'string) ; "A" ~ a, but not "a"
;;=> (("A" . 2))
(contains-duplicates '("A" "a" b a) :test 'equalp :key 'string) ; "A" ~ "a" ~ a
;;=> (("A" . 3))
(contains-duplicates '(1 2 3 5) :key 'evenp) ; two even elements
;;=> ((NIL . 2))

functions and lists in scheme/racket

How would you define a function which takes one argument, which should be a list, and returns the elements in the
list which are themselves lists?
(check-expect (find-sublists ’(1 2 () (3) (a b c) a b c))
’(() (3) (a b c)))
Do you have experience designing functions that can filter through a list?
A simpler problem with the same flavor as the original is something like this: design a function that takes a list of numbers and keeps only the even numbers. Would you be able to do that function?
Looking at http://www.ccs.neu.edu/home/matthias/HtDP2e/htdp2e-part2.html and going through its guided exercises may also help.
Two useful tools which should start you on your way:
1) Traversing through a list:
; traverse: takes a list of numbers
; Goes through each element, one-by-one, and alters it
(define traverse
(lambda (the_list)
(if (empty? the_list)
empty
(cons (+ 1 (first the_list))
(traverse (rest the_list))))))
(traverse (cons 3 (cons 4 empty))) returns (cons 4 (cons 5 empty))
2) list?:
(list? (list 1 2 3)) returns #t
(list? 5) returns #f

Lists in scheme

I'm trying to write a function in scheme that takes a list and squares every item on the list, then returns the list in the form (list x y z). However, I'm not sure how to write a code that will do that. So far, I have
(define (square=list list)
(cond
[(empty? list) false]
[else (list (sqr (first a-list))(square-list (rest a-list)))]))
but it returns the list in the form
(cons x (cons y (cons z empty)))
What can I do to make it return the list just in the form (list x y z)? Thanks!
You're almost there -- make sure you understand the difference between cons and list (the textbook How to Design Programs explains this in Section 13. You can find the online copy here).
cons will take an item as its first element and (usually) a (possibly empty) list for the 'rest' part. As an example, (cons 1 empty) has the number 1 as its first element and the empty list as the 'rest'. (cons 1 (cons 2 empty)) has the number 1 as the first element, and (cons 2 empty) as the 'rest'.
list is just an easy shorthand for making lists, taking an arbitrary number of items. Thus:
(list 1 2 3 4 5)
is the same as...
'(1 2 3 4 5)
which is the same as
(cons 1 (cons 2 (cons 3 (cons 4 (cons 5 empty))))).
But be careful. (list 1 (list 2 (list 3))) is not the same as (cons 1 (cons 2 (cons 3 empty))). In fact, it is (cons 1 (cons 2 (cons 3 empty) empty) empty).
If you're still confused, feel free to post a comment.
The problem is that you're using list in the else statement. You are saying build me a list with this value as the first entry, and a list as the second entry.
You want to cons the first entry onto the list created by recursive call.
(list 'a '(b c d))
; gives you
'(a (b c d))
(cons 'a '(b c d))
; gives you
'(a b c d)
This is probably not what your TA is looking for, but I'll throw it in anyway because it may help you grok a tiny bit more of Scheme. The idiomatic (in Scheme) way to write what you are trying to do is to use map:
> (map (lambda (x) (* x x)) '(1 2 3 66 102 10403))
(1 4 9 4356 10404 108222409)
map applies a function (here, (lambda (x) (* x x)) - a nameless function that returns the square of its input) to each element of a list and returns a new list containing all of the results. Scheme's map basically does the same iteration you are doing in your code, the advantage being that by using map you never have to explicitly write such iterations (and, nominally at least, a Scheme implementation might optimize map in some special way, though that's not really that important in most cases). The important thing about map is that it reduces your code to the important parts - this code squares each element of the list, this other code takes the square root of each element, this code adds one to it, etc, without having to repeat the same basic loop iteration code again and again.