Returning the contents of an arbitrary array - multidimensional-array

There are many Common Lisp functions to access the various properties of an arbitrary array, for example array-dimensions. But a function that returns a copy of the contents of the array (in the same format used to enter :initial-contents in make-array) is not provided. Loop ... collect would seem useful, but the dimensional nesting is arbitrarily deep. Would a macro be appropriate, or is there a better way?

Macros is a code-generation/language-extension tool.
You do not need them here.
What you need is a recursive function:
(defun array-to-nested-sequences (array &rest indexes)
"Extract the section of the multidimentional array defined by the indexes.
Must be (<= (length indexes) (array-rank array)) ==> T.
When (= (length indexes) (array-rank array)), this is equivanent to AREF."
(let ((ni (length indexes)))
(if (= ni (array-rank array))
(apply #'aref array indexes)
(loop for i from 0 below (array-dimension array ni)
collect (apply #'array-to-nested-sequences array
(append indexes (list i)))))))
(setq init '(((1 2 3 4) (5 6 7 8) (9 10 11 12))
((13 15 15 16) (17 18 19 20) (21 22 23 24)))
array (make-array '(2 3 4) :initial-contents init))
(equal (array-to-nested-sequences array)
init)
==> T
(equal (array-to-nested-sequences array 1) (second init))
==> T
array-to-nested-sequences can actually extract sub-arrays.
Note that the depth of recursion is the rank of the array, so you are unlikely to run out of stack.

Related

Collecting to a vector instead of a list

I solved Project Euler's 8th problem using SBCL and the iterate package from quicklisp. In my code I defined a function that turns a number into a list of it's digits. Here's the source code:
(defun number-to-list (n)
(iter (for c in-string (write-to-string n)) (collect (digit-char-p c))))
The collect clause both in iter and in loop make a list out of the values. Is it possible to instead generate a vector (one dimensional array)?
Would my only option be to convert the list generated by number-to-list to a vector? Because that seems inefficient (although probably not that inefficient)
Usually there is one big problem: how large will the result vector be? It would be best to know that upfront, then we can allocate the vector once with the correct size. Otherwise we would have find ways to deal with that: use a resizable vector, allocate a list first and copy into a result vector later, allocate a larger vector with a fill pointer, ...
If you have a sequence, then one can use the Common Lisp function MAP: if the source object is a vector, here a string, its length is cheap to get.
CL-USER 1 > (map 'vector
#'digit-char-p
(write-to-string 5837457324534))
#(5 8 3 7 4 5 7 3 2 4 5 3 4)
You can use ITERATE and collect a vector:
FOO 32 > (defun number-to-vector (n)
(iter (for c in-string (write-to-string n))
(collect (digit-char-p c) result-type vector)))
NUMBER-TO-VECTOR
FOO 33 > (number-to-vector 8573475934)
#(8 5 7 3 4 7 5 9 3 4)
If you look at the macro expansion, it actually collects into a list and then calls COERCE to create the vector. So: no win in efficiency.
Note that this is another example where ITERATE is more powerful than LOOP: the standard LOOP can't directly return vectors from collect.
The proposed solutions are correct and elegant, but they first create a list, or trasform the number in string. I would like to propose a direct transformation from integers to arrays, without transforming first the number in a list or a string:
(defun digits(n)
"Transform a positive integer n in array of digits"
(let* ((logn (floor (log n 10)))
(result (make-array (1+ logn) :element-type '(integer 0 9))))
(loop for i downfrom logn to 0
do (setf (values n (aref result i)) (floor n 10)))
result))
The problem of allocating an array of the correct dimension is solved with the formula that gives the number of decimal digits of an integer n: ⌊log10 n⌋+1.
Maybe not a direct answer to your question but here are my num-to-list and list-to-num functions I frequently use.
(defun num-to-list-helper (n liste)
(cond ((< n 1) liste)
(t (num-to-list-helper (truncate (/ n 10)) (cons (rem n 10) liste))))))
(defun num-to-list (n)
(num-to-list-helper n nil))
(defun list-to-num-helper (liste n)
(if (null liste)
n
(list-to-num-helper (cdr liste)
(+ n (* (car liste) (expt 10 (1- (length liste))))))))
(defun list-to-num (liste)
(list-to-num-helper liste 0))
You could try these and see if there's an improvement over converting the number to string. Personally I don't prefer strings for numbers as I consider them as an ugly trick I was forced to do in my Java days.
You could also convert these functions to a version using vectors and see how they do.

Functional programming for 3 lists in Racket

I could manage following code to replaces items in a list using 2 other lists. Orilist and newlist have original and new terms in order. The replacement is done using orilist and newlist- if orilist items are present in slist, slist is changed to have corresponding new items from newlist:
(define (list-replace-from-lists slist orilist newlist)
(define replaced #f)
(define outl '())
(for ((item slist))
(set! replaced #f)
(for ((ori_ orilist) (i (in-naturals)) #:when (equal? item ori_))
(set! outl (cons (list-ref newlist i) outl))
(set! replaced #t))
(when (not replaced)
(set! outl (cons item outl))))
(reverse outl))
To replace 2 and 5 to 12 and 15, respectively, in (list 1 2 3 4 5 6) :
(list-replace-from-lists (list 1 2 3 4 5 6) (list 2 5) (list 12 15))
Output is:
'(1 12 3 4 15 6)
However, above code does not look functional and has many set! statements. How can this be converted to functional code? Should I use structures or some other data-types for above purpose?
Edit: items may recur in original list, e.g. (list 1 2 3 4 5 2 6)
You can still use lists and keep everything functional. :-) Here's my solution:
(define (replace-all haystack needles new-needles)
(define replace-alist (map cons needles new-needles))
(define (replace-one item)
(cond ((assoc item replace-alist) => cdr)
(else item)))
(map replace-one haystack))
Explanation of the code:
First, we build a replacement association list (alist). This is a list of pairs, of which the keys correspond to the needles and the values correspond to new-needles.
Then we define a replace-one function that takes an item, and sees if it matches any of the keys in the alist. If so, we return the corresponding value; otherwise, we return the original item.
Finally, we map the haystack through replace-one. Yay higher-order functions!
Note that this code is O(m*n) where m is the size of haystack and n is the size of needles, which is the same runtime as your version. If needles is large, you will want to use a hashtable instead of an alist, which will amortise the runtime of the function to O(m).
This is a functional solution that uses hash to keep the associations. That makes this solution O(haystack-length log needle-length) since immutable hashes are implemented with trees.
(define (list-replace-all haystack needles new-values)
;; make a dictionary of elements to be replaced
(define hash
(foldl (λ (needle new-value hash)
(hash-set hash needle new-value))
#hash()
needles
new-values))
;; do the replace. If not in hash the actual key is default
(map (λ (e) (hash-ref hash e e)) haystack))
(list-replace-all '(1 2 3 4 5 6) '(2 5) '(12 15))
; ==> (1 12 3 4 15 6)

Average using &rest in lisp

So i was asked to do a function i LISP that calculates the average of any given numbers. The way i was asked to do this was by using the &rest parameter. so i came up with this :
(defun average (a &rest b)
(cond ((null a) nil)
((null b) a)
(t (+ (car b) (average a (cdr b))))))
Now i know this is incorrect because the (cdr b) returns a list with a list inside so when i do (car b) it never returns an atom and so it never adds (+)
And that is my first question:
How can i call the CDR of a &rest parameter and get only one list instead of a list inside a list ?
Now there is other thing :
When i run this function and give values to the &rest, say (average 1 2 3 4 5) it gives me stackoverflow error. I traced the funcion and i saw that it was stuck in a loop, always calling the function with the (cdr b) witch is null and so it loops there.
My question is:
If i have a stopping condition: ( (null b) a) , shouldnt the program stop when b is null and add "a" to the + operation ? why does it start an infinite loop ?
EDIT: I know the function only does the + operation, i know i have to divide by the length of the b list + 1, but since i got this error i'd like to solve it first.
(defun average (a &rest b)
; ...
)
When you call this with (average 1 2 3 4) then inside the function the symbol a will be bound to 1 and the symbol b to the proper list (2 3 4).
So, inside average, (car b) will give you the first of the rest parameters, and (cdr b) will give you the rest of the rest parameters.
But when you then recursively call (average a (cdr b)), then you call it with only two arguments, no matter how many parameters where given to the function in the first place. In our example, it's the same as (average 1 '(3 4)).
More importantly, the second argument is now a list. Thus, in the second call to average, the symbols will be bound as follows:
a = 1
b = ((3 4))
b is a list with only a single element: Another list. This is why you'll get an error when passing (car b) as argument to +.
Now there is other thing : When i run this function and give values to the &rest, say (average 1 2 3 4 5) it gives me stackoverflow error. I traced the funcion and i saw that it was stuck in a loop, always calling the function with the (cdr b) witch is null and so it loops there. My question is:
If i have a stopping condition: ( (null b) a) , shouldnt the program stop when b is null and add "a" to the + operation ? why does it start an infinite loop ?
(null b) will only be truthy when b is the empty list. But when you call (average a '()), then b will be bound to (()), that is a list containing the empty list.
Solving the issue that you only pass exactly two arguments on the following calls can be done with apply: It takes the function as well as a list of parameters to call it with: (appply #'average (cons a (cdr b)))
Now tackling your original goal of writing an average function: Computing the average consists of two tasks:
Compute the sum of all elements.
Divide that with the number of all elements.
You could write your own function to recursively add all elements to solve the first part (do it!), but there's already such a function:
(+ 1 2) ; Sum of two elements
(+ 1 2 3) ; Sum of three elements
(apply #'+ '(1 2 3)) ; same as above
(apply #'+ some-list) ; Summing up all elements from some-list
Thus your average is simply
(defun average (&rest parameters)
(if parameters ; don't divide by 0 on empty list
(/ (apply #'+ parameters) (length parameters))
0))
As a final note: You shouldn't use car and cdr when working with lists. Better use the more descriptive names first and rest.
If performance is critical to you, it's probably best to fold the parameters (using reduce which might be optimized):
(defun average (&rest parameters)
(if parameters
(let ((accum
(reduce #'(lambda (state value)
(list (+ (first state) value) ;; using setf is probably even better, performance wise.
(1+ (second state))))
parameters
:initial-value (list 0 0))))
(/ (first accum) (second accum)))
0))
(Live demo)
#' is a reader macro, specifically one of the standard dispatching macro characters, and as such an abbreviation for (function ...)
Just define average*, which calls the usual average function.
(defun average* (&rest numbers)
(average numbers))
I think that Rainer Joswig's answer is pretty good advice: it's easier to first define a version that takes a simple list argument, and then define the &rest version in terms of it. This is a nice opportunity to mention spreadable arglists, though. They're a nice technique that can make your library code more convenient to use.
In most common form, the Common Lisp function apply takes a function designator and a list of arguments. You can do, for instance,
(apply 'cons '(1 2))
;;=> (1 . 2)
If you check the docs, though, apply actually accepts a spreadable arglist designator as an &rest argument. That's a list whose last element must be a list, and that represents a list of all the elements of the list except the last followed by all the elements in that final list. E.g.,
(apply 'cons 1 '(2))
;;=> (1 . 2)
because the spreadable arglist is (1 (2)), so the actual arguments (1 2). It's easy to write a utility to unspread a spreadable arglist designator:
(defun unspread-arglist (spread-arglist)
(reduce 'cons spread-arglist :from-end t))
(unspread-arglist '(1 2 3 (4 5 6)))
;;=> (1 2 3 4 5 6)
(unspread-arglist '((1 2 3)))
;;=> (1 2 3)
Now you can write an average* function that takes one of those (which, among other things, gets you the behavior, just like with apply, that you can pass a plain list):
(defun %average (args)
"Returns the average of a list of numbers."
(do ((sum 0 (+ sum (pop args)))
(length 0 (1+ length)))
((endp args) (/ sum length))))
(defun average* (&rest spreadable-arglist)
(%average (unspread-arglist spreadable-arglist)))
(float (average* 1 2 '(5 5)))
;;=> 3.25
(float (average* '(1 2 5)))
;;=> 2.66..
Now you can write average as a function that takes a &rest argument and just passes it to average*:
(defun average (&rest args)
(average* args))
(float (average 1 2 5 5))
;;=> 3.5
(float (average 1 2 5))
;;=> 2.66..

lisp functions ( count numbers in common lisp)

I am working on program related to the different of dealing with even numbers in C and lisp , finished my c program but still having troubles with lisp
isprime function is defined and I need help in:
define function primesinlist that returns unique prime numbers in a lis
here what i got so far ,
any help with that please?
(defun comprimento (lista)
(if (null lista)
0
(1+ (comprimento (rest lista)))))
(defun primesinlist (number-list)
(let ((result ()))
(dolist (number number-list)
(when (isprime number)
( number result)))
(nreverse result)))
You need to either flatten the argument before processing:
(defun primesinlist (number-list)
(let ((result ()))
(dolist (number (flatten number-list))
(when (isprime number)
(push number result)))
(delete-duplicates (nreverse result))))
or, if you want to avoid consing up a fresh list, flatten it as you go:
(defun primesinlist (number-list)
(let ((result ()))
(labels ((f (l)
(dolist (x l)
(etypecase x
(integer (when (isprime x)
(push x result)))
(list (f x))))))
(f number-list))
(delete-duplicates (nreverse result))))
To count distinct primes, take the length of the list returned by primesinlist.
Alternatively, you can use count-if:
(count-if #'isprime (delete-duplicates (flatten number-list)))
It sounds like you've already got a primality test implemented, but for sake of completeness, lets add a very simple one that just tries to divide a number by the numbers less than it up to its square root:
(defun primep (x)
"Very simple implementation of a primality test. Checks
for each n above 1 and below (sqrt x) whether n divides x.
Example:
(mapcar 'primep '(2 3 4 5 6 7 8 9 10 11 12 13))
;=> (T T NIL T NIL T NIL NIL NIL T NIL T)
"
(do ((sqrt-x (sqrt x))
(i 2 (1+ i)))
((> i sqrt-x) t)
(when (zerop (mod x i))
(return nil))))
Now, you need a way to flatten a potentially nested list of lists into a single list. When approaching this problem, I usually find it a bit easier to think in terms of trees built of cons-cells. Here's an efficient flattening function that returns a completely new list. That is, it doesn't share any structure with the original tree. That can be useful, especially if we want to modify the resulting structure later, without modifying the original input.
(defun flatten-tree (x &optional (tail '()))
"Efficiently flatten a tree of cons cells into
a list of all the non-NIL leafs of the tree. A completely
fresh list is returned.
Examples:
(flatten-tree nil) ;=> ()
(flatten-tree 1) ;=> (1)
(flatten-tree '(1 (2 (3)) (4) 5)) ;=> (1 2 3 4 5)
(flatten-tree '(1 () () 5)) ;=> (1 5)
"
(cond
((null x) tail)
((atom x) (list* x tail))
((consp x) (flatten-tree (car x)
(flatten-tree (cdr x) tail)))))
Now it's just a matter of flatting a list, removing the number that are not prime, and removing duplicates from that list. Common Lisp includes functions for doing these things, namely remove-if-not and remove-duplicates. Those are the "safe" versions that don't modify their input arguments. Since we know that the flattened list is freshly generated, we can use their (potentially) destructive counterparts, delete-if-not and delete-duplicates.
There's a caveat when you're removing duplicate elements, though. If you have a list like (1 3 5 3), there are two possible results that could be returned (assuming you keep all the other elements in order): (1 3 5) and (1 5 3). That is, you can either remove the the later duplicate or the earlier duplicate. In general, you have the question of "which one should be left behind?" Common Lisp, by default, removes the earlier duplicate and leaves the last occurrence. That behavior can be customized by the :from-end keyword argument. It can be nice to duplicate that behavior in your own API.
So, here's a function that puts all those considerations together.
(defun primes-in-tree (tree &key from-end)
"Flatten the tree, remove elements which are not prime numbers,
using FROM-END to determine whether earlier or later occurrences
are kept in the list.
Examples:
(primes-in-list '(2 (7 4) ((3 3) 5) 6 7))
;;=> (2 3 5 7)
(primes-in-list '(2 (7 4) ((3 3) 5) 6 7) :from-end t)
;;=> (2 7 3 5)"
;; Because FLATTEN-TREE returns a fresh list, it's OK
;; to use the destructive functions DELETE-IF-NOT and
;; DELETE-DUPLICATES.
(delete-duplicates
(delete-if-not 'primep (flatten-tree list))
:from-end from-end))

Common Lisp: how to access a row of a certain multi-dimension array?

Let's say I wrote
(setf s (make-array (list 9 9) :element-type 'bit))
so s is a 9x9 matrix of bits.
and I want to get the 1st row of s. How do I get that?
I could have done the following:
(setf s (make-array 9
:element-type 'array
:initial-element
(make-array 9 :element-type 'bit)))
and access the first row by (svref s 0).
But I want to know if there is a built-in way.
(And the 2 dim array seems to allocate less bytes).
(defun array-slice (arr row)
(make-array (array-dimension arr 1)
:displaced-to arr
:displaced-index-offset (* row (array-dimension arr 1))))
This only works for row slices and doesn't, IIRC, copy the array. Writing to the slice will modify the original array.

Resources