Sorting groups using map and accumulate in Scheme - dictionary

I'm trying to use "map" and "accumulating" functions in scheme for sorting unknown amount of listing into a lists that the first will have all the first places of the olds lists and so on.
(1 2 3.. ) (4 5 6..) (7 8 9..)...
to this list:
(1 4 7) (2 5 8) (3 6 9).
I was writing this:
(accumulate (lambda (x y) (if (null? y) x (map cons x y))) null '((1 2 3) (4 5 6) (7 8 9) (9 10 11) (12 13 14)))
and it keeps giving me the annoying dot in the end...
((1 4 7 9 . 12) (2 5 8 10 . 13) (3 6 9 11 . 14)).
what seemes to be the problem? thanks!

Try this:
(if (null? y)
(map list x)
(map cons x y))

(define (accumulate x . rest)
(append (list x) rest))
> (map accumulate '(1 2 3) '(4 5 6) '(7 8 9))
=> ((1 4 7) (2 5 8) (3 6 9))
> (map accumulate '(1 2 3 4) '(5 6 7 8) '(9 10 11 12) '(13 14 15 16))
=> ((1 5 9 13) (2 6 10 14) (3 7 11 15) (4 8 12 16))

Related

How to determine if a number is the largest element in a list - Using Racket

I'm trying to write a function for peaks which consumes list to produce a sublist that consists of all the peaks of the original list. ex. (peaks (cons 1 (cons 6 (cons 4 (cons 5 empty))))) should produce (cons 6 (cons 5 empty))
MY answer seems right but I think I messed up somewhere because it's not the right answer. I did a helper function using recursion to determine the maximum number in the list and then subbed that into another recursion function to create a sublist consisting of maximum numbers.
Any advice on where I messed up? We just started learning recursions and this is the only question that tripping me up.
(cond
[(empty? (rest lon)) (first lon)]
[else (max (first lon) (greatest (rest lon)))]))
(define (peaks lon)
(cond
[(empty? (rest lon)) lon]
[(equal? (first lon) (greatest lon)) (cons (first lon) (peaks (rest lon)))]
[else (peaks (rest lon))]))```
A possible solution is:
(define (peaks lst)
(cond [(empty? lst) lst]
[(empty? (rest lst)) lst]
[(empty? (rest (rest lst))) (list (max (first lst) (second lst)))]
[(<= (first lst) (second lst)) (peaks (rest lst))]
[else (cons (first lst) (peaks (rest (rest lst))))]))
Examples:
> (peaks '(1 6 4 5))
'(6 5)
> (peaks '(9 1 2 6 7 3 4 5 0 8))
'(9 7 5 8)
> (peaks '())
'()
> (peaks '(7))
'(7)
> (peaks '(7 3))
'(7)
> (peaks '(3 4))
'(4)
> (peaks '(5 0 8))
'(5 8)
> (peaks '(6 7 3))
'(7)
I might approach it like this. First I write a function is-peak which determines if three (3) adjacent elements contain a peak in the middle element -
(define (is-peak a b c)
(and (< a b) (> b c)))
Then I write a peaks procedure using pattern match for lists containing elements 0, 1, 2, 3, or more elements -
(define (peaks ls)
(match ls
;; 0, 1, or 2-element lists do not have peaks
[(list) null]
[(list a) null]
[(list a b) null]
;; 3-element lists could have at most 1 peak
[(list a b c)
(if (is-peak a b c)
(list b)
null)]
;; 4 elements or more
[(list a b c d ...)
(if (is-peak a b c)
(cons b (peaks (cddr ls)))
(peaks (cdr ls)))]))
(peaks (list 1 2 1 3 4 5 4 2 1 5 6 7 4))
'(2 5 7)
We can visualize the linear process and track the values of a, b, c, d .... Notice how cddr allows us to fast-forward one element after a peak is found. This is because a peak can never be adjacent to another peak -
a
b
c
d...
1
2 (peak)
1
3 4 5 4 2 1 5 6 7 4
1
3
4
5 4 2 1 5 6 7 4
3
4
5
4 2 1 5 6 7 4
4
5 (peak)
4
2 1 5 6 7 4
4
2
1
5 6 7 4
2
1
5
6 7 4
1
5
6
7 4
5
6
7
4
6
7 (peak)
4
Now we'll consider some other inputs for peaks -
(peaks (list 1 2 3 2 1))
(peaks (list 3 2 1 2 3))
(peaks null)
'(3)
'()
'()

LISP make list items positive

How do we loop through a list to get the absolute value of each list item using lambda or any other looping mechanism?
(defun span (start end &key (step 1))
(loop for n from start to end by step
collect n))
(setf bce #'(lambda (x) (abs x)) (span -10 -1))
The result can be used, for example, as the BCE timeline.
You can use mapcar (reference):
CL-USER> (mapcar #'(lambda (x) (abs x)) (span -10 -1))
(10 9 8 7 6 5 4 3 2 1)
;; can be written also as:
CL-USER> (mapcar (lambda (x) (abs x)) (span -10 -1))
(10 9 8 7 6 5 4 3 2 1)
;; better yet:
CL-USER> (mapcar #'abs (span -10 -1))
(10 9 8 7 6 5 4 3 2 1)
As loop:
CL-USER> (loop for x in (span -10 -1) collect (abs x))
(10 9 8 7 6 5 4 3 2 1)
Combining this in a single function:
CL-USER> (defun span (start end &key (step 1) (key #'identity))
(loop for n from start to end by step
collect (funcall key n)))
SPAN
CL-USER> (span -10 -1)
(-10 -9 -8 -7 -6 -5 -4 -3 -2 -1)
CL-USER> (span -10 -1 :key #'abs)
(10 9 8 7 6 5 4 3 2 1)

Racket - Building the built-in member function

I like writing code to the same thing that built-in functions do. It is always a great exercise for me.
In racket there is a bult-in function called "member" which checks if a certain element is inside a list. If true, the function returns the rest/cdr o the list If false, the function returns #f. Examples:
> (member 2 (list 1 2 3 4))
'(2 3 4)
> (member 9 (list 1 2 3 4))
#f
I did the following code:
(require racket/trace)
(define (member-mine lista num)
(cond ((equal? (car lista) num) (cdr lista))
((equal? (car lista) '()) #f)
(else (member-mine (cdr lista) num))))
(define small-list (list 1 2 3 4 5 6 7 8))
(trace member-mine)
And, when I try using it with the cool tool trace, I am partially successful.
Calling:
(member-mine small-list 1)
Returns:
>(member-mine '(1 2 3 4 5 6 7 8) 1)
<'(2 3 4 5 6 7 8)
Calling:
(member-mine small-list 8)
Returns:
>(member-mine '(1 2 3 4 5 6 7 8) 8)
>(member-mine '(2 3 4 5 6 7 8) 8)
>(member-mine '(3 4 5 6 7 8) 8)
>(member-mine '(4 5 6 7 8) 8)
>(member-mine '(5 6 7 8) 8)
>(member-mine '(6 7 8) 8)
>(member-mine '(7 8) 8)
>(member-mine '(8) 8)
<'()
The problem is when I call an element which is not in the list given. The output should be #f:
(member-mine small-list 9)
Which returns is an error:
>(member-mine '(1 2 3 4 5 6 7 8) 9)
>(member-mine '(2 3 4 5 6 7 8) 9)
>(member-mine '(3 4 5 6 7 8) 9)
>(member-mine '(4 5 6 7 8) 9)
>(member-mine '(5 6 7 8) 9)
>(member-mine '(6 7 8) 9)
>(member-mine '(7 8) 9)
>(member-mine '(8) 9)
>(member-mine '() 9)
. . car: contract violation
expected: pair?
given: '()
How do I manage to deal with the empty?
There are some issues with your code. As a first observation you have switched the contract so that the list comes first instead of last.
It also seem that you are checking if one of the elements is the empty list and not the list itself. Thus your member would terminate with #f in this case:
(member-mine '(() 1 2 3 4 5 6 7 8) 1) ; ==> #f
So your member should check if the whole argument is null? (empty?) or perhaps check if it's not pair?. Then it should evaluate to #f.
If the first element matches your search, then the original member evaluates to the whole argument with the match as the first element and not the cdr like in your code.
Move the empty case to be the first branch of the conditional. When the empty list is passed into your function on the final recursive call, you request the car of the list, which cannot be done because the list is empty. Putting the empty case fist should cause the function to terminate with #f before reaching a call to car.
Another way to check empty list is to check its length:
(define (member-mine lista num)
(cond
((equal? (length lista) 0) #f) ; '=' can also be used instead of 'equal?'
((equal? (car lista) num) (cdr lista))
(else (member-mine (cdr lista) num))))
(define small-list (list 1 2 3 4 5 6 7 8))
(member-mine small-list 9)
Output:
#f
But proper way is:
(empty? lista) or (null? lista)

How to group any consecutive numbers or items of a given series

I am trying to group any consecutive numbers or items of a given series.
all consecutive number 1 is return as a sublist.
(defun length1-to-atom (l)
(loop for x in l collect (if (= (length x) 1) (car x) x)))
(defun group-series (n list)
(length1-to-atom
(reduce (lambda (item result)
(cond
((endp result) (list (list item)))
((and (eql (first (first result)) item) (= n item))
(cons (cons item (first result))
(rest result)))
(t (cons (list item) result))))
list
:from-end t
:initial-value '())))
(group-series 1 '(1 1 2 3 1 1 1 2 2 1 5 6 1 1))
;=> ((1 1) 2 3 (1 1 1) 2 1 5 6 (1 1))
(group-series 2 '(1 1 2 3 1 1 1 2 2 1 5 6 1 1))
;=> (1 1 2 3 1 1 1 (2 2) 1 5 6 1 1)
can't find any solution for the examples below
(group-series '(1 2) '(1 1 2 3 1 1 1 2 1 5 6 1 1))
;=> ((1 (1 2) 3 1 1 (1 2) 1 5 6 1 1))
or
(group-series '(1 2 1) '(1 1 2 3 1 1 1 2 1 5 6 1 1))
;=> ((1 1 2 3 1 1 (1 2 1) 5 6 1 1))
Any help much appreciated.
The first case (finding repetitions of a single item) can be solved with the following function:
(defun group-series-1 (x list)
(let (prev
rez)
(dolist (elt list)
(setf rez (if (and (equal elt x)
(equal elt prev))
;; found consecutive number
(cons (cons elt (mklist (car rez)))
(cdr rez)))
(cons elt
(if (and rez (listp (car rez)))
;; finished a series
(cons (reverse (car rez))
(cdr rez))
;; there was no series
rez)))
prev elt))
(reverse rez)))
where:
(defun mklist (x)
(if (consp x) x (list x)))
The second one can be solved with the similar approach, but there will be twice as much code.
I agree with the comment, that group-series seems to be doing two separate things depending on if the input is a list or an item.
If the input is a list (the second case), this seems to meet the spec:
(defun group-series (sublst lst)
(funcall (alambda (lst res)
(if (null lst)
res
(if (equal (subseq lst 0 (min (length lst) (length sublst)))
sublst)
(self (nthcdr (length sublst) lst)
(nconc res (list sublst)))
(self (cdr lst)
(nconc res (list (car lst)))))))
lst '()))
This makes use of Paul Graham's alambda macro (http://lib.store.yahoo.net/lib/paulgraham/onlisp.pdf). Also note that because the anonymous function is a closure (i.e., it has closed over sublst), it can reference sublst without having to pass it around as an additional input variable.
A number of comments say that this looks like the function is doing two different things, but there's actually a way to unify what it's doing. The trick is to treat the first argument a list designator:
list designator n. a designator for a list of objects; that is,
an object that denotes a list and that is one of: a non-nil atom
(denoting a singleton list whose element is that non-nil atom) or a
proper list (denoting itself).
With this understanding, we can see group-series as taking a designator for a sublist of list, and returning a list that's like list, except that all consecutive occurrences of the sublist have been collected into a new sublist. E.g.,
(group-series 1 '(1 2 1 1 2) ==
(group-series '(1) '(1 2 1 1 2)
;=> ((1) 2 (1 1) 2)
(group-series '(1 2) '(1 2 3 4 1 2 1 2 3 4))
;=> ((1 2) 3 4 (1 2 1 2) 3 4)
With that understanding, the two cases become one, and we just need to convert the first argument to the designated list once, at the beginning. Then it's easy to implement group-series like this:
(defun group-series (sublist list)
(do* ((sublist (if (listp sublist) sublist (list sublist)))
(len (length sublist))
(position (search sublist list))
(result '()))
((null position)
(nreconc result list))
;; consume any initial non-sublist prefix from list, and update
;; position to 0, since list then begins with the sublist.
(dotimes (i position)
(push (pop list) result))
(setf position 0)
;; consume sublists from list into group until the list does not
;; begin with sublist. add the group to the result. Position is
;; left pointing at the next occurrence of sublist.
(do ((group '()))
((not (eql 0 position))
(push (nreverse group) result))
(dotimes (i len)
(push (pop list) group))
(setf position (search sublist list)))))
CL-USER> (group-series 1 '(1 1 2 3 1 1 1 2 2 1 5 6 1 1))
((1 1) 2 3 (1 1 1) 2 2 (1) 5 6 (1 1))
CL-USER> (group-series 2 '(1 1 2 3 1 1 1 2 2 1 5 6 1 1))
(1 1 (2) 3 1 1 1 (2 2) 1 5 6 1 1)
CL-USER> (group-series '(1 2) '(1 1 2 3 1 1 1 2 1 5 6 1 1))
(1 (1 2) 3 1 1 (1 2) 1 5 6 1 1)
CL-USER> (group-series '(1 2 1) '(1 1 2 3 1 1 1 2 1 5 6 1 1))
(1 1 2 3 1 1 (1 2 1) 5 6 1 1)
CL-USER> (group-series '(a b) '(c a b a b c d e f a b))
(C (A B A B) C D E F (A B))

Lisp: multidimensional array elementwise operations

What is the "correct" construct in Common Lisp to apply elementwise operations to multidimensional arrays?
The following examples should help illustrate what I'm trying to do:
A) Suppose I want to increase every element of an array by one:
0 1 2 1 2 3
3 4 5 -> 4 5 6
6 7 8 7 8 9
B) Suppose I want to add 2 arrays:
1 2 -1 -1 0 1
3 4 + -2 -2 -> 1 2
5 6 -3 -3 2 3
C) Suppose I want to find the largest elements of several arrays, elementwise:
max( 0 1 , 4 -1 , 0 0 ) -> 4 1
2 3 0 0 8 1 8 3
Basically I think I'm looking for some sort of "arraymap" function which would be used in like so: (arraymap f A1 A2 ... An), where f takes n arguments as input, and the Ai are arrays of the same size.
In the above examples it would be used like so:
A)
(setq M #2A((0 1 2) (3 4 5) (6 7 8)))
(arraymap #'incf M)
B)
(setq M #2A((1 2) (3 4) (5 6)))
(setq N #2A((-1 -1) (-2 -2) (-3 -3)))
(arraymap #'+ M N)
C)
(setq M #2A((0 1) (2 3)))
(setq N #2A((4 -1) (0 0)))
(setq O #2A((0 0) (8 1)))
(arraymap #'max M N O)
I have tried some constructs with map and loop, but it seems to not work since multidimensional arrays are not a sequence type.
There are four ways to do that:
Write an ARRAY-MAP function based on the array dimensions and iterate over those.
Use ROW-MAJOR-AREF, which views the array like a vector.
Use displaced one-dimensional arrays for the operations.
Example for a use of displaced arrays:
(defun array-map (function &rest arrays)
"maps the function over the arrays.
Assumes that all arrays are of the same dimensions.
Returns a new result array of the same dimension."
(flet ((make-displaced-array (array)
(make-array (reduce #'* (array-dimensions array))
:displaced-to array)))
(let* ((displaced-arrays (mapcar #'make-displaced-array arrays))
(result-array (make-array (array-dimensions (first arrays))))
(displaced-result-array (make-displaced-array result-array)))
(declare (dynamic-extent displaced-arrays displaced-result-array))
(apply #'map-into displaced-result-array function displaced-arrays)
result-array)))
Using it:
CL-USER 3 > (array-map #'1+ #2A((0 1 2) (3 4 5) (6 7 8)))
#2A((1 2 3) (4 5 6) (7 8 9))
CL-USER 4 > (array-map #'+ #2A((1 2) (3 4) (5 6)) #2A((-1 -1) (-2 -2) (-3 -3)) )
#2A((0 1) (1 2) (2 3))
Use internal, implementation specific, operations for efficient array operations.
For anyone coming here looking for an up-to-date answer to this question: https://github.com/bendudson/array-operations defines aops:each (and aops:each*) that does exactly what the OP asks for.

Resources