Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 8 years ago.
Improve this question
I have to solve an exercise in functional programming. I solved by iterative schemes, I want to use recursion but not knowing conversion? Can anyone help me k?
Title: N and N of the people, the things i would have done the job performance j A [i] [j]. Find the plan work assignments so that the greatest performance?
Here is code use loop circle
(define (Bai15 N)
(define i 0)
(define j 0)
(define k 0)
(define t 0)
(define ii 0)
(define jj 0)
(define dem 0)
(define MaTrix (make-vector N))
(define Result (make-vector N))
(define Test (make-vector N))
(define Max 0)
(display "a.Nhap ma trận X[1..N][1..N]:")
(newline)
(newline)
(while (< i N)
(set! (vector-ref MaTrix i) (make-vector N))
(set! i (+ i 1))
)
(set! i 0)
(while (< i N)
(set! k (vector-ref MaTrix i))
(while (< j N)
(display "X[")
(display i)
(display "][")
(display j)
(display "]= ")
(set! (vector-ref k j) (read))
(set! j (+ j 1))
)
(newline)
(set! j 0)
(set! i (+ i 1))
)
(newline)
(set! i 0)
(set! j 0)
(while (< i N)
(set! k (vector-ref MaTrix i))
(while (< j N)
(display (vector-ref k j))
(display " ")
(set! j (+ j 1))
)
(newline)
(set! j 0)
(set! i (+ i 1))
)
(set! i 0)
(while (< i N)
(set! (vector-ref Result i) -1)
(set! i (+ i 1))
)
(set! i 0)
(while (< i N)
(set! (vector-ref Test i) -1)
(set! i (+ i 1))
)
(set! i 0)
(while (< i N)
(display (vector-ref Test i))
(set! i (+ i 1))
)
(newline)
(set! k 0)
(set! i 0)
(set! j 0)
(set! t 0)
(set! dem 0)
(while (< t N)
(if (and (not (= t 0)) (= i 0))
(set! jj t)
(set! jj 0))
(while (>= (vector-ref Test jj) 0)
(set! jj (+ jj 1))
)
(display "jj: ")
(display jj)
(newline)
(display "i: ")
(display i)
(newline)
(set! k (+ (vector-ref (vector-ref MaTrix i) jj) k))
(display "k: ")
(display k)
(newline)
(set! (vector-ref Test jj) i)
(set! ii 0)
(display "Test: ")
(while (< ii N)
(display (vector-ref Test ii))
(display " ")
(set! ii (+ ii 1))
)
(newline)
(set! dem (+ dem 1))
(if (= dem N)
(begin
(if (> k Max)
(begin
(set! Max k)
(display "Max: ")
(display Max)
(newline)
(set! ii 0)
(display "Result: ")
(while (< ii N)
(set! (vector-ref Result ii) (vector-ref Test ii))
(display (vector-ref Result ii))
(display " ")
(set! ii (+ ii 1))
)
(newline)
(set! i 0)
(while (< i N)
(set! (vector-ref Test i) -1)
(set! i (+ i 1))
)
(set! i 0)
(set! dem 0)
(set! k 0)
(set! t (+ t 1))))
(begin
(set! i 0)
(while (< i N)
(set! (vector-ref Test i) -1)
(set! i (+ i 1))
)
(set! i 0)
(set! dem 0)
(set! k 0)
(set! t (+ t 1))))
(begin
(set! i (+ i 1))
))
)
(newline)
(display "Divide the work plan: ")
(newline)
(set! i 0)
(while (< i N)
(display "Job ")
(display (+ i 1))
(display " - People ")
(display (+ (vector-ref Result i) 1))
(display " work")
(newline)
(set! i (+ i 1))
)
(display "Effective: ")
(display Max)
)
I want to solve with recursion and logic programming
Learning a completely new language (I.e. Haskell (SASL dialect) or Scheme (Lisp dialect) if you know Java (Algol dialect)) is harder than learning a new dialect of the same language family (I.e. learning Ruby when you know Java or Common Lisp if you know Scheme)
It seems you have proven it's true that you can write Fortran in any language.
while doesn't exist in Scheme, but since I also program Algol dialects I know how it's supposed to work. I guess it's definition is something like:
(define-syntax while
(syntax-rules ()
((_ expr body ...)
(let loop ()
(cond (expr body ... (loop))
(else 'undefined-return))))))
Also your code has lots of (set! (vector-ref ...) new-value) which doesn't work. After fixing this the code still didn't work.
It's not trivial to just transform a project to be functional. It's far easier to start with a problem and begin dividing it in parts using divide and conquer. Not all your code can be functional because that implies you cannot have output nor input. Instead you try keeping display and read in it's own procedures.
Using arrays are a means of optimization. By design they are not functional in Scheme. A functional array would produce a new array and leaving the old as it was when changing elements. I know Racket has arrays like that but not Scheme. It's better if you recuse lists instead.
The pattern you have in your code you initialize a counter with define and increment it's global value in while while checking for a certain limit. For this you can use named let eg. in this code that makes list of list.
(define N 10)
(define init-list (let zero-loop ((n N) (acc '()))
(if (zero? n)
acc ; return the accumulated list
(zero-loop (- n 1) (cons 0 acc))))) ; ==> undefine, init-list is (0 0 ...)
(let lol ((n N)) (acc '())
(if (zero? n)
acc
(lol (- n 1) (cons init-list acc)))) ; ==> ((0 0 0...) ...)
I'm unsure what you program is supposed to do so I'll stop here. You have to start writing Scheme in Scheme. If you are having problems with this you should begin with a tutorial. Perhaps follow the SICP video lectures or if you really want to be good, finish the SICP books exercises. In the video lectures you learn how to make a programming language like Prolog.
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
>
I was asked to write a procedure that computes elements of Pascal's triangle by means of a recursive process. I may create a procedure that returns a single row in the triangle or a number within a particular row.
Here is my solution:
(define (f n)
(cond ((= n 1) '(1))
(else
(define (func i n l)
(if (> i n)
l
(func (+ i 1) n (cons (+ (convert (find (- i 1) (f (- n 1))))
(convert (find i (f (- n 1)))))
l))))
(func 1 n '()))))
(define (find n l)
(define (find i n a)
(if (or (null? a) (<= n 0))
'()
(if (>= i n)
(car a)
(find (+ i 1) n (cdr a)))))
(find 1 n l))
(define (convert l)
(if (null? l)
0
(+ l 0)))
This seems to work fine but it gets really inefficient to find elements of a larger row starting with (f 8). Is there a better procedure that solves this problem by means of a recursive process?
Also, how would I write it, if I want to use an iterative process (tail-recursion)?
There are several ways to optimize the algorithm, one of the best would be to use dynamic programming to efficiently calculate each value. Here is my own solution to a similar problem, which includes references to better understand this approach - it's a tail-recursive, iterative process. The key point is that it uses mutation operations for updating a vector of precomputed values, and it's a simple matter to adapt the implementation to print a list for a given row:
(define (f n)
(let ([table (make-vector n 1)])
(let outer ([i 1])
(when (< i n)
(let inner ([j 1] [previous 1])
(when (< j i)
(let ([current (vector-ref table j)])
(vector-set! table j (+ current previous))
(inner (add1 j) current))))
(outer (add1 i))))
(vector->list table)))
Alternatively, and borrowing from #Sylwester's solution we can write a purely functional tail-recursive iterative version that uses lists for storing the precomputed values; in my tests this is slower than the previous version:
(define (f n)
(define (aux tr tc prev acc)
(cond ((> tr n) '())
((and (= tc 1) (= tr n))
prev)
((= tc tr)
(aux (add1 tr) 1 (cons 1 acc) '(1)))
(else
(aux tr
(add1 tc)
(cdr prev)
(cons (+ (car prev) (cadr prev)) acc)))))
(if (= n 1)
'(1)
(aux 2 1 '(1 1) '(1))))
Either way it works as expected for larger inputs, it'll be fast for n values in the order of a couple of thousands:
(f 10)
=> '(1 9 36 84 126 126 84 36 9 1)
There are a number of soluitons presented already, and they do point out that usign dynamic programming is a good option here. I think that this can be written a bit more simply though. Here's what I'd do as a straightforward list-based solution. It's based on the observation that if row n is (a b c d e), then row n+1 is (a (+ a b) (+ b c) (+ c d) (+ d e) e). An easy easy to compute that is to iterate over the tails of (0 a b c d e) collecting ((+ 0 a) (+ a b) ... (+ d e) e).
(define (pascal n)
(let pascal ((n n) (row '(1)))
(if (= n 0) row
(pascal (- n 1)
(maplist (lambda (tail)
(if (null? (cdr tail)) 1
(+ (car tail)
(cadr tail))))
(cons 0 row))))))
(pascal 0) ;=> (1)
(pascal 1) ;=> (1 1)
(pascal 2) ;=> (1 2 1)
(pascal 3) ;=> (1 3 3 1)
(pascal 4) ;=> (1 4 6 4 1)
This made use of an auxiliary function maplist:
(define (maplist function list)
(if (null? list) list
(cons (function list)
(maplist function (cdr list)))))
(maplist reverse '(1 2 3))
;=> ((3 2 1) (3 2) (3))
How would I write a vector-to-list function without using the built in (vector->list) function. Specifically I am looking to learn how to access values within vectors as I have not previously worked with them.
Is there a more straightforward implementation than this:
(define (vector-to-list vec)
(define (helper k lst)
(if (= k (vector-length vec))
lst
(helper (+ k 1) (cons (vector-ref vec k) lst))))
(reverse (helper 0 '())))
(vector-to-list #(1 2 3 4))
?
No, that is a sound implementation. One could write it a bit more idiomatically using 'named-let' as:
(define (vector-to-list vec)
(let ((len (vector-length vec)))
(let looping ((k 0) (lst '())
(if (= k len)
(reverse lst)
(looping (+ k 1)
(cons (vector-ref vec k) lst)))))
You could avoid the use of reverse by constructing the list from back to front:
(define (vector-to-list vec)
(let looping ((k (- (vector-length vec) 1)) (lst '())
(if (< k 0)
lst
(looping (- k 1)
(cons (vector-ref vec k) lst)))))
I am writing a function to count the number of ways to make change in scheme given a list of denominations and an amount. My code is as follows, but it does not work as intended. Should I be using cons instead of the + operator? Should the third line down's base case be the empty list?
(define (change k l)
(cond ((= k 0) 1)
((or (< k 0) (null? l)) 0)
(else (+ (change k (cdr l))
(change (- k (car l))
(cdr l))))))
Test:
(change 11 (list 1 5 10 25))
If the returned value is just a number then forget about cons and '() for building the output, and only use car, cdr, null? for processing the input. Other than that, be aware that there's a small mistake in the last line of your code, here's the fixed version:
(define (change k l)
(cond ((= k 0) 1)
((or (< k 0) (null? l)) 0)
(else
(+ (change k (cdr l))
(change (- k (car l)) l))))) ; don't do (cdr l) here
Now it works as expected:
(change 11 (list 1 5 10 25))
=> 4
I am learning Lisp. I have implemented a Common Lisp function that merges two strings that are ordered alphabetically, using recursion. Here is my code, but there is something wrong with it and I didn't figure it out.
(defun merge (F L)
(if (null F)
(if (null L)
F ; return f
( L )) ; else return L
;else if
(if (null L)
F) ; return F
;else if
(if (string< (substring F 0 1) (substring L 0 1)
(concat 'string (substring F 0 1)
(merge (substring F 1 (length F)) L)))
(
(concat 'string (substring L 0 1)
(merge F (substring L 1 (length L)) ))
))))
Edit :
I simply want to merge two strings such as the
inputs are string a = adf and string b = beg
and the result or output should be abdefg.
Thanks in advance.
Using string< is an overkill, char< should be used instead, as shown by Kaz. Recalculating length at each step would make this algorithm quadratic, so should be avoided. Using sort to "fake it" makes it O(n log n) instead of O(n). Using concatenate 'string all the time probably incurs extra costs of unneeded traversals too.
Here's a natural recursive solution:
(defun str-merge (F L)
(labels ((g (a b)
(cond
((null a) b)
((null b) a)
((char< (car b) (car a))
(cons (car b) (g a (cdr b))))
(t (cons (car a) (g (cdr a) b))))))
(coerce (g (coerce F 'list) (coerce L 'list))
'string)))
But, Common Lisp does not have a tail call optimization guarantee, let alone tail recursion modulo cons optimization guarantee (even if the latter was described as early as 1974, using "Lisp 1.6's rplaca and rplacd field assignment operators"). So we must hand-code this as a top-down output list building loop:
(defun str-merge (F L &aux (s (list nil)) ) ; head sentinel
(do ((p s (cdr p))
(a (coerce F 'list) (if q a (cdr a)))
(b (coerce L 'list) (if q (cdr b) b ))
(q nil))
((or (null a) (null b))
(if a (rplacd p a) (rplacd p b))
(coerce (cdr s) 'string)) ; FTW!
(setq q (char< (car b) (car a))) ; the test result
(if q
(rplacd p (list (car b)))
(rplacd p (list (car a))))))
Judging by your comments, it looks like you're trying to use if with a series of conditions (like a series of else ifs in some other languages). For that, you probably want cond.
I replaced that if with cond and cleaned up some other errors, and it worked.
(defun empty (s) (= (length s) 0))
(defun my-merge (F L)
(cond
((empty F)
(if (empty L)
F
L))
((empty L)
F)
(t
(if (string< (subseq F 0 1) (subseq L 0 1))
(concatenate 'string (subseq F 0 1) (my-merge (subseq F 1 (length F)) L))
(concatenate 'string (subseq L 0 1) (my-merge F (subseq L 1 (length L))))))))
Your test case came out as you wanted it to:
* (my-merge "adf" "beg")
"abdefg"
There were quite a few good answers, so why would I add one more? Well, the below is probably more efficient then the other answers here.
(defun merge-strings (a b)
(let* ((lena (length a))
(lenb (length b))
(len (+ lena lenb))
(s (make-string len)))
(labels
((safe-char< (x y)
(if (and x y) (char< x y)
(not (null x))))
(choose-next (x y)
(let ((ax (when (< x lena) (aref a x)))
(by (when (< y lenb) (aref b y)))
(xy (+ x y)))
(cond
((= xy len) s)
((safe-char< ax by)
(setf (aref s xy) ax)
(choose-next (1+ x) y))
(t
(setf (aref s xy) by)
(choose-next x (1+ y)))))))
(choose-next 0 0))))
(merge-strings "adf" "beg")
It is more efficient specifically in the sense of memory allocations - it only allocates enough memory to write the result string, never coerces anything (from list to string or from array to string etc.) It may not look very pretty, but this is because it is trying to do every calculation only once.
This is, of course, not the most efficient way to write this function, but programming absolutely w/o efficiency in mind is not going to get you far.
A recursive way to do it (fixed according to comment- other solutions can get an IF form as well).
(defun merge-strings (a b)
(concatenate 'string
(merge-strings-under a b)))
(defun merge-strings-under (a b)
(when (and
(= (length a)
(length b))
(> (length a) 0))
(append (if (string< (aref a 0) (aref b 0))
(list (aref a 0) (aref b 0))
(list (aref b 0) (aref a 0)))
(merge-strings-under (subseq a 1)
(subseq b 1)))))
Here's a iterative way to do it.
(concatenate 'string
(loop for i across "adf" for j across "beg" nconc (list i j)))
Note that these rely on building the string into a list of characters, then vectorizing it ( a string is a vector of characters).
You can also write a more C-esque approach...
(defun merge-strings-vector (a b)
(let ((retstr (make-array (list (+
(length a)
(length b)))
:element-type 'character)))
(labels ((merge-str (a b i)
(when (and
(= (length a)
(length b))
(/= i (length a)))
(setf (aref retstr (* 2 i)) (aref a i))
(setf (aref retstr (1+ (* 2 i))) (aref b i))
(merge-str a b (1+ i)))))
(merge-str a b 0)
retstr)))
Note that this one - unlike the other 2 - has side effects within the function. It also, imo, is more difficult to understand.
All 3 take varying numbers of cycles to execute on SBCL 56; each seems to take between 6K and 11K on most of my trials. I'm not sure why.