It's a tad more complicated than the title suggests, but I couldn't condense it to one sentence.
I am using Clisp and currently have a list of lists. The outer list is arbitrarily long, while the inner lists are 4 integers long. Here is an example of what I may have.
((2 1 1 0) (1 1 0 0) (1 0 0 1) (1 1 0 0) (1 0 1 0) (1 0 0 0))
Now each inner list is made up of 2 parts, the first item is the 'multiplier'. And the last 3 items are just values the list holds. So in a sense, (10 1 1 0) is the same as (5 1 1 0) (5 1 1 0).
I need a function which can condense this list down, so that there is no 2 lists that contain the same last 3 items. But only one list for every unique last 3 items, and a value in the first space which is 'how many' of this list there is. If that makes sense...
So this
((2 1 1 0) (1 1 0 0) (1 0 0 1) (1 1 0 0) (1 0 1 0) (1 0 0 0))
; ^ ^
would become this
((2 1 1 0) (2 1 0 0) (1 0 0 1) (1 0 1 0) (1 0 0 0))
; ^
I am at a loss of what direction to take this atm. And would like some advice on how I could best tackle this
In Common Lisp, the easiest way to do this is probably to build a histogram of your data using a hash table, and then to iterate through the hash table to recombine the counts and the keys. The following histogram that creates the histogram as a hash table:
(defun histogram (sequence &key hash-args key delta-key)
"Create a histogram (hash-table) mapping elements to their frequencies.
* sequence---a proper sequence
* hash-args---a list of initargs for MAKE-HASH-TABLE, default is NIL
* key---a designator for a function of one argument, or NIL
* delta-key---a designator for a function of one argument, or NIL
HISTOGRAM returns a hash table mapping keys hash-keys extracted from
the elements of SEQUENCE by KEY to frequencies computed using
DELTA-KEY. The hash table is created using HASH-ARGS as initargs.
The default is the empty list, in which case the hash-table will
compare hash keys with EQL. HISTOGRAM iterates through the elements
of SEQUENCE, using KEY to extract a hash key from the element and
DELTA-KEY to extract an increment value, and increments the entry for
the hash key in the histogram by the increment value.
### See Also:
Section 17.2 (Rules about Test Functions), Section 3.6 (Traversal
Rules and Side Effects)"
(flet ((key (x)
(if (null key) x
(funcall key x)))
(delta (x)
(if (null delta-key) 1
(funcall delta-key x))))
(let ((histogram (apply 'make-hash-table hash-args)))
(prog1 histogram
(map nil #'(lambda (element)
(incf (gethash (key element) histogram 0)
(delta element)))
sequence)))))
Then it's not too hard to write a function to get a list of (value . key) pairs from a hash table:
(defun hash-table-to-list (table)
"Return a list of (VALUE . KEY) pairs based on TABLE."
(loop
for k being each hash-key in table
using (hash-value v)
collect (cons v k)))
To apply this to your data, you need an equal hash table so that the keys (which are lists of integers) are compared properly, and the key function is rest, because you're comparing the tails of the input. The delta-key function is first, because you want to increment the "count" by the first element in the list.
CL-USER> (histogram '((2 1 1 0) (1 1 0 0) (1 0 0 1)
(1 1 0 0) (1 0 1 0) (1 0 0 0))
:hash-args '(:test equal)
:key 'rest
:delta-key 'first)
;=> #<HASH-TABLE :TEST EQUAL :COUNT 5 {10051558E3}>
CL-USER> (hash-table-to-list *)
;=> ((2 1 1 0) (2 1 0 0) (1 0 0 1) (1 0 1 0) (1 0 0 0))
CL-USER> (histogram '((5 1 1 0) (3 1 1 0) (1 0 0 1) (1 0 0 1))
:hash-args '(:test equal)
:key 'rest
:delta-key 'first)
;=> #<HASH-TABLE :TEST EQUAL :COUNT 2 {100527DA53}>
CL-USER> (hash-table-to-list *)
;=> ((8 1 1 0) (2 0 0 1))
Here's a version for Racket (sorry, I'm not a Common Lisper, so can't help there):
(define (count-alist alist)
(define ht (for/fold ((ht (hash)))
((ass (in-list alist)))
(hash-update ht (cdr ass) (curry + (car ass)) 0)))
(for/list (((key val) (in-hash ht)))
(cons val key)))
Let's break the problem down in English:
To collect up the actual counts of your "three numbers", build a hash table using the "three numbers" as the key, and 0 as the default value.
For each item in your incoming list, you'd add the count to the value, then update the hash table with that new value.
Then iterate through your hash table to build your result list.
Related
So, I wrote the following program to determine the max element in a 2D array using LISP. Note, this is my first time using the language, so I am unfamiliar with many aspects.
The function should return the coordinates of the largest element in row-major order. In the below example, the largest element, 7, is found at index (2, 4). However, when the program is executed, it returns (3, 15).
It seems to be starting the index at 1, rather than 0, for the row. Additionally, it seems to be counting all indexes up to 15, where the max element is found. I am unsure how to fix this issue.
(defun find-max-location (x)
(let (
(maxval -100)
(loc nil)
(cur 0)
(cur2 0)
(k 1)
(l 1)
(f 0))
(loop for i in x do
(loop for j in i do
(if (> j maxval)
(progn
(setf cur k)
(setf cur2 l)
(setf maxval j))
)
(setf l (+ l 1))
)
(setf k (+ k 1))
)
(list cur cur2)))
(find-max-location '((0 1 0 0 1) (0 2 2 0 0) (3 0 1 4 7) (0 1 2 0 0) (1 2 1 0 3)))
The error is very simple: you don't reinitialize tha value of l each time the inner iteration is started. For the indexes, instead, if you want to start from 0, then you should initialize them with 0, and not with 1. Here is a rewriting of the code, in which I have removed the unused variables loc and f, used when instead of the one-branch if, and used a more conventional way of writing in Common Lisp:
(defun find-max-location (x)
(let ((maxval -100)
(cur 0)
(cur2 0)
(k 0)
l)
(loop for i in x
do (setf l 0)
(loop for j in i
do (when (> j maxval)
(setf cur k)
(setf cur2 l)
(setf maxval j))
(setf l (+ l 1)))
(setf k (+ k 1)))
(list cur cur2)))
(find-max-location '((0 1 0 0 1) (0 2 2 0 0) (3 0 1 4 7) (0 1 2 0 0) (1 2 1 0 3))) ; => (2 4)
Note that setf can perform multiple assignments, so the code can be simplified as:
(defun find-max-location (x)
(let ((maxval -100)
(cur 0)
(cur2 0)
(k 0)
l)
(loop for i in x
do (setf l 0)
(loop for j in i
do (when (> j maxval)
(setf cur k
cur2 l
maxval j))
(setf l (+ l 1)))
(setf k (+ k 1)))
(list cur cur2))
Finally, there are very convenient mechanisms in loop that allow the initialization of variables (with) and the looping of variables “in parallel” with the iteration variables. So here is the final iterative version of the function (with the use of when as loop keyword):
(defun find-max-location (x)
(loop with maxval = -100
and cur = 0
and cur2 = 0
for i in x
for k from 0
do (loop for j in i
for l from 0
when (> j maxval)
do (setf cur k
cur2 l
maxval j))
finally (return (list cur cur2))))
A very good starting point to master the complexity of loop is the chapter “Loop for Black Belts" of the free book “Practical Common Lisp”. Another excellent resource to learn Common Lisp is the “Common Lisp Cookbook”.
Finally, it is worth to note that Common Lisp has arrays, including 2D arrays, so that you can represent them directly, instead that with lists of lists, as in your example.
It seems that you're thinking about this in a very procedural manner. Recursion is your friend here.
How would we find the max and its position in a simple list? We'd recursively count up from 0, evaluating each element to see if it's greater than the current max or if max hasn't yet been set. We'd use the max parameter to the function to update this information. Hitting the end of the list we'd return the max.
(defun find-max-in-row (lst &optional (pos 0) (max '()))
(cond ((null lst)
max)
(or (null max) (> (car lst) (car max))
(find-max-in-row (cdr lst) (1+ pos) (list (car lst) pos)))
(t
(find-max-in-row (cdr lst) (1+ pos) max))))
(defvar foo '(1 6 8 2 7))
(format t "~a~%" (find-max-in-row foo))
Prints:
(8 2)
This logic can be adapted to find the column where a max value occurs. A starting point would be to map this function to your list of rows.
(format t "~a~%"
(mapcar #'find-max-in-row
'((0 1 0 0 1)
(0 2 2 0 0)
(3 0 1 4 7)
(0 1 2 0 0)
(1 2 1 0 3))))
Prints:
((1 1) (2 1) (7 4) (2 2) (3 4))
Here is another answer that defines a higher-order function indexed-list-fold, similar to folding functions like reduce or fold_left in other functional languages.
It's purpose is to take a function that works on a accumulator, and element and its index, to produce the next value for the accumulator. I define it as follows, with loop:
(defun indexed-list-fold (function accumulator list)
(loop
:for acc = accumulator :then res
:for elt :in list
:for idx :from 0
:for res = (funcall function acc elt idx)
:finally (return acc)))
Notice the use of for/then construct and how the order of the clauses matter: for elt in list may interrupt the iteration when reaching the end of the list, so it is important that acc is computed first. This is especially important if the list is empty initially, otherwise its value would be always nil and not accumulator.
Let's write a function that finds the maximum value and its location, in a list:
(defun find-max-location-in-list (list)
(flet ((fold (max.pos elt idx)
(let ((max (car max.pos)))
(if (or (null max) (< max elt))
(cons elt idx)
max.pos))))
(indexed-list-fold #'fold (cons nil nil) list)))
For example:
> (find-max-location-in-list '(1 3 8 3 12 -4 -200))
(12 . 4)
The maximum value is 12 at position 4.
In order to generalize this to a list of lists (a tree), the fold function must be able to reference itself in a recursive call to indexed-list-fold, so it is now declared with labels:
(defun find-max-location-in-tree (tree)
(labels ((fold (max.pos elt idx)
(let ((idx (alexandria:ensure-list idx)))
(etypecase elt
(real (let ((max (car max.pos)))
(if (or (null max) (< max elt))
(cons elt idx)
max.pos)))
(list
(indexed-list-fold (lambda (max.pos elt child)
(fold max.pos elt (cons child idx)))
max.pos
elt))))))
(indexed-list-fold #'fold (cons nil nil) tree)))
The logic is the same as before, except that elt may now be a list itself, and idx is a stack of indices. For example:
> (find-max-location-in-tree '(1 3 8 3 12 -4 -200))
(12 4)
Notice how the cdr of the result is a list. For the example you provided:
> (find-max-location-in-tree '((0 1 0 0 1)
(0 2 2 0 0)
(3 0 1 4 7)
(0 1 2 0 0)
(1 2 1 0 3)))
(7 4 2)
The maximum value is 7 at index 4 of the list at index 2.
I would loop in a nested way through the list-of-list (lol) and setf the values when bigger than current max-val:
(defun find-max-location (lol)
"Find max element's coordinate in a lol"
(let ((max-val (caar lol))
(max-coord '(0 . 0))) ;; start with first element
(loop for il in lol
for i from 0
do (loop for e in il
for j from 0
when (> e max-val)
do (setf max-val e
max-coord (cons i j))))
(values max-coord max-val)))
This function can handle irregular list-of-lists.
Using values, you can decide whether just to use only the coordinates or
to also capture the max-value itself.
;; usage:
(find-max-location '((0 1 9) (4 9) (6 7 8)))
;; => (0 . 2)
;; => 9
;; capture max-val too:
(multiple-value-bind (coord val) (find-max-location '((0 1 9) (4 9) (6 7 8)))
(list val (car coord) (cdr coord)))
;; => (9 0 2)
;; or destructure coord:
(multiple-value-bind (coord val) (find-max-location '((0 1 9) (4 5) (6 7 8)))
(destructuring-bind (x . y) coord
(list val x y)))
The first max-val is the very first element in this list-of-list.
According to the book, this is what the function definition is,
The function scramble takes a non-empty tuple in which no argument is greater than its own index and returns a tuple of same length. Each number in the argument is treated as a backward index from its own position to a point earlier in tuple. The result at each position is obtained by counting backward from the current position according to this index.
And these are some examples,
; Examples of scramble
(scramble '(1 1 1 3 4 2 1 1 9 2)) ; '(1 1 1 1 1 4 1 1 1 9)
(scramble '(1 2 3 4 5 6 7 8 9)) ; '(1 1 1 1 1 1 1 1 1)
(scramble '(1 2 3 1 2 3 4 1 8 2 10)) ; '(1 1 1 1 1 1 1 1 2 8 2)
Here is the implementation,
(define pick
(λ (i lat)
(cond
((eq? i 1) (car lat))
(else (pick (sub1 i)
(cdr lat))))))
(define scramble-b
(lambda (tup rev-pre)
(cond
((null? tup) '())
(else
(cons (pick (car tup) (cons (car tup) rev-pre))
(scramble-b (cdr tup)
(cons (car tup) rev-pre)))))))
(define scramble
(lambda (tup)
(scramble-b tup '())))
This is a case where using a very minimal version of the language means that the code is verbose enough that understanding the algorithm is not perhaps easy.
One way of dealing with this problem is to write the program in a much richer language, and then work out how the algorithm, which is now obvious, is implemented in the minimal version. Let's pick Racket as the rich language.
Racket has a function (as does Scheme) called list-ref: (list-ref l i) returns the ith element of l, zero-based.
It also has a nice notion of 'sequences' which are pretty much 'things you can iterate over' and a bunch of constructs whose names begin with for for iterating over sequences. There are two functions which make sequences we care about:
in-naturals makes an infinite sequence of the natural numbers, which by default starts from 0, but (in-naturals n) starts from n.
in-list makes a sequence from a list (a list is already a sequence in fact, but in-list makes things clearer and there are rumours also faster).
And the iteration construct we care about is for/list which iterates over some sequences and collects the result from its body into a list.
Given these, then the algorithm is almost trivial: we want to iterate along the list, keeping track of the current index and then do the appropriate subtraction to pick a value further back along the list. The only non-trivial bit is dealing with zero- vs one-based indexing.
(define (scramble l)
(for/list ([index (in-naturals)]
[element (in-list l)])
(list-ref l (+ (- index element) 1))))
And in fact if we cause in-naturals to count from 1 we can avoid the awkward adding-1:
(define (scramble l)
(for/list ([index (in-naturals 1)]
(element (in-list l)))
(list-ref l (- index element))))
Now looking at this code, even if you don't know Racket, the algorithm is very clear, and you can check it gives the answers in the book:
> (scramble '(1 1 1 3 4 2 1 1 9 2))
'(1 1 1 1 1 4 1 1 1 9)
Now it remains to work out how the code in the book implements the same algorithm. That's fiddly, but once you know what the algorithm is it should be straightforward.
If the verbal description looks vague and hard to follow, we can try following the code itself, turning it into a more visual pseudocode as we go:
pick i [x, ...ys] =
case i {
1 --> x ;
pick (i-1) ys }
==>
pick i xs = nth1 i xs
(* 1 <= i <= |xs| *)
scramble xs =
scramble2 xs []
scramble2 xs revPre =
case xs {
[] --> [] ;
[x, ...ys] -->
[ pick x [x, ...revPre],
...scramble2 ys
[x, ...revPre]] }
Thus,
scramble [x,y,z,w, ...]
=
[ nth1 x [x] (*x=1..1*)
, nth1 y [y,x] (*y=1..2*)
, nth1 z [z,y,x] (*z=1..3*)
, nth1 w [w,z,y,x] (*w=1..4*)
, ... ]
Thus each element in the input list is used as an index into the reversed prefix of that list, up to and including that element. In other words, an index into the prefix while counting backwards, i.e. from the element to the left, i.e. towards the list's start.
So we have now visualized what the code is doing, and have also discovered requirements for its input list's elements.
It is working fine and I've checked manually that everything is running, but I now need to figure out how to print out the answer in a chessboard like fashion, where I have an nxn board of 0's and 1's, where 1's are the queens. I am using vectors and for example lets say I run nq-bt for a 5x5 board I get the answer: #(0 2 4 1 3)
nq-bt is the method that gives me the answer above
Here is my pseudocode for trying to get this to work:
(define (print-answer n)
(make n equal to the returned vector of method (nq-bt))
(loop until it hits end of the returned vector_length)
(set value equal to (vector ref of n (*variable used for first loop)))
(loop again the length of returned vector_length)
(print 0's until hits vector ref's value, then print 1, then print 0's till end of loop)
(print newline)))))
I know this is insane pseudocode, but my problem is that I'm not used to scheme and there isn't too much documentation on how I could do any of this. Any help would be greatly appreciated.
You didn't mention which Scheme interpreter you're using, so first I'll show you a generic solution that uses standard procedures. For starters, we must decide how are we going to loop over the vector (say, using named lets).
Also notice that I changed the input parameter, it's easier if we pass the board's solution, besides I don't see how you can use the size n of the board if nq-bt doesn't receive it as a parameter (I hope nq-bt isn't obtaining n from a global define, that wouldn't be right):
(define (print-answer board)
(let outer-loop ((i 0))
(cond ((< i (vector-length board))
(let ((queen (vector-ref board i)))
(let inner-loop ((j 0))
(cond ((< j (vector-length board))
(display (if (= queen j) 1 0))
(display " ")
(inner-loop (+ j 1))))))
(newline)
(outer-loop (+ i 1))))))
Now, if you're lucky and use Racket we can write a simpler and more idiomatic implementation without all the kludge of the previous solution:
(define (print-answer board)
(for ([i (in-range (vector-length board))])
(let ([queen (vector-ref board i)])
(for ([j (in-range (vector-length board))])
(printf "~a " (if (= queen j) 1 0))))
(newline)))
Either way we can call print-answer with the result returned by nq-bt. For example:
(print-answer '#(0 2 4 1 3))
1 0 0 0 0
0 0 1 0 0
0 0 0 0 1
0 1 0 0 0
0 0 0 1 0
I'm currently working on finding the row sequences of Pascal's triangle. I wanted to input the row number and output the sequence of numbers in a list up until that row. For example, (Pascal 4) would give the result (1 1 1 1 2 1 1 3 3 1).
I am trying to use an algorithm that I found. Here is the algorithm itself:
Vc = Vc-1 * ((r - c)/c)
r and c are supposed to be row and column, and V0=1. The algorithm can be specifically found on the wikipedia page in the section titled "Calculating and Individual Row or Diagonal."
Here is the code that I have so far:
(define pascal n)
(cond((zero? n) '())
((positive? n) (* pascal (- n 1) (/ (- n c)c))))
I know that's hardly anything but I've been struggling a lot on trying to find scoping the function with a let or a lambda to incorporate column values. Additionally, I've also been struggling on the recursion. I don't really know how to establish the base case and how to get to the next step. Basically, I've been getting pretty lost everywhere. I know this isn't showing much, but any step in the right direction would be greatly appreciated.
Using as a guide the entry in Wikipedia, this is a straightforward implementation of the algorithm for calculating a value in the Pascal Triangle given its row and column, as described in the link:
#lang racket
(define (pascal row column)
(define (aux r c)
(if (zero? c)
1
(* (/ (- r c) c)
(aux r (sub1 c)))))
(aux (add1 row) column))
For example, the following will return the first four rows of values, noticing that both rows and columns start with zero:
(pascal 0 0)
(pascal 1 0)
(pascal 1 1)
(pascal 2 0)
(pascal 2 1)
(pascal 2 2)
(pascal 3 0)
(pascal 3 1)
(pascal 3 2)
(pascal 3 3)
Now we need a procedure to stick together all the values up until the desired row; this works for Racket:
(define (pascal-up-to-row n)
(for*/list ((i (in-range n))
(j (in-range (add1 i))))
(pascal i j)))
The result is as expected:
(pascal-up-to-row 4)
> '(1 1 1 1 2 1 1 3 3 1)
I discussed Pascal's Triangle at my blog.
In your question, the expression for Vc is just for one row. That translates to code like this:
(define (row r)
(let loop ((c 1) (row (list 1)))
(if (= r c)
row
(loop (+ c 1) (cons (* (car row) (- r c) (/ c)) row)))))
Then you just put together a bunch of rows to make the triangle:
(define (rows r)
(let loop ((r r) (rows (list)))
(if (zero? r)
rows
(loop (- r 1) (append (row r) rows)))))
And here's the output:
> (rows 4)
(1 1 1 1 2 1 1 3 3 1)
The base case is (= r c) in the first function and (zero? r) in the second.
If you want to write subscripts clearly, you can adopt the notation used by TeX: subscripts are introduced by an underscore and superscripts by a caret, with braces around anything bigger than one character. Thus Vc in your notation would be V_c, and Vc-1 in your notation would be V_{c-1}.
If I have the following list:
(define thelist '(0 1 0 0 7 7 7))
How can I write a function that returns a new list in which the value in the requested cell is replaced.
Example:
(set-cell thelist 2 4)
This would return a new list with the same values, but in cell (2) there will be the value 4 instead of 1:
(0 4 0 0 7 7 7)
HtDP provides a really concrete methodology for solving this kind of problem. For this problem, your job is going to be to write down the template for lists, then to stare at it until you can see what the arguments to the recursive call should be, and what the results will be. I'm hoping that you've solved a bunch of warm-up problems on lists--compute the length of a list, count the number of 6's in the list, etc.
Although you can implement the requested functionality with lists, the natural way to solve that problem is to use a vector, and remember that in Scheme indexes start in 0 (that's why the second argument for vector-set! is a 1 and not a 2):
(define thevector (vector 0 1 0 0 7 7 7))
; thevector is #(0 1 0 0 7 7 7)
(vector-set! thevector 1 4)
; thevector is #(0 4 0 0 7 7 7)
Now, if you definitely need to use a list, something like this would work:
(define (set-cell lst idx val)
(cond ((null? lst) '())
((zero? idx) (cons val (cdr lst)))
(else (cons (car lst)
(set-cell (cdr lst) (sub1 idx) val)))))
And you'd call it like this:
(define thelist '(0 1 0 0 7 7 7))
(set-cell thelist 1 4)
> (0 4 0 0 7 7 7)
Again, I'm using 0-based indexing, as is the convention. Also notice that thelist was not modified, instead, set-cell returns a new list with the modification.
Other people have mentioned the 0-based indexes convention. I'll assume 0-based indexes, then.
The other answers you've gotten are wrong, given how you stated your problem. I'll cite the key point in your question (my emphasis):
This would return a new list with the same values, but in cell (2) there will be the value 4 instead of 1.
The answers you've been given are modifying a list in place, not returning a newly constructed list while leaving the original intact!
Here's a correct (though suboptimal) solution:
(define (set-list index new-value list)
(if (= index 0)
(cons new-value (cdr list))
(cons (car list)
(set-list (- index 1) new-value (cdr list))))))
I didn't bother to put in error checking here (e.g., if somebody passes in the empty list, or a list with too few elements relative to index, or a negative index).
Here is an approach using an auxiliary function that starts the count from 0. On each recursion, the count is incremented, and the list is shortened.
If the desired index is hit, the recursion can stop. If it gets to the end of the list without hitting the index, the original list is returned.
(define (set-cell ls ind val)
(define (aux c ls)
(cond ((null? ls) ls)
((= c ind) (cons val (cdr ls)))
(else (cons (car ls) (aux (+ c 1) (cdr ls))))))
(aux 0 ls))
What a mess above!! Keep it simple: Scheme has list-set! for this.
Example:
(define ls (list 1 2 3 4 5))
(list-set! ls 0 "new")
(list-set! ls 3 "changed")
(list-ref ls 0)
=> "new"
ls
=> '("new" 2 3 "changed" 5)
However, you might want to limit assignments on lists. Vectors are faster for this since you don't need to traverse the previous elements. Use lists whenever you can't specify the length before construction or when the length is continously changed.