I am having trouble duplicating a symbol. Basically I have a list and I need to surround it with same number of the symbol # as the number of elements in the list you pass.
For example:
(display(frontenddupe '# '((! % % % !)(! % ! % !))))
and I'm suppose to get the following as an output:
((# # # # #)(! % % % !)(! % ! % !)(# # # # #))
This is my code that I have so far:
(define (frontenddupe s lst)
(define (duplicate n s)
(cond`]
[(zero? n) '()]
[else (append (list s (duplicate (- n 1) s)))]))
(append (list (list (duplicate (length lst) '# ))(list s) lst (list (list s)))))
I know this is completely wrong, but I am just at a total lost on how to fix it.
You can write a solution without using explicit recursion, just use some of the built-in procedures - like this:
(define (frontenddupe s lst)
(let* ([len (length (first lst))] ; assuming all lists have same length
[dup (build-list len (λ (n) s))])
(append (cons dup lst) (list dup))))
It works as expected:
(frontenddupe '# '((! % % % !) (! % ! % !)))
=> '((# # # # #) (! % % % !) (! % ! % !) (# # # # #))
Related
Hi I'm struggling with this problem, I don't know how to add the number of square tiles and incorporate that as a user input value, I only know how to increase the size of the tiles. So I can make the squares bigger but I can't increase the number of them. The main issue is alternating the square colors red and black and having user input of the board size. If you can show me with circles or anything else how to take user input to add more I'd appreciate any help, this is due in three days and I've been working on it for a while.
Edit: In my class we haven't learned for-loops in racket so if there's an iterative/recursive way that would help me out.
Here's my code with multiple attempts:
#lang slideshow
(define (square n) (filled-rectangle n n))
(define (redblock n) (colorize(square) "red"))
(define (blackblock n) (colorize(square) "black"))
;slideshow
(define (series n)
[hc-append (* square n)]) ; contract violation, expected: number?, given: #<procedure:square>
;slideshow
(define (rb-series mk)
(vc-append
(series [lambda (sz) (colorize (mk sz) "red")])
(series [lambda (sz) (colorize (mk sz) "black")])))
(define (checker p1 p2) ;makes 2x2
(let ([p12 (hc-append p1 p2)]
[p21 (hc-append p2 p1)])
(vc-append p12 p21)))
(define (four p) ;can we get the parameter of this as any number instead of the shape?
(define two-p (hc-append p p))
(vc-append two-p two-p))
(define (checkerboard n sz)
(let* ([redblock (colorize(square sz)"red")]
[blackblock (colorize(square sz)"black")])
(define (blackred-list n)
;(define (string lst)) ;is there a way to construct an empty string to add to?
(for ([i n])
(if (even? i)
(hc-append blackblock)
(else
(hc-append (redblock)))))) ; this else part throws an error saying no hc-append
(define (redblack-list n)
(for ([i n])
(if (even? i)
(hc-append redblock)
(else (hc-append blackblock))))) ;another else with the same issue
(define (row-list n)
(for ([i n])
(if (even? i)
(vc-append blackred-list)
(else
(vc-append redblack-list)))))
(checkerboard 5 20))) ;this is just to test it, but how would I get user input?```
Let's break it down step by step:
Define function named checkerboard:
(define (checkerboard n sz) ...
With local definitions of redblock and blackblock...
(let ([redblock (colorize (filled-rectangle sz sz) "red")]
[blackblock (colorize (filled-rectangle sz sz) "black")])
With function blackred-list (I used letrec for recursive local definitions)...
(letrec ([blackred-list
(lambda (m) (cond ((zero? m) '())
((even? m) (cons blackblock (blackred-list (sub1 m))))
(else (cons redblock (blackred-list (sub1 m))))))]
With function redblack-list, which is very similar to blackred-list, so I am leaving that as work for you.
With function row-list:
[row-list (lambda (m) (map (lambda (i) (apply hc-append (reverse
(if (even? i)
(blackred-list m)
(redblack-list m)))))
(range m)))]
Then write (apply vc-append (row-list n)) inside letrec.
User input isn't mentioned in task, because you will just call (checkerboard 6 15) (or any other test) in REPL, but you surely can do this:
> (checkerboard (read) (read))
If one can confidently write and assemble small functions then the suggestions in
the exercise may be all one needs to produce a solution. But if this is a skill
that one is learning, then following a systematic design method may
help that learning process.
The design method here is HtDF (How to Design Functions): write down stub with signature and purpose, examples, and template, then edit the template to produce the required function.
(This answer uses characters to stand for blocks -- substitute eg hc-append for list->string for images)
(define redblock #\r)
(define blackblock #\b)
#;
(define (blackred-list m) ;; Natural -> ListOfBlock ; *stub* ;; *signature*
;; produce list of m alternating blocks (last one red) ; *purpose statement*
empty) ; *stub body* (valid result)
(check-expect (blackred-list 0) empty ) ; *minimal example*
#;
(define (fn n) ; *template*
(cond ;
[(zero? n) ... ] ;
[else (.... n (fn (- n 1))) ])) ;
(check-expect (blackred-list 1) (list redblock) ) ; *examples* to guide .... edit
(check-expect (blackred-list 2) (list blackblock redblock) )
(define (blackred-list m) ;; Natural -> ListOfBlock ; (edit template)
;; produce list of m alternating blocks (last one red)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
blackblock
redblock)
(blackred-list (- m 1))) ]))
(check-expect (blackred-list 3) (list redblock blackblock redblock) )
(define (redblack-list m) ;; Natural -> ListOfBlock
;; produce list of m alternating blocks (last one black)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
redblock
blackblock)
(redblack-list (- m 1))) ]))
(check-expect (redblack-list 3) (list blackblock redblock blackblock) )
#;
(define (row-list m) ;; Natural -> ListOfString ; *stub*
;; produce list of m alternating strings of blocks (last one ends in red)
empty)
(check-expect (row-list 0) empty) ; *examples* (same template)
(check-expect (row-list 1) (list "r") )
(check-expect (row-list 2) (list "rb" "br") )
(define (n-strings-of-length m n) ;; Natural Natural -> ListOfString
;; produce list of n alternating length m strings of blocks (last one ends in red)
(cond
[(zero? n) empty ]
[else (cons
(if (even? n)
(list->string (redblack-list m))
(list->string (blackred-list m)))
(n-strings-of-length m (- n 1))) ]))
(define (row-list m) ;; Natural -> ListOfString
;; produce list of m alternating length m strings of blocks (last one ends in red)
(n-strings-of-length m m))
(define (display-rows los) ;; ListOfString -> ; (from natural list recursion template)
;; display los, one element per line
(cond
[(empty? los) (void) ]
[else (begin
(display (car los))
(newline)
(display-rows (cdr los))) ]))
(define (checkerboard m) ;; Natural ->
;; display checkerboard with side m
(display-rows (row-list m)))
Welcome to DrRacket, version 8.4 [cs].
Language: Advanced Student.
All 8 tests passed!
>
The functions can now be reordered to produce the solution in specified local form:
(define redblock #\r)
(define blackblock #\b)
(define (checkerboard m) ;; Natural ->
;; display checkerboard with side m
(local [
(define (blackred-list m) ;; Natural -> ListOfBlock
;; produce list of m alternating blocks (last one red)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
blackblock
redblock)
(blackred-list (- m 1))) ]))
(define (redblack-list m) ;; Natural -> ListOfBlock
;; produce list of m alternating blocks (last one black)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
redblock
blackblock)
(redblack-list (- m 1))) ]))
(define (n-strings-of-length m n) ;; Natural Natural -> ListOfString
;; produce list of n alternating length m strings of blocks (last one ends in red)
(cond
[(zero? n) empty ]
[else (cons
(if (even? n)
(list->string (redblack-list m))
(list->string (blackred-list m)))
(n-strings-of-length m (- n 1))) ]))
(define (row-list m) ;; Natural -> ListOfString
;; produce list of m alternating length m strings of blocks (last one ends in red)
(n-strings-of-length m m))
(define (display-rows los) ;; ListOfString ->
;; display los, one element per line
(cond
[(empty? los) (void) ]
[else (begin
(display (car los))
(newline)
(display-rows (cdr los))) ])) ])
(display-rows (row-list m)))
Welcome to DrRacket, version 8.4 [cs].
Language: Advanced Student.
> (checkerboard 5)
rbrbr
brbrb
rbrbr
brbrb
rbrbr
>
The "finding the digits problem" is this:
Find unique decimal digits A, B, C such that
CCC
+ BBB
+ AAA
= CAAB
To solve it using recursion in Common Lisp, I've written this code:
(defun find! ()
(found? 0 ;; initially point to the number 1
'(1 2 3) ;; initial list
'() ;; initially no numbers found
3 ;; numbers list width is 3
) )
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ;; recursion happens here
lst
(setf occupied (remove j occupied)))))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar
(lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst) (first lst)
(first lst) (second lst))))))
(if (= lefthnd rghthnd)
lst
'nil))))))
The delivered result (lst) is (9 9 9)
The expected result (lst) is (9 8 1) meaning A=9, B=8, C=1 so that the equation CCC + BBB + AAA = CAAB holds i.e.
111 ; CCC
+ 888 ; BBB
+ 999 ; AAA
= 1998 ; CAAB
Which parts of the code should I change so that it gives the expected result? Can someone fix the code? Note that using recursion is a must. Only one line of recursion is enough i.e. like the line where the ;; recursion happens here comment is.
What is the minimal edit to fix this code?
The minimal edit needed to make your code work is the following three small changes (marked with ;;;; NB in the comments):
You are not allowed to surgically modify the structure of a quoted list, as you do. It must be freshly allocated, for that.
(defun find! ()
(found? 0 ;; initially point to the number 1
(list 1 2 3) ;; initial list ;;;; NB freshly allocated!
'() ;; initially no numbers found
3 ;; numbers list width is 3
) )
You must change the structure of the code (moving one closing paren one line up) to always undo the push of j into occupied:
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ;; recursion happens here
lst) ;;;; NB
(setf occupied (remove j occupied)))) ;;;; NB _always_ undo the push
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar
(lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst) (first lst)
(first lst) (second lst))))))
(if (= lefthnd rghthnd)
(return-from found? lst) ;;;; NB actually return here
'nil))))))
You also must actually return the result, once it is found (seen in the above snippet as well).
If you change the return-from line to print the result instead of returning it, you will get all of them printed.
If you want to get them all in a list instead of being printed, you can surgically append each of the results to some list defined in some outer scope (or cons onto the front and reverse it when it's all done, if you prefer).
Or in general, you can change this code to accept a callback and call it with each result, when it is found, and let this callback to do whatever it does with it -- print it, append it to an external list, whatever.
Remarks: your code follows a general recursive-backtracking approach, creating three nested loops structure through recursion. The actual result is calculated -- and put into lst by surgical manipulation -- at the deepest level of recursion, corresponding to the innermost loop of j from 1 to 9 (while avoiding the duplicates).
There's lots of inconsequential code here. For instance, the if in (if (found? ...) lst) isn't needed at all and can be just replaced with (found? ...). I would also prefer different names -- occupied should really be named used, lst should be res (for "result"), index is canonically named just i, width is just n, etc. etc. (naming is important)... But you did request the smallest change.
This code calculates the result lst gradually, as a side effect on the way in to the innermost level of the nested loops, where it is finally fully set up.
Thus this code follows e.g. an example of Peter Norvig's PAIP Prolog interpreter, which follows the same paradigm. In pseudocode:
let used = []
for a from 1 to 9:
if a not in used:
used += [a]
for b from 1 to 9:
if b not in used:
used += [b]
for c from 1 to 9:
if c not in used and valid(a,b,c):
return [a,b,c] # or:
# print [a,b,c] # or:
# call(callback,[a,b,c]) # etc.
remove b from used
remove a from used
Here's your code re-structured, renamed, and streamlined:
(defun find2 ( &aux (res (list 0 0 0))
(used '()) (n (length res)))
(labels
((f (i)
(do ((d 1 (1+ d))) ; for d from 1 to 9...
((> d 9) 'FAIL) ; FAIL: no solution!
(unless (member d used) ; "d" for "digit"
(setf (nth i res) d) ; res = [A... B... C...]
(cond
((< i (- n 1)) ; outer levels
(setf used (cons d used))
(f (1+ i)) ; recursion! going in...
(setf used (cdr used))) ; and we're out.
(T ; the innermost level!
(let ((left (* 111 (reduce #'+ res)))
(rght (reduce #'+
(mapcar #'* '(1000 100 10 1)
(list (third res) ; C A A B
(first res)
(first res)
(second res))))))
(if (= left rght)
(return-from find2 res))))))))) ; success!
(f 0)))
This is now closely resembling the C++ code you once had in your question, where the working function (here, f) also received just one argument, indicating the depth level of the nested loop -- corresponding to the index of the digit being tried, -- and the rest of the variables were in an outer scope (there, global; here, the auxiliary variables in the containing function find2).
By the way, you aren't trying any 0s for some reason.
You seem to be able to solve the problem using another language, so I won't spend too long talking about the problem/algorithm used (you already know how to do it). However, as it seems that you are learning Common Lisp, I am going to provide a typical StackOverflow answer, and give a lot of advice that you haven't asked for !
Fix your parentheses/indentation, this will make the code clearer for you.
Split your code in more, smaller functions. You are solving a problem using a recursive function, with several parameters, and the function is more than twenty lines long. This makes it really hard to read and to debug.
Use built-in functions: (some (lambda (x) (= x j)) occupied) == (member j occupied :test #'=), and in that case, it still works without specifying the test (this is technically wrong, the two functions do not return the same thing, but you only ever use the result as a boolean so this is effectively the same thing here).
(mapcar (lambda (x y) (* x y)) ...) is just a longer way to write (mapcar #'* ...)
'nil == nil, you don't need to quote it. It is also (arguably) good style to use () instead of nil to represent the empty list (as opposed to a boolean value), but this really is a minor point.
As far as the algorithm is concerned, I will gladly help if you rewrite it using smaller functions. At the moment, it really is unnecessarily hard to read and understand.
EDIT:
I still tried to take the time to rewrite the code and come up with a cleaner solution.
TL;DR: this is the final result, with "minimal" modifications to your code:
(defun find! ()
(found? 0 (list 1 2 3) () 3))
(defun compute-lefthand (list)
(* 111 (reduce #'+ list)))
(defun compute-righthand (list)
(reduce #'+ (mapcar #'*
'(1000 100 10 1)
(list (third list)
(first list)
(first list)
(second list)))))
(defun check-solution (list)
(when (= (compute-lefthand list)
(compute-righthand list))
list))
(defun try-solution (j index list occupied width)
(unless (member j occupied)
(setf (nth index list) j)
(found? (1+ index)
list
(cons j occupied)
width)))
(defun found? (index lst occupied width)
(if (= index width)
(check-solution lst)
(dotimes (j 10)
(when (try-solution j index lst occupied width)
(return lst)))))
Your initial code, on top of style issues already mentioned in my initial answer, had shaky control flow. It was somewhat hard to determine what was really returned by each recursive call, because you do not have smaller functions and so it was not clear what the goal of each part was, how the information was transmitted from the recursive call to the parent, which objects where modified and so on.
Now, my code is not the cleanest, and I would probably not use this strategy to solve the problem, but I tried to stay as close as possible to your initial code. Main differences:
I split things into smaller functions. This makes everything clearer, and above all, easier to test. Each function returns something clear. For example, check-solution returns the list if it represents a proper solution, and nil otherwise; this is made clear by the fact that I use a when instead of an if control structure.
I replace do by dotimes which is also clearer; the variable that is changing, and how it is changing at each step, is now immediately visible.
I do not use the &optional return argument to the do/dotimes macro, and instead use an explicit return. It is then clear to determine what is being returned, and when.
I do not use push/pop to modify my lists. You are using a recursive strategy, and so your "modifications" should take the form of different arguments passed to functions. Once again, it makes reasoning about the program easier, by knowing exactly what each function does to each argument. An even better solution would also be to remove the call to setf and instead use (cons <smtg> lst) as the argument of the recursive call, but it's fine.
The error in your initial program is probably coming from the fact that your function does not return what you think, because you have several consecutive expressions, each invoked under different circumstances, whose return value is itself wrong because they are not in the right order and modify objects and return them at the wrong time using do's optional return value.
TL;DR: split things up; make each function do a single thing.
Your code
(defun find! ()
(found? 0 ;; initially show the number 1
'(1 2 3) ;; initial list
'() ;; initially no numbers found
3 ;; numbers list width is 3
) )
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ;; recursion
lst
(setf occupied (remove j occupied)))))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+ (mapcar (lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst) (first lst) (first lst) (second lst))
))))
(if (= lefthnd rghthnd)
lst
'nil))))))
Indentation and comment style: end-of-line comments use a single semicolon,
align non-body arguments, indent bodies by two spaces
(defun find! ()
(found? 0 ; initially show the number 1
'(1 2 3) ; initial list
'() ; initially no numbers found
3)) ; numbers list width is 3
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
lst
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar (lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(if (= lefthnd rghthnd)
lst
'nil))))))
Use more telling predicates: find or member. Don't wrap * in a lambda doing
nothing else. (I'll leave aside find! hereafter.)
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
lst
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(if (= lefthnd rghthnd)
lst
'nil))))))
The body of a do doesn't return anything. There is a lot of dead code,
which we remove now:
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(unless (found? (1+ index) lst occupied width) ; recursion
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)))))
Instead of pushing and then conditionally removing, we can conditionally push:
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(when (found? (1+ index) lst occupied width) ; recursion
(push j occupied))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)))))
While it makes a difference in performance, putting the outer conditional
into the inner body makes it more readable here:
(defun found? (index lst occupied width)
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(when (and (< index (1- width))
(found? (1+ index) lst occupied width)) ; recursion
(push j occupied)))))
This does nothing except count to 9 a few times, which seems to be congruent
to your findings.
I guess that you wanted to return something from the dead code. You might
want to use return-from for that.
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
(return-from found? lst)
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst)))))))
This returns (1 2 9), which is wrong. The problem seems to be that you
return the list even when you run over 9, but you want to return nil then,
because you didn't find anything.
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) nil) ; <- nothing found
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
(return-from found? lst)
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) nil) ; <- nothing found
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst)))))))
This returns (9 8 1), which is correct. Now that I seem to understand what
you're trying to do, let's refactor a bit more. Instead of pushing and
removing from the occupied list, just create a new list with the new element
in front transiently:
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) nil)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(when (found? (1+ index) ; recursion
lst
(cons j occupied)
width)
(return-from found? lst))))
(do ((j 1 (1+ j)))
((> j 9) nil)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst)))))))
I think that using loop instead of do makes this much more readable:
(defun found? (index lst occupied width)
(if (< index (1- width))
(loop :for j :from 1 :to 9
:unless (find j occupied :test #'=)
:do (setf (nth index lst) j)
(when (found? (1+ index) ; recursion
lst
(cons j occupied)
width)
(return-from found? lst)))
(loop :for j :from 1 :to 9
:unless (find j occupied :test #'=)
:do (setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst))))))
Since the loop is rather elaborate, I'd want to write and read it only once,
so move the outer condition inside:
(defun found? (index lst occupied width)
(loop :for j :from 1 :to 9
:unless (find j occupied :test #'=)
:do (setf (nth index lst) j)
(if (< index (1- width))
(when (found? (1+ index) ; recursion
lst
(cons j occupied)
width)
(return-from found? lst))
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst))))))
Did you see that occupied is just the first one or two elements of lst,
reversed? Instead of setting list elements, we can build up lst through the
recursion. We actually need to return the recursive results for that, so
this is better referential transparency.
(defun find! ()
(found? 0 ; initially show the number 1
'() ; initially no numbers found
3)) ; numbers list width is 3
(defun found? (index part width)
(loop :for j :from 1 :to 9
:unless (find j part :test #'=)
:do (if (< index (1- width))
(let ((solution (found? (1+ index) ; recursion
(cons j part)
width)))
(when solution
(return-from found? solution)))
(let* ((full (cons j part))
(lefthnd (* 111 (reduce #'+ full)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third full)
(first full)
(first full)
(second full))))))
(when (= lefthnd rghthnd)
(return-from found? full))))))
Index and width are now only used for counting, so we only need one number,
which we can count towards zero. This also makes apparent that we should
probably move the base case out of the looping:
(defun find! ()
(found? '() ; initially no numbers found
3)) ; numbers list width is 3
(defun found? (part count)
(if (zerop count)
(let* ((full part) ; just rename to show that the number is complete
(lefthnd (* 111 (reduce #'+ full)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third full)
(first full)
(first full)
(second full))))))
(when (= lefthnd rghthnd)
(return-from found? full)))
(loop :for j :from 1 :to 9
:unless (find j part :test #'=)
:do (let ((solution (found? (cons j part)
(1- count))))
(when solution
(return-from found? solution))))))
I think this more or less is what you can do if you keep it to a single
function. Now you'd probably want to separate the generation of
permutations from the actual code. There are for example some functions to
deal with such things in the widely used library alexandria.
I am trying to create Pascal's Triangle using recursion. My code is:
(define (pascal n)
(cond
( (= n 1)
list '(1))
(else (append (list (pascal (- n 1))) (list(add '1 (coresublist (last (pascal (- n 1))))))
)))) ;appends the list from pascal n-1 to the new generated list
(define (add s lst) ;adds 1 to the beginning and end of the list
(append (list s) lst (list s))
)
(define (coresublist lst) ;adds the subsequent numbers, takes in n-1 list
(cond ((= (length lst) 1) empty)
(else
(cons (+ (first lst) (second lst)) (coresublist (cdr lst)))
)))
When I try to run it with:
(display(pascal 3))
I am getting an error that says:
length: contract violation
expected: list?
given: 1
I am looking for someone to help me fix this code (not write me entirely new code that does Pascal's Triangle). Thanks in advance! The output for pascal 3 should be:
(1) (1 1) (1 2 1)
We should start with the recursive definition for a value inside Pascals' triangle, which is usually expressed in terms of two parameters (row and column):
(define (pascal x y)
(if (or (zero? y) (= x y))
1
(+ (pascal (sub1 x) y)
(pascal (sub1 x) (sub1 y)))))
There are more efficient ways to implement it (see Wikipedia), but it will work fine for small values. After that, we just have to build the sublists. In Racket, this is straightforward using iterations, but feel free to implement it with explicit recursion if you wish:
(define (pascal-triangle n)
(for/list ([x (in-range 0 n)])
(for/list ([y (in-range 0 (add1 x))])
(pascal x y))))
It'll work as expected:
(pascal-triangle 3)
=> '((1) (1 1) (1 2 1))
Here is what I have done so far:
(define sumOdd
(lambda(n)
(cond((> n 0)1)
((odd? n) (* (sumOdd n (-(* 2 n) 1)
output would look something like this:
(sumOdd 1) ==> 1
(sumOdd 4) ==> 1 + 3 + 5 + 7 ==> 16
(sumOdd 5) ==> 1 + 3 + 5 + 7 + 9 ==> 25
This is what I am trying to get it to do: find the sum of the first N odd positive integers
I can not think of a way to only add the odd numbers.
To elaborate further on the sum-odds problem, you might solve it in terms of more abstract procedures that in combination accumulates the desired answer. This isn't necessarily the easiest solution, but it is interesting and captures some more general patterns that are common when processing list structures:
; the list of integers from n to m
(define (make-numbers n m)
(if (= n m) (list n) ; the sequence m..m is (m)
(cons n ; accumulate n to
(make-numbers (+ n 1) m)))) ; the sequence n+1..m
; the list of items satisfying predicate
(define (filter pred lst)
(if (null? lst) '() ; nothing filtered is nothing
(if (pred (car lst)) ; (car lst) is satisfactory
(cons (car lst) ; accumulate item (car lst)
(filter pred (cdr lst))) ; to the filtering of rest
(filter pred (cdr lst))))) ; skip item (car lst)
; the result of combining list items with procedure
(define (build-value proc base lst)
(if (null? lst) base ; building nothing is the base
(proc (car lst) ; apply procedure to (car lst)
(build-value proc base (cdr lst))))) ; and to the building of rest
; the sum of n first odds
(define (sum-odds n)
(if (negative? n) #f ; negatives aren't defined
(build-value + ; build values with +
0 ; build with 0 in base case
(filter odd? ; filter out even numbers
(make-numbers 1 n))))) ; make numbers 1..n
Hope this answer was interesting and not too confusing.
Let's think about a couple of cases:
1) What should (sumOdd 5) return? Well, it should return 5 + 3 + 1 = 9.
2) What should (sumOdd 6) return? Well, that also returns 5 + 3 + 1 = 9.
Now, we can write this algorithm a lot of ways, but here's one way I've decided to think about it:
We're going to write a recursive function, starting at n, and counting down. If n is odd, we want to add n to our running total, and then count down by 2. Why am I counting down by 2? Because if n is odd, n - 2 is also odd. Otherwise, if n is even, I do not want to add anything. I want to make sure that I keep recursing, however, so that I get to an odd number. How do I get to the next odd number, counting down from an even number? I subtract 1. And I do this, counting down until n is <= 0. I do not want to add anything to my running total then, so I return 0. Here is what that algorithm looks like:
(define sumOdd
(lambda (n)
(cond ((<= n 0) 0)
((odd? n) (+ n (sumOdd (- n 2))))
(else (sumOdd (- n 1))))))
If it helps you, here is a more explicit example of a slightly different algorithm:
(define sumOdd
(lambda (n)
(cond ((<= n 0) 0)
((odd? n) (+ n (sumOdd (- n 1))))
((even? n) (+ 0 (sumOdd (- n 1))))))) ; note that (even? n) can be replaced by `else' (if its not odd, it is even), and that (+ 0 ..) can also be left out
EDIT:
I see that the problem has changed just a bit. To sum the first N positive odd integers, there are a couple of options.
First option: Math!
(define sumOdd (lambda (n) (* n n)))
Second option: Recursion. There are lots of ways to accomplish this. You could generate a list of 2*n and use the procedures above, for example.
You need to have 2 variables, one which keep counter of how many odd numbers are still to be added and another to hold the current odd number which gets increment by 2 after being used in addition:
(define (sum-odd n)
(define (proc current start)
(if (= current 0)
0
(+ start (proc (- current 1) (+ start 2)) )))
(proc n 1))
Here is a nice tail recursive implementation:
(define (sumOdd n)
(let summing ((total 0) (count 0) (next 1))
(cond ((= count n) total)
((odd? next) (summing (+ total next)
(+ count 1)
(+ next 1)))
(else (summing total count (+ next 1))))))
Even shorter tail-recursive version:
(define (sumOdd n)
(let loop ((sum 0) (n n) (val 1))
(if (= n 0)
sum
(loop (+ sum val) (- n 1) (+ val 2)))))
Given a recursive function in scheme how do I change that function to tail recursive, and then how would I implement it using streams? Are there patterns and rules that you follow when changing any function in this way?
Take this function as an example which creates a list of numbers from 2-m (this is not tail recursive?)
Code:
(define listupto
(lambda (m)
(if (= m 2)
'(2)
(append (listupto (- m 1)) (list m)))))
I'll start off by explaining your example. It is definitely not tail recursive. Think of how this function executes. Each time you append you must first go back and make the recursive call until you hit the base case, and then you pull your way back up.
This is what a trace of you function would look like:
(listupto 4)
| (append (listupto(3)) '4)
|| (append (append (listupto(2)) '(3)) '(4))
||| (append (append '(2) '(3)) '(4))
|| (append '(2 3) '(4))
| '(2 3 4)
'(2 3 4)
Notice the V-pattern you see pulling in and then out of the recursive calls. The goal of tail recursion is to build all of the calls together, and only make one execution. What you need to do is pass an accumulator along with your function, this way you can only make one append when your function reaches the base case.
Here is the tail recursive version of your function:
(define listupto-tail
(lambda (m)
(listupto m '())))
# Now with the new accumulator parameter!
(define listupto
(lambda (m accu)
(if (= m 2)
(append '(2) accu)
(listupto (- m 1) (append (list m) accu)))))
If we see this trace, it will look like this:
(listupto 4)
| (listupto (3) '(4)) # m appended with the accu, which is the empty list currently
|| (listupto (2) '(3 4)) # m appended with accu, which is now a list with 4
||| (append '(2) '(3 4))
'(2 3 4)
Notice how the pattern is different, and we don't have to traverse back through the recursive calls. This saves us pointless executions. Tail recursion can be a difficult concept to grasp I suggest taking a look here. Chapter 5 has some helpful sections in it.
Generally to switch to a tail recursive form you transform the code so that it takes an accumulator parameter which builds the result up and is used as the final return value. This is generally a helper function which your main function delegates too.
Something of the form:
(define listupto
(lambda (m)
(listupto-helper m '())))
(define listupto-helper
(lambda (m l)
(if (= m 2)
(append '(2) l)
(listupto-helper (- m 1) (append (list m) l)))))
As the comments point out, the helper function can be replaced with a named let which is apparently (haven't done much/enough Scheme!) more idiomatic (and as the comments suggest cons is much better than creating a list and appending.
(define listupto
(lambda (n)
(let loop ((m n) (l '()))
(if (= m 2)
(append '(2) l)
(loop (- m 1) (cons m l))))))
You also ask about streams. You can find a SICP styled streams used e.g. here or here which have a from-By stream builder defined:
;;;; Stream Implementation
(define (head s) (car s))
(define (tail s) ((cdr s)))
(define-syntax s-cons
(syntax-rules ()
((s-cons h t) (cons h (lambda () t)))))
;;;; Stream Utility Functions
(define (from-By x s)
(s-cons x (from-By (+ x s) s)))
Such streams creation relies on macros, and they must be accessed by special means:
(define (take n s)
(cond ; avoid needless tail forcing for n == 1 !
((= n 1) (list (head s))) ; head is already forced
((> n 1) (cons (head s) (take (- n 1) (tail s))))
(else '())))
(define (drop n s)
(cond
((> n 0) (drop (- n 1) (tail s)))
(else s)))
But they aren't persistent, i.e. take and drop recalculate them on each access. One way to make streams persistent is to have a tailing closure surgically altering the last cons cell on access:
(1 . <closure>)
(1 . (2 . <closure>))
....
like this:
(define (make-stream next this state)
(let ((tcell (list (this state)))) ; tail sentinel cons cell
(letrec ((g (lambda ()
(set! state (next state))
(set-cdr! tcell (cons (this state) g))
(set! tcell (cdr tcell))
tcell)))
(set-cdr! tcell g)
tcell)))
(define (head s) (car s))
(define (tail s)
(if (or (pair? (cdr s))
(null? (cdr s)))
(cdr s)
((cdr s))))
We can now use it like this
(define a (make-stream (lambda (i) (+ i 1)) (lambda (i) i) 1))
;Value: a
a
;Value 13: (1 . #[compound-procedure 14])
(take 3 a)
;Value 15: (1 2 3)
a
;Value 13: (1 2 3 . #[compound-procedure 14])
(define b (drop 4 a))
;Value: b
b
;Value 16: (5 . #[compound-procedure 14])
a
;Value 13: (1 2 3 4 5 . #[compound-procedure 14])
(take 4 a)
;Value 17: (1 2 3 4)
a
;Value 13: (1 2 3 4 5 . #[compound-procedure 14])
Now, what does (make-stream (lambda (i) (list (cadr i) (+ (car i) (cadr i)))) car (list 0 1)) define?
update: in Daniel Friedman's 1994 slides "The Joys of Scheme, Cont'd" we find simpler implementation of these "memoized streams" (as they are called there), making the tail function itself store the forced stream in the tail sentinel, as
(define (tail s)
(if (or (pair? (cdr s))
(null? (cdr s)))
(cdr s)
(let ((n ((cdr s))))
(set-cdr! s n)
(cdr s))))
;; can be used as e.g. (https://ideone.com/v6pzDt)
(define fibs
(let next-fib ((a 0) (b 1))
(s-cons a (next-fib b (+ a b)))))
Here's a tail recursive form -
(define (listupto n)
(let run
((m 0)
(return identity))
(if (> m n)
(return null)
(run (add1 m)
(lambda (r) (return (cons m r)))))))
(listupto 9)
; '(0 1 2 3 4 5 6 7 8 9)
And here it is as a stream -
(define (listupto n)
(let run
((m 0))
(if (> m n)
empty-stream
(stream-cons m
(run (add1 m))))))
(stream->list (listupto 9))
; '(0 1 2 3 4 5 6 7 8 9)