I'm attempting to create a function that creates copies of whatever list the user puts in by the desired number of copies.
User: (copy '(A) '(7))
Output: (A A A A A A A)
(defun copy (x y)
(cond ((-1 counter)
nil)
(T
(list (cons (car x) (cdr x)))
copy
(cdr x)))
I'm attempting to set up a counter and just create a new list into the current list by decrementing the counter. So far the counter is pseudo-code.
This is the counter I'm trying to figure out.
(defun count (y)
(let ((a y))
(- a 1)))
The error I get is that whatever I put into y isn't a number.
While I can understand why the first parameter is a list, the second must be a number. A very simple implementation might look like:
(defun copy (lst count)
(when (> count 0)
(append (copy-list lst) (copy lst (1- count)))))
Testing:
CL-USER> (copy '(A) 7)
(A A A A A A A)
CL-USER> (copy '(A B C) 7)
(A B C A B C A B C A B C A B C A B C A B C)
The usual caveats concerning the use of append and object copying apply.
I'd suggest passing your list as a &rest argument instead and use loop:
(defun repeat (n &rest items)
(loop repeat n append items))
Test
CL-USER> (repeat 10 0 1 2)
(0 1 2 0 1 2 0 1 2 0 1 2 0 1 2 0 1 2 0 1 2 0 1 2 0 1 2 0 1 2)
Related
I have a function that doubles every item in a list:
(defun double (L)
(cond
((atom L) nil)
(t (cons (car L) (cons (car L ) (double (cdr L))))) ) )
(double '(a b c )) => (a a b b c c)
How could I accomplish the same result while dividing by 2 the number of times the function calls cons ? (i.e. in the previous example, it calls cons 6 times. How could I do it with 3 times only?)
Thanks!
Edit 2, after jkiiski's comments, seems like it works now:
(defun double2 (L)
(cond
((atom L) nil)
(t (setf
(cdr L)
(cons (car L ) (double2 (cdr L))))
L) ) )
(double2 (list 'a 'b 'c)) => (a a b b c c)
Here is an another way of doing it, without recursion. Note that this answer assumes you are doing a homework and trying to find a way to avoid creating a fresh list, which is what the simplest solution does. In practice, you would simply use collect twice in a loop, like Sylwester demonstrated. Here the original input list is destructively modified.
Copy list
Suppose your original list is (1 2 3). Instead of consing
elements yourself, you can call (copy-list list), which performs the
required amount of consing. That's all you need to consider for memory
allocation. Then, you "only" need to interleave all the cons cells to
obtain the desired repetition.
Keep the list variable as given, and define two variables which
iterate over both lists:
current = (1 2 3) ;; original
fresh = (1 2 3) ;; copy
Reordering cells
Graphically, you want to change CDRs to "thread" existing cons-cells together. At first, both lists look like this:
current ( 1 . x-)-->( 2 . x-)-->...
fresh ( 1 . x-)-->( 2 . x-)-->...
But you want to have:
current ( 1 . x ) ( 2 . x )
| ^ |
V | V
fresh ( 1 . x ) ( 2 . ...)
More formally, at the beginning of each step, and when your lists are not empty, the above variables can be decomposed as follows:
current = (chead . ctail)
fresh = (fhead . ftail)
You want to make current's tail point to the fresh cons-cell, and make fresh's tail point to ctail.
Once you finish interleaving cells, the variables should be bound as follows:
current = (chead . (fhead . ctail))
fresh = ftail
And then, you can descend twice in current, so that finally:
current = ctail
fresh = ftail
From here, you can continue with the rest of both lists. Note that
list still contains the original cons cell you were given as an
input.
Code
(defun double-loop (list)
(loop
with fresh = (copy-list list) ;; cursor to new cons cells
with current = list ;; cursor to current cell
while fresh ;; stop when fresh is nil
do (print (list list current fresh)) ;; for debugging
(rotatef (cdr fresh) (cdr current) fresh) ;; change CDRs, rebind fresh
(setf current (cddr current)) ;; update CURRENT
finally (return list))) ;; LIST points to head of result
I am using ROTATEF to wire cons cells:
(rotatef (cdr fresh) (cdr current) fresh)
What happens is that the value of fresh is placed in (cdr current), whose previous value is itself placed in (cdr fresh), the original
value of which eventually becomes the new value bound to fresh.
Example
Here is an example trace output:
CL-USER> (double-loop (list 0 1 2 3))
((0 1 2 3) (0 1 2 3) (0 1 2 3))
((0 0 1 2 3) (1 2 3) (1 2 3))
((0 0 1 1 2 3) (2 3) (2 3))
((0 0 1 1 2 2 3) (3) (3))
=> (0 0 1 1 2 2 3 3)
After jkiiski's comments, seems like it works now:
(defun double2 (L)
(cond
((atom L) nil)
(t (setf
(cdr L)
(cons (car L ) (double2 (cdr L))))
L) ) )
(double2 (list 'a 'b 'c)) => (a a b b c c)
I have a list of lists and want to test if all elements are different from each other, i.e. equal should return nil for all combinations of list elements.
E.g.
(defparameter feld '((1 0 0 5 5 0)
(0 0 0 0 0 0)
(1 1 5 5 0 0)
(0 1 0 1 5 5)
(5 5 1 0 1 0)
(1 0 1 0 5 5)))
I thought of using reduce but as far as I understand it only tests the equality of neighbors, as would do a loop construct like:
(loop for i below (length feld)
for j from 1
if (equal (nth i feld) (nth j feld)) return t)
Is there a simple way using a standard construct which I do not see at the moment or do I have to create a recursive function?
The whole data structure represents a "board game" where every list is a line on the board and each element in the inside-lists is a value of this very field. The three numerical values (0, 1 and 5) are something like empty, Symbol A and Symbol B. A valid board cannot have two identical lines. This is why I want to identify those.
Basically, it is like remove-duplicates without removing. In the meantime I was thinking about something like this:
(defun duplicates-p (lst)
(cond ((null lst) '())
((member (car lst) (cdr lst)) t)
(t (duplicates-p (rest lst)))))
Something like this:
(defun unique (lsts &aux (h (make-hash-table :test 'equal)))
(loop :for lst :in lsts
:never (gethash lst h)
:do (setf (gethash lst h) t)))
Why following function (match-redefine) is not working?
(define vlist (list 10 20 30))
(match-define (list aa bb cc) (list 1 2 3))
(define alist (list aa bb cc))
alist
vlist
(define (match-redefine dst_list src_list)
(for ((d dst_list)(s src_list)) (set! d s)) )
(rnmatch-redefine alist vlist)
alist
vlist
The output is:
'(1 2 3)
'(10 20 30)
'(1 2 3)
'(10 20 30)
The destination list (alist) remains unchanged. Can this function be made to work?
Edit: I tried vector as suggested by #OscarLopez in the answers, but it does not work:
(match-define (list a b c) (list 0 0 0 ) )
(define variable_vect (vector a b c))
a
b
c
(define valuelist (list 1 2 3) )
(for ((i variable_vect)(j valuelist)) ; does not work
(set! i j))
variable_vect
a
b
c
(set! variable_vect valuelist)
(println "------- after ----------")
variable_vect
a
b
c
Output is:
0
0
0
'#(0 0 0)
0
0
0
"------- after ----------"
'(1 2 3)
0
0
0
Edit: It seems I will have to use special class to apply this:
(define myob%
(class object%
(super-new)
(init-field val)
(define/public (getval) val)
(define/public (setval v) (set! val v)) ))
(define (copyvalues objlist valuelist)
(for ((a alist)(v valuelist)) (send a setval v)) )
(define (show_objlist alist)
(for ((a alist)) (println (send a getval))) )
; USED AS FOLLOWS:
(define ob1 (make-object myob% 5))
(define ob2 (make-object myob% 5))
(define ob3 (make-object myob% 5))
(define alist (list ob1 ob2 ob3))
(println "---------- first assignment -----------")
(define vlist (list 1 2 3))
(copyvalues alist vlist)
(show_objlist alist)
(println "---------- second assignment -----------")
(define ylist (list 10 20 30))
(copyvalues alist ylist)
(show_objlist alist)
(println "---------- individual access -----------")
(send ob1 getval)
(send ob3 getval)
Output is:
"---------- first assignment -----------"
1
2
3
"---------- second assignment -----------"
10
20
30
"---------- individual access -----------"
10
30
You ask why the function is not working.
The reason is that (set! d s) is doing something
you do not expect.
Observe:
#lang racket
(define vlist (list 10 20 30))
(match-define (list aa bb cc) (list 1 2 3))
(define alist (list aa bb cc))
alist
vlist
(define (match-redefine dst_list src_list)
(for ((d dst_list)(s src_list))
(set! d s)
(displayln (~a "d is now: " s))))
(match-redefine alist vlist)
The output is:
'(1 2 3)
'(10 20 30)
d is now: 10
d is now: 20
d is now: 30
This means that you change the value of d (not the value of the variable which corresponds to the symbols that d runs through.
See your previous question on the same topic.
Again, this is not the way we do things in Scheme. Besides, your code is simply reassigning a local variable that was pointing to an element in the list, the destination list remains unmodified.
You could use vectors instead of lists - those can be modified, exactly as you would modify an array in the most common programming languages, something like this:
(define value_list (list 1 2 3))
(define value_vect (vector 0 0 0))
value_vect
=> '#(0 0 0)
(for [(i (in-range (vector-length value_vect)))
(value value_list)]
(vector-set! value_vect i value))
value_vect
=> '#(1 2 3)
Anyway you should not modify a list of variables, just return a list with the new values. And don't think about mutating the list - although it is possible to do so using mutable pairs, that's not the correct way to deal with this situation, please stop thinking about mutating everything you encounter!
I have two lists: (1 2 3) and (a b) and I need to create something like this (1 2 3 1 2 3). The result is a concatenation of the first list as many times as there are elements in the second. I should use some of the functions (maplist/mapcar/mapcon, etc.). This is exactly what I need, although I need to pass first list as argument:
(mapcan #'(lambda (x) (list 1 2 3)) (list 'a 'b))
;=> (1 2 3 1 2 3)
When I try to abstract it into a function, though, Allegro freezes:
(defun foo (a b)
(mapcan #'(lambda (x) a) b))
(foo (list 1 2 3) (list 'a 'b))
; <freeze>
Why doesn't this definition work?
There's already an accepted answer, but I think some more explanation about what's going wrong in the original code is in order. mapcan applies a function to each element of a list to generate a bunch of lists which are destructively concatenated together. If you destructively concatenate a list with itself, you get a circular list. E.g.,
(let ((x (list 1 2 3)))
(nconc x x))
;=> (1 2 3 1 2 3 1 2 3 ...)
Now, if you have more concatenations than one, you can't finish, because to concatenate something to the end of a list requires walking to the end of the list. So
(let ((x (list 1 2 3)))
(nconc (nconc x x) x))
; ----------- (a)
; --------------------- (b)
(a) terminates, and returns the list (1 2 3 1 2 3 1 2 3 ...), but (b) can't terminate since we can't get to the end of (1 2 3 1 2 3 ...) in order to add things to the end.
Now that leaves the question of why
(defun foo (a b)
(mapcan #'(lambda (x) a) b))
(foo (list 1 2 3) '(a b))
leads to a freeze. Since there are only two elements in (a b), this amounts to:
(let ((x (list 1 2 3)))
(nconc x x))
That should terminate and return an infinite list (1 2 3 1 2 3 1 2 3 ...). In fact, it does. The problem is that printing that list in the REPL will hang. For instance, in SBCL:
CL-USER> (let ((x (list 1 2 3)))
(nconc x x))
; <I manually stopped this, because it hung.
CL-USER> (let ((x (list 1 2 3)))
(nconc x x) ; terminates
nil) ; return nil, which is easy to print
NIL
If you set *print-circle* to true, you can see the result from the first form, though:
CL-USER> (setf *print-circle* t)
T
CL-USER> (let ((x (list 1 2 3)))
(nconc x x))
#1=(1 2 3 . #1#) ; special notation for reading and
; writing circular structures
The simplest way (i.e., fewest number of changes) to adjust your code to remove the problematic behavior is to use copy-list in the lambda function:
(defun foo (a b)
(mapcan #'(lambda (x)
(copy-list a))
b))
This also has an advantage over a (reduce 'append (mapcar ...) :from-end t) solution in that it doesn't necessarily allocate an intermediate list of results.
You could
(defun f (lst1 lst2)
(reduce #'append (mapcar (lambda (e) lst1) lst2)))
then
? (f '(1 2 3) '(a b))
(1 2 3 1 2 3)
Rule of thumb is to make sure the function supplied to mapcan (and destructive friends) creates the list or else you'll make a loop. The same applies to arguments supplied to other destructive functions. Usually it's best if the function has made them which makes it only a linear update.
This will work:
(defun foo (a b)
(mapcan #'(lambda (x) (copy-list a)) b))
Here is some alternatives:
(defun foo (a b)
;; NB! apply sets restrictions on the length of b. Stack might blow
(apply #'append (mapcar #'(lambda (x) a) b))
(defun foo (a b)
;; uses loop macro
(loop for i in b
append a))
I really don't understand why b cannot be a number? You're really using it as church numbers so I think I would have done this instead:
(defun x (list multiplier)
;; uses loop
(loop for i from 1 to multiplier
append list))
(x '(a b c) 0) ; ==> nil
(x '(a b c) 1) ; ==> (a b c)
(x '(a b c) 2) ; ==> (a b c a b c)
;; you can still do the same:
(x '(1 2 3) (length '(a b))) ; ==> (1 2 3 1 2 3)
I have written the following program to calculate the sum of all multiples of 3 & 5 below 1000 in scheme. However, it gives me an incorrect output.
Any help would be much appreciated.
(define (multiples)
(define (calc a sum ctr cir)
(cond (> a 1000) (sum)
(= ctr 7) (calc (+ a (list-ref cir 0)) (+ sum a) 0 (list 3 2 1 3 1 2 3))
(else (calc (+ a (list-ref cir ctr)) (+ sum a) (+ 1 ctr) (list 3 2 1 3 1 2 3)))))
(calc 0 0 0 (list 3 2 1 3 1 2 3)))
You can simply port imperative style solution to functional Scheme by using an accumulator(sum parameter) and a target parameter to test when to stop summing:
(define (multiples)
(define (multiples-iter num sum target)
(if (> num target)
sum
(multiples-iter (+ 1 num)
(if (or (zero? (mod num 3)) (zero? (mod num 5)))
(+ sum num)
sum)
target)))
(multiples-iter 0 0 1000))
Here's my (Racket-specific) solution, which doesn't involve lots of (or, for that matter, any) modulo calls, and is completely general (so that you don't need to construct the (3 2 1 3 1 2 3) list that the OP has):
(define (sum-of-multiples a b limit)
(define (sum-of-multiple x)
(for/fold ((sum 0))
((i (in-range 0 limit x)))
(+ sum i)))
(- (+ (sum-of-multiple a) (sum-of-multiple b))
(sum-of-multiple (lcm a b))))
Test run:
> (sum-of-multiples 3 5 1000)
233168
If you're using Racket, there's a very compact way to do what you ask, using looping constructs:
(for/fold ([sum 0])
([i (in-range 1 1000)]
#:when (or (zero? (modulo i 3)) (zero? (modulo i 5))))
(+ sum i))
=> 233168
One problem is that your code is missing a pair of parentheses around the cond clauses.
In the line (cond (> a 1000) (sum) the condition is just> while a and 1000 are interpreted as forms to be evaluated if > is true (which it is), and thus 1000 will be returned as the result.
Two other problem (masked by the first one) is that you are initializing ctr to 0 when it reaches 7, while it should be set to the next value, i.e. 1, and that you are including 1000 in the result.
The corrected version of your function is
(define (multiples)
(define (calc a sum ctr cir)
(cond ((>= a 1000) sum)
((= ctr 7) (calc (+ a (list-ref cir 0)) (+ sum a) 1 (list 3 2 1 3 1 2 3)))
(else (calc (+ a (list-ref cir ctr)) (+ sum a) (+ 1 ctr) (list 3 2 1 3 1 2 3)))))
(calc 0 0 0 (list 3 2 1 3 1 2 3)))
The same algorithm can also be defined as a non-recursive function like this:
(define (multiples)
(do ((cir (list 3 2 1 3 1 2 3))
(ctr 0 (+ ctr 1))
(a 0 (+ a (list-ref cir (modulo ctr 7))))
(sum 0 (+ sum a)))
((>= a 1000) sum)))
(require-extension (srfi 1))
(define (sum-mod-3-5 upto)
(define (%sum-mod-3-5 so-far generator-position steps)
(let ((next (car generator-position)))
(if (> (+ steps next) upto)
so-far
(%sum-mod-3-5 (+ so-far steps)
(cdr generator-position)
(+ steps next)))))
(%sum-mod-3-5 0 (circular-list 3 2 1 3 1 2 3) 0)) ; 233168
For this particular task, it will do on average half the operations then you would do if incrementing the counter by one, also, one less if condition to check.
Also, modulo (as being division in disguise, probably) is more expensive then summation.
EDIT: I'm not a pro on modular system in different dialects of Scheme. The SRFI-1 extension here is only required to make it easier to create a circular list. I couldn't find an analogue to Common Lisp (#0=(3 2 1 3 1 2 3) . #0#), but perhaps, someone more knowledgeable will correct this.
If you absolutely want to use the "repeating pattern" method, you could go about it something like this.
This uses recursion on the list of intervals rather than relying on list-ref and explicit indexing.
(define (mults limit)
(define steps '(3 2 1 3 1 2 3))
(define (mults-help a sum ls)
(cond ((>= a limit) sum)
((null? ls) (mults-help a sum steps))
(else (mults-help (+ a (car ls))
(+ a sum)
(cdr ls)))))
(mults-help 0 0 steps))