Recursion Vs. Tail Recursion - recursion

I'm quite new to functional programming, especially Scheme as used below. I'm trying to make the following function that is recursive, tail recursive.
Basically, what the function does, is scores the alignment of two strings. When given two strings as input, it compares each "column" of characters and accumulates a score for that alignment, based on a scoring scheme that is implemented in a function called scorer that is called by the function in the code below.
I sort of have an idea of using a helper function to accumulate the score, but I'm not too sure how to do that, hence how would I go about making the function below tail-recursive?
(define (alignment-score string_one string_two)
(if (and (not (= (string-length string_one) 0))
(not (=(string-length string_two) 0)))
(+ (scorer (string-ref string_one 0)
(string-ref string_two 0))
(alignment-score-not-tail
(substring string_one 1 (string-length string_one))
(substring string_two 1 (string-length string_two))
)
)
0)
)

Just wanted to make an variant of Chris' answer that uses lists of chars:
(define (alignment-score s1 s2)
(let loop ((score 0)
(l1 (string->list s1))
(l2 (string->list s2)))
(if (or (null? l1) (null? l2))
score
(loop (+ score (scorer (car l1)
(car l2)))
(cdr l1)
(cdr l2)))))
No use stopping there. Since this now have become list iteration we can use higher order procedure. Typically we want a fold-left or foldl and SRFI-1 fold is an implementation of that that doesn't require the lists to be of the same length:
; (import (scheme) (only (srfi :1) fold)) ; r7rs
; (import (rnrs) (only (srfi :1) fold)) ; r6rs
; (require srfi/1) ; racket
(define (alignment-score s1 s2)
(fold (lambda (a b acc)
(+ acc (scorer a b)))
0
(string->list s1)
(string->list s2)))
If you accumulating and the order doesn't matter always choose a left fold since it's always tail recursive in Scheme.

Here's how it would look like with accumulator:
(define (alignment-score s1 s2)
(define min-length (min (string-length s1) (string-length s2)))
(let loop ((score 0)
(index 0))
(if (= index min-length)
score
(loop (+ score (scorer (string-ref s1 index)
(string-ref s2 index)))
(+ index 1)))))
In this case, score is the accumulator, which starts as 0. We also have an index (also starting as 0) that keeps track of which position in the string to grab. The base case, when we reach the end of either string, is to return the accumulated score so far.

Related

Rewriting a common function using tail-end recursion

I've been trying to tinker with this code to rewrite a "repeat" function using tail-end recursion but have gotten a bit stuck in my attempts.
(define (repeat n x)
(if (= n 0)
'()
(cons x (repeat (- n 1) x))))
This is the original "repeat" function. It traverses through 'n - 1' levels of recursion then appends 'x' into a list in 'n' additional recursive calls. Instead of that, the recursive call should be made and the 'x' should be appended to a list at the same time.
(define (repeat-tco n x)
(trace-let rec ([i 0]
[acc '()])
(if (= i n)
acc
(rec (+ i 1) (cons x acc)))))
This is the closest rewritten version that I've come up with which I believe follows tail-call recursion but I'm not completely sure.
Your repeat-tco function is indeed tail recursive: it is so because the recursive call to rec is in 'tail position': at the point where it's called, the function that is calling it has nothing left to do but return the value of that call.
[The following is just some perhaps useful things: the answer is above, but an answer which was essentially 'yes' seemed too short.]
This trick of taking a procedure p which accumulates some result via, say (cons ... (p ...)) and turning it into a procedure with an extra 'accumulator' argument which is then tail recursive is very common. A result of using this technique is that the results come out backwards: this doesn't matter for you because all the elements of your list are the same, but imagine this:
(define (evens/backwards l)
(let loop ([lt l]
[es '()])
(if (null? lt)
es
(loop (rest lt)
(if (even? (first lt))
(cons (first lt) es)
es)))))
This will return the even elements of its arguments, but backwards. If you want them the right way around, a terrible answer is
(define (evens/terrible l)
(let loop ([lt l]
[es '()])
(if (null? lt)
es
(loop (rest lt)
(if (even? (first lt))
(append es (list (first lt)))
es)))))
(Why is it a terrible answer?) The proper answer is
(define (evens l)
(let loop ([lt l]
[es '()])
(if (null? lt)
(reverse es)
(loop (rest lt)
(if (even? (first lt))
(cons (first lt) es)
es)))))

How to remove mutability from this function in scheme (N-queens)

I'm arduously struggling my way through the N-queens problem in SICP (the book; I spent a few days on it -- last question here: Solving Eight-queens in scheme). Here is what I have for the helper functions:
#lang sicp
; the SICP language in Racket already defines this:
; (define nil '()
; boilerplate: filter function and range functions
(define (filter func lst)
(cond
((null? lst)
nil)
(else
(if (func (car lst))
(cons (car lst) (filter func (cdr lst)))
(filter func (cdr lst))))))
(define (range a b)
(if (> a b)
nil
(cons a (range (+ 1 a) b))))
; Selectors/handlers to avoid confusion on the (col, row) notation:
; representing it a position as (col, row), using 1-based indexing
(define (make-position col row) (cons col (list row)))
(define (col p) (car p))
(define (row p) (cadr p))
; adding a new position to a board
(define (add-new-position existing-positions p)
(append existing-positions
(list (make-position (col p) (row p)))))
; The 'safe' function
(define (any? l proc)
(cond ((null? l) #f)
((proc (car l)) #t)
(else (any? (cdr l) proc))))
(define (none? l proc) (not (any? l proc)))
(define (safe? existing-positions p)
(let ((bool (lambda (x) x)) (r (row p)) (c (col p)))
(and
; is the row safe? i.e., no other queen occupies that row?
(none? (map (lambda (p) (= (row p) r)) existing-positions)
bool)
; safe from the diagonal going up
(none? (map (lambda (p) (= r (+ (row p) (- c (col p)))))
existing-positions)
bool)
; safe from the diagonal going down
(none? (map (lambda (p) (= r (- (row p) (- c (col p)))))
existing-positions)
bool))))
And now, with that boilerplate, the actual/monstrous first working version I have of the queens problem:
(define (positions-for-col col size)
(map (lambda (ri) (make-position col ri))
(range 1 size)))
(define (queens board-size)
(define possible-positions '())
(define safe-positions '())
(define all-new-position-lists '())
(define all-positions-list '())
; existing-positions is a LIST of pairs
(define (queen-cols col existing-positions)
(if (> col board-size)
(begin
(set! all-positions-list
(append all-positions-list (list existing-positions))))
(begin
; for the column, generate all possible positions,
; for example (3 1) (3 2) (3 3) ...
(set! possible-positions (positions-for-col col board-size))
; (display "Possible positions: ") (display possible-positions) (newline)
; filter out the positions that are not safe from existing queens
(set! safe-positions
(filter (lambda (pos) (safe? existing-positions pos))
possible-positions))
; (display "Safe positions: ") (display safe-positions) (newline)
(if (null? safe-positions)
; bail if we don't have any safe positions
'()
; otherwise, build a list of positions for each safe possibility
; and recursively call the function for the next column
(begin
(set! all-new-position-lists
(map (lambda (pos)
(add-new-position existing-positions pos))
safe-positions))
; (display "All positions lists: ") (display all-new-position-lists) (newline)
; call itself for the next column
(map (lambda (positions-list) (queen-cols (+ 1 col)
positions-list))
all-new-position-lists))))))
(queen-cols 1 '())
all-positions-list)
(queens 5)
(((1 1) (2 3) (3 5) (4 2) (5 4))
((1 1) (2 4) (3 2) (4 5) (5 3))
((1 2) (2 4) (3 1) (4 3) (5 5))
((1 2) (2 5) (3 3) (4 1) (5 4))
((1 3) (2 1) (3 4) (4 2) (5 5))
To be honest, I think I did all the set!s so that I could more easily debug things (is that common?) How could I remove the various set!s to make this a proper functional-procedure?
As an update, the most 'terse' I was able to get it is as follows, though it still appends to a list to build the positions:
(define (queens board-size)
(define all-positions-list '())
(define (queen-cols col existing-positions)
(if (> col board-size)
(begin
(set! all-positions-list
(append all-positions-list
(list existing-positions))))
(map (lambda (positions-list)
(queen-cols (+ 1 col) positions-list))
(map (lambda (pos)
(add-new-position existing-positions pos))
(filter (lambda (pos)
(safe? existing-positions pos))
(positions-for-col col board-size))))))
(queen-cols 1 nil)
all-positions-list)
Finally, I think here is the best I can do, making utilization of a 'flatmap' function that helps deal with nested lists:
; flatmap to help with reduction
(define (reduce function sequence initializer)
(let ((elem (if (null? sequence) nil (car sequence)))
(rest (if (null? sequence) nil (cdr sequence))))
(if (null? sequence)
initializer
(function elem
(reduce function rest initializer)))))
(define (flatmap proc seq)
(reduce append (map proc seq) nil))
; actual
(define (queens board-size)
(define (queen-cols col existing-positions)
(if (> col board-size)
(list existing-positions)
(flatmap
(lambda (positions-list)
(queen-cols (+ 1 col) positions-list))
(map
(lambda (pos)
(add-new-position existing-positions
pos))
(filter
(lambda (pos)
(safe? existing-positions pos))
(positions-for-col col board-size))))))
(queen-cols 1 nil))
Are there any advantages of this function over the one using set! or is it more a matter of preference (I find the set! one easier to read and debug).
When you are doing the SICP problems, it would be most beneficial if you strive to adhere to the spirit of the question. You can determine the spirit from the context: the topics covered till the point you are in the book, any helper code given, the terminology used etc. Specifically, avoid using parts of the scheme language that have not yet been introduced; the focus is not on whether you can solve the problem, it is on how you solve it. If you have been provided helper code, try to use it to the extent you can.
SICP has a way of building complexity; it does not introduce a concept unless it has presented enough motivation and justification for it. The underlying theme of the book is simplification through abstraction, and in this particular section you are introduced to various higher order procedures -- abstractions like accumulate, map, filter, flatmap which operate on sequences/lists, to make your code more structured, compact and ultimately easier to reason about.
As illustrated in the opening of this section, you could very well avoid the use of such higher programming constructs and still have programs that run fine, but their (liberal) use results in more structured, readable, top-down style code. It draws parallels from the design of signal processing systems, and shows how we can take inspiration from it to add structure to our code: using procedures like map, filter etc. compartmentalize our code's logic, not only making it look more hygienic but also more comprehensible.
If you prematurely use techniques which don't come until later in the book, you will be missing out on many key learnings which the authors intend for you from the present section. You need to shed the urge to think in an imperative way. Using set! is not a good way to do things in scheme, until it is. SICP forces you down a 'difficult' path by making you think in a functional manner for a reason -- it is for making your thinking (and code) elegant and 'clean'.
Just imagine how much more difficult it would be to reason about code which generates a tree recursive process, wherein each (child) function call is mutating the parameters of the function. Also, as I mentioned in the comments, assignment places additional burden upon the programmers (and on those who read their code) by making the order of the expressions have a bearing on the results of the computation, so it is harder to verify that the code does what is intended.
Edit: I just wanted to add a couple of points which I feel would add a bit more insight:
Your code using set! is not wrong (or even very inelegant), it is just that in doing so, you are being very explicit in telling what you are doing. Iteration also reduces the elegance a bit in addition to being bottom up -- it is generally harder to think bottom up.
I feel that teaching to do things recursively where possible is one of the aims of the book. You will find that recursion is a crucial technique, the use of which is inevitable throughout the book. For instance, in chapter 4, you will be writing evaluators (interpreters) where the authors evaluate the expressions recursively. Even much earlier, in section 2.3, there is the symbolic differentiation problem which is also an exercise in recursive evaluation of expressions. So even though you solved the problem imperatively (using set!, begin) and bottom-up iteration the first time, it is not the right way, as far as the problem statement is concerned.
Having said all this, here is my code for this problem (for all the structure and readability imparted by FP, comments are still indispensable):
; the board is a list of lists - a physical n x n board, where
; empty positions are 0 and filled positions are 1
(define (queens board-size)
(let ((empty-board (empty-board-gen board-size))) ; minor modification - making empty-board available to queen-cols
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter (lambda (positions) (safe? k positions))
; the flatmap below generates a list of new positions
; by 'adjoining position'- adding 'board-size' number
; of new positions for each of the positions obtained
; recursively from (queen-cols (- k 1)), which have
; been found to be safe till column k-1. This new
; set (list) of positions is then filtered using the
; safe? function to filter out unsafe positions
(flatmap
(lambda (rest-of-queens)
; the map below adds 'board-size' number of new
; positions to 'rest-of-queens', which is an
; element of (queen-cols (- k 1))
(map (lambda (new-row)
(adjoin-position new-row k rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size)) ; end of let block
)
; add a column having a queen placed at position (new-row, col).
(define (adjoin-position new-row col rest-queens)
(let ((board-dim (length rest-queens))) ;length of board
; first create a zero 'vector', put a queen in it at position
; 'new-row', then put (replace) this new vector/column at the
; 'col' position in rest-queens
(replace-elem (replace-elem 1 new-row (gen-zero-vector board-dim)) col rest-queens)))
(define (safe? k positions) ; the safe function
(let ((row-pos-k (non-zero-index (item-at-index k positions)))) ; get the row of the queen in column k
(define (iter-check col rem) ;iteratively check if column 'col' of the board is safe wrt the kth column
(let ((rw-col (non-zero-index (car rem)))) ; get the row of 'col' in which a queen is placed
(cond ((= k 1) #t); 1x1 board is always safe
((= col k) #t); if we reached the kth column, we are done
; some simple coordinate geometry
; checks if the row of the queen in col and kth
; column is same, and also checks if the 'slope' of
; the line connecting the queens of the two columns
; is 1 (i.e. if it's a diagonal), if either is true,
; the kth queen is not safe
((or (= row-pos-k rw-col) (= (- k col) (abs (- row-pos-k rw-col)))) #f)
(else (iter-check (+ col 1) (cdr rem)))))) ; check the next column
(iter-check 1 positions))) ; start checking from the first column
; helper functions follow
(define (item-at-index n items) ; given a list, return the nth element
(define (iter idx rem)
(if (= idx n)
(car rem)
(iter (+ idx 1) (cdr rem))))
(iter 1 items))
(define (non-zero-index items)
; gives the first non-zero element from items - used for
; determining the row at which a queen is placed
(define (iter a rem)
(if (> (car rem) 0)
a
(iter (+ a 1) (cdr rem))))
(iter 1 items))
(define (empty-board-gen n) ; the empty board is n lists, each list with n zeros
(map (lambda (x) (map (lambda (y) 0) (enumerate-interval 1 n))) (enumerate-interval 1 n)))
(define (replace-elem new-elem pos items) ; replace item at position pos in items by new-elem, ultimately used for replacing an empty column with a column which has a queen
(define (iter i res rem)
(if (= i pos)
(append res (list new-elem) (cdr rem))
(iter (+ i 1) (append res (list(car rem))) (cdr rem)))) (iter 1 '() items))
(define (gen-zero-vector n) ; generate a list of length n with only zeros as elements
(define (iter a res)
(if (> a n)
res
(iter (+ a 1) (append res (list 0))))) (iter 1 '()))
(define (flatmap proc seq)
(accumulate append '() (map proc seq)))
(define (length items) ; not particularly efficient way for length of a list
(accumulate + 0 (map (lambda (x) 1) items)))
(define (accumulate op null-value seq)
(if (null? seq)
null-value
(op (car seq) (accumulate op null-value (cdr seq)))))
(define (enumerate-interval low high) ; a list of integers from low to hi
(define (iter a b res)
(if (> a b)
res
(iter (+ a 1) b (append res (cons a '())))))
(iter low high '()))
There are many ways to tackle this problem. I'll attempt to write a short and concise solution using Racket-specific procedures, explaining each step of the way. A solution using only the Scheme procedures explained in SICP is also possible, but it'll be more verbose and I'd argue, more difficult to understand.
My aim is to write a functional-programming style solution reusing as many built-in procedures as possible, and avoiding mutation at all costs - this is the style that SICP encourages you to learn. I'll deviate from the template solution in SICP if I think we can get a clearer solution by reusing existing Racket procedures (it follows then, that this code must be executed using the #lang racket language), but I've provided another answer that fits exactly exercise 2.42 in the book, implemented in standard Scheme and compatible with #lang sicp.
First things first. Let's agree on how are we going to represent the board - this is a key point, the way we represent our data will have a big influence on how easy (or hard) is to implement our solution. I'll use a simple representation, with only the minimum necessary information.
Let's say a "board" is a list of row indexes. My origin of coordinates is the position (0, 0), on the top-left corner of the board. For the purpose of this exercise we only need to keep track of the row a queen is in, the column is implicitly represented by its index in the list and there can only be one queen per column. Using my representation, the list '(2 0 3 1) encodes the following board, notice how the queens' position is uniquely represented by its row number and its index:
0 1 2 3
0 . Q . .
1 . . . Q
2 Q . . .
3 . . Q .
Next, let's see how are we going to check if a new queen added at the end of the board is "safe" with respect to the previously existing queens. For this, we need to check if there are any other queens in the same row, or if there are queens in the diagonal lines starting from the new queen's position. We don't need to check for queens in the same column, we're trying to set a single new queen and there aren't any others in this row. Let's split this task in multiple procedures.
; main procedure for checking if a queen in the given
; column is "safe" in the board; there are no more
; queens to the "right" or in the same column
(define (safe? col board)
; we're only interested in the queen's row for the given column
(let ([row (list-ref board (sub1 col))])
; the queen must be safe on the row and on the diagonals
(and (safe-row? row board)
(safe-diagonals? row board))))
; check if there are any other queens in the same row,
; do this by counting how many times `row` appears in `board`
(define (safe-row? row board)
; only the queen we want to add can be in this row
; `curry` is a shorthand for writing a lambda that
; compares `row` to each element in `board`
(= (count (curry equal? row) board) 1))
; check if there are any other queens in either the "upper"
; or the "lower" diagonals starting from the current queen's
; position and going to the "left" of it
(define (safe-diagonals? row board)
; we want to traverse the row list from right-to-left so we
; reverse it, and remove the current queen from it; upper and
; lower positions are calculated starting from the current queen
(let loop ([lst (rest (reverse board))]
[upper (sub1 row)]
[lower (add1 row)])
; the queen is safe after checking all the list
(or (null? lst)
; the queen is not safe if we find another queen in
; the same row, either on the upper or lower diagonal
(and (not (= (first lst) upper))
(not (= (first lst) lower))
; check the next position, updating upper and lower
(loop (rest lst) (sub1 upper) (add1 lower))))))
Some optimizations could be done, for example stopping early if there's more than one queen in the same row or stopping when the diagonals' rows fall outside of the board, but they'll make the code harder to understand and I'll leave them as an exercise for the reader.
In the book they suggest we use an adjoin-position procedure that receives both row and column parameters; with my representation we only need the row so I'm renaming it to add-queen, it simply adds a new queen at the end of a board:
; add a new queen's row to the end of the board
(define (add-queen queen-row board)
(append board (list queen-row)))
Now for the fun part. With all of the above procedures in place, we need to try out different combinations of queens and filter out those that are not safe. We'll use higher-order procedures and recursion for implementing this backtracking solution, there's no need to use set! at all as long as we're in the right mindset.
This will be easier to understand if you read if from the "inside out", try to grok what the inner parts do before going to the outer parts, and always remember that we're unwinding our way in a recursive process: the first case that will get executed is when we have an empty board, the next case is when we have a board with only one queen in position and so on, until we finally have a full board.
; main procedure: returns a list of all safe boards of the given
; size using our previously defined board representation
(define (queens board-size)
; we need two values to perform our computation:
; `queen-col`: current row of the queen we're attempting to set
; `board-size`: the full size of the board we're trying to fill
; I implemented this with a named let instead of the book's
; `queen-cols` nested procedure
(let loop ([queen-col board-size])
; if there are no more columns to try exit the recursion
(if (zero? queen-col)
; base case: return a list with an empty list as its only
; element; remember that the output is a list of lists
; the book's `empty-board` is just the empty list '()
(list '())
; we'll generate queen combinations below, but only the
; safe ones will survive for the next recursive call
(filter (λ (board) (safe? queen-col board))
; append-map will flatten the results as we go, we want
; a list of lists, not a list of lists of lists of...
; this is equivalent to the book's flatmap implementation
(append-map
(λ (previous-boards)
(map (λ (new-queen-row)
; add a new queen row to each one of
; the previous valid boards we found
(add-queen new-queen-row previous-boards))
; generate all possible queen row values for this
; board size, this is similar to the book's
; `enumerate-interval` but starting from zero
(range board-size)))
; advance the recursion, try a smaller column
; position, as the recursion unwinds this will
; return only previous valid boards
(loop (sub1 queen-col)))))))
And that's all there is to it! I'll provide a couple of printing procedures (useful for testing) which should be self-explanatory; they take my compact board representation and print it in a more readable way. Queens are represented by 'o and empty spaces by 'x:
(define (print-board board)
(for-each (λ (row) (printf "~a~n" row))
(map (λ (row)
(map (λ (col) (if (= row col) 'o 'x))
board))
(range (length board)))))
(define (print-all-boards boards)
(for-each (λ (board) (print-board board) (newline))
boards))
We can verify that things work and that the number of solutions for the 8-queens problem is as expected:
(length (queens 8))
=> 92
(print-all-boards (queens 4))
(x x o x)
(o x x x)
(x x x o)
(x o x x)
(x o x x)
(x x x o)
(o x x x)
(x x o x)
As a bonus, here's another solution that works with the exact definition of queens as provided in the SICP book. I won't go into details because it uses the same board representation (except that here the indexes start in 1 not in 0) and safe? implementation of my previous answer, and the explanation for the queens procedure is essentially the same. I did some minor changes to favor standard Scheme procedures, so hopefully it'll be more portable.
#lang racket
; redefine procedures already explained in the book with
; Racket equivalents, delete them and use your own
; implementation to be able to run this under #lang sicp
(define flatmap append-map)
(define (enumerate-interval start end)
(range start (+ end 1)))
; new definitions required for this exercise
(define empty-board '())
(define (adjoin-position row col board)
; `col` is unused
(append board (list row)))
; same `safe?` implementation as before
(define (safe? col board)
(let ((row (list-ref board (- col 1))))
(and (safe-row? row board)
(safe-diagonals? row board))))
(define (safe-row? row board)
; reimplemented to use standard Scheme procedures
(= (length (filter (lambda (r) (equal? r row)) board)) 1))
(define (safe-diagonals? row board)
(let loop ((lst (cdr (reverse board)))
(upper (- row 1))
(lower (+ row 1)))
(or (null? lst)
(and (not (= (car lst) upper))
(not (= (car lst) lower))
(loop (cdr lst) (- upper 1) (+ lower 1))))))
; exact same implementation of `queens` as in the book
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter
(lambda (positions) (safe? k positions))
(flatmap
(lambda (rest-of-queens)
(map (lambda (new-row)
(adjoin-position new-row k rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size))
; debugging
(define (print-board board)
(for-each (lambda (row) (display row) (newline))
(map (lambda (row)
(map (lambda (col) (if (= row col) 'o 'x))
board))
(enumerate-interval 1 (length board)))))
(define (print-all-boards boards)
(for-each (lambda (board) (print-board board) (newline))
boards))
The above code is more in spirit with the original exercise, which asked you to implement just three definitions: empty-board, adjoin-position and safe?, thus this was more of a question about data representation. Unsurprisingly, the results are the same:
(length (queens 8))
=> 92
(print-all-boards (queens 4))
(x x o x)
(o x x x)
(x x x o)
(x o x x)
(x o x x)
(x x x o)
(o x x x)
(x x o x)

How can I make my average function tail recursive in Lisp

I am simply trying to make this average function to be tail recursive. I have managed to get my function to work and that took some considerable effort. Afterwards I went to ask my professor if my work was satisfactory and he informed me that
my avg function was not tail recursive
avg did not produce the correct output for lists with more than one element
I have been playing around with this code for the past 2 hours and have hit a bit of a wall. Can anyone help me to identify what I am not understanding here.
Spoke to my professor he was != helpful
(defun avg (aList)
(defun sumup (aList)
(if (equal aList nil) 0
; if aList equals nil nothing to sum
(+ (car aList) (sumup (cdr aList)) )
)
)
(if
(equal aList nil) 0
; if aList equals nil length dosent matter
(/ (sumup aList) (list-length aList) )
)
)
(print (avg '(2 4 6 8 19))) ;39/5
my expected results for my test are commented right after it 39/5
So this is what I have now
(defun avg (aList &optional (sum 0) (length 0))
(if aList
(avg (cdr aList) (+ sum (car aList))
(+ length 1))
(/ sum length)))
(print (avg '(2 4 6 8 19))) ;39/5
(defun avg (list &optional (sum 0) (n 0))
(cond ((null list) (/ sum n))
(t (avg (cdr list)
(+ sum (car list))
(+ 1 n)))))
which is the same like:
(defun avg (list &optional (sum 0) (n 0))
(if (null list)
(/ sum n)
(avg (cdr list)
(+ sum (car list))
(+ 1 n))))
or more similar for your writing:
(defun avg (list &optional (sum 0) (n 0))
(if list
(avg (cdr list)
(+ sum (car list))
(+ 1 n))
(/ sum n)))
(defun avg (lst &optional (sum 0) (len 0))
(if (null lst)
(/ sum len)
(avg (cdr lst) (incf sum (car lst)) (1+ len))))
You could improve your indentation here by putting the entire if-then/if-else statement on the same line, because in your code when you call the avg function recursively the indentation bleeds into the next line. In the first function you could say that if the list if null (which is the base case of the recursive function) you can divide the sum by the length of the list. If it is not null, you can obviously pass the cdr of the list, the sum so far by incrementing it by the car of the list, and then increment the length of the list by one. Normally it would not be wise to use the incf or 1+ functions because they are destructive, but in this case they will only have a localized effect because they only impact the optional sum and len parameters for this particular function, and not the structure of the original list (or else I would have passed a copy of the list).
Another option would be to use a recursive local function, and avoid the optional parameters and not have to compute the length of the list on each recursive call. In your original code it looks like you were attempting to use a local function within the context of your avg function, but you should use the "labels" Special operator to do that, and not "defun":
(defun avg (lst)
(if (null lst)
0
(labels ((find-avg (lst sum len)
(if (null lst)
(/ sum len)
(find-avg (cdr lst) (incf sum (car lst)) len))))
(find-avg lst 0 (length lst))))
I'm not 100% sure if your professor would want the local function to be tail-recursive or if he was referring to the global function (avg), but that is how you could also make the local function tail-recursive if that is an acceptable remedy as well. It's actually more efficient in some ways, although it requires more lines of code. In this case a lambda expression could also work, BUT since they do not have a name tail-recursion is not possibly, which makes the labels Special operator is useful for local functions if tail-recursion is mandatory.

Arithmetic Recursion

I'm a beginner to scheme and I'm trying to learn some arithmetic recursion. I can't seem to wrap my head around doing this using scheme and producing the correct results. For my example, I'm trying to produce a integer key for a string by doing arithmetic on each character in the string. In this case the string is a list such as: '(h e l l o). The arithmetic I need to perform is to:
For each character in the string do --> (33 * constant + position of letter in alphabet)
Where the constant is an input and the string is input as a list.
So far I have this:
(define alphaTest
(lambda (x)
(cond ((eq? x 'a) 1)
((eq? x 'b) 2))))
(define test
(lambda (string constant)
(if (null? string) 1
(* (+ (* 33 constant) (alphaTest (car string))) (test (cdr string)))
I am trying to test a simple string (test '( a b ) 2) but I cannot produce the correct result. I realize my recursion must be wrong but I've been toying with it for hours and hitting a wall each time. Can anyone provide any help towards achieving this arithmetic recursion? Please and thank you. Keep in mind I'm an amateur at Scheme language :)
EDIT
I would like to constant that's inputted to change through each iteration of the string by making the new constant = (+ (* 33 constant) (alphaTest (car string))). The output that I'm expecting for input string '(a b) and constant 2 should be as follows:
1st Iteration '(a): (+ (* 33 2) (1)) = 67 sum = 67, constant becomes 67
2nd Iteration '(b): (+ (* 33 67) (2)) = 2213 sum = 2213, constant becomes 2213
(test '(a b) 2) => 2280
Is this what you're looking for?
(define position-in-alphabet
(let ([A (- (char->integer #\A) 1)])
(λ (ch)
(- (char->integer (char-upcase ch)) A))))
(define make-key
(λ (s constant)
(let loop ([s s] [constant constant] [sum 0])
(cond
[(null? s)
sum]
[else
(let ([delta (+ (* 33 constant) (position-in-alphabet (car s)))])
(loop (cdr s) delta (+ sum delta)))]))))
(make-key (string->list ) 2) => 0
(make-key (string->list ab) 2) => 2280
BTW, is the procedure supposed to work on strings containing characters other than letters—like numerals or spaces? In that case, position-in-alphabet might yield some surprising results. To make a decent key, you might just call char->integer and not bother with position-in-alphabet. char->integer will give you a different number for each character, not just each letter in the alphabet.
(define position-in-alphabet
(let ([A (- (char->integer #\A) 1)])
(lambda (ch)
(- (char->integer (char-upcase ch)) A))))
(define (test chars constant)
(define (loop chars result)
(if (null? chars)
result
(let ((r (+ (* 33 result) (position-in-alphabet (car chars)))))
(loop (rest chars) (+ r result)))))
(loop chars constant))
(test (list #\a #\b) 2)
Here's a solution (in MIT-Gnu Scheme):
(define (alphaTest x)
(cond ((eq? x 'a) 1)
((eq? x 'b) 2)))
(define (test string constant)
(if (null? string)
constant
(test (cdr string)
(+ (* 33 constant) (alphaTest (car string))))))
Sample outputs:
(test '(a) 2)
;Value: 67
(test '(a b) 2)
;Value: 2213
I simply transform the constant in each recursive call and return it as the value when the string runs out.
I got rid of the lambda expressions to make it easier to see what's happening. (Also, in this case the lambda forms are not really needed.)
Your test procedure definition appears to be broken:
(define test
(lambda (string constant)
(if (null? string)
1
(* (+ (* 33 constant)
(alphaTest (car string)))
(test (cdr string)))
Your code reads as:
Create a procedure test that accepts two arguments; string and constant.
If string is null, pass value 1, to end the recursion. Otherwise, multiply the following values:
some term x that is = (33 * constant) + (alphaTest (car string)), and
some term y that is the output of recursively passing (cdr string) to the test procedure
I don't see how term y will evaluate, as 'test' needs two arguments. My interpreter threw an error. Also, the parentheses are unbalanced. And there's something weird about the computation that I can't put my finger on -- try to do a paper evaluation to see what might be getting computed in each recursive call.

Scheme / Racket Best Practice - Recursion vs Variable Accumulation

I'm new to Scheme (via Racket) and (to a lesser extent) functional programming, and could use some advise on the pros and cons of accumulation via variables vs recursion. For the purposes of this example, I'm trying to calculate a moving average. So, for a list '(1 2 3 4 5), the 3 period moving average would be '(1 2 2 3 4). The idea is that any numbers before the period are not yet part of the calculation, and once we reach the period length in the set, we start averaging the subset of the list according the chosen period.
So, my first attempt looked something like this:
(define (avg lst)
(cond
[(null? lst) '()]
[(/ (apply + lst) (length lst))]))
(define (make-averager period)
(let ([prev '()])
(lambda (i)
(set! prev (cons i prev))
(cond
[(< (length prev) period) i]
[else (avg (take prev period))]))))
(map (make-averager 3) '(1 2 3 4 5))
> '(1 2 2 3 4)
This works. And I like the use of map. It seems composible and open to refactoring. I could see in the future having cousins like:
(map (make-bollinger 5) '(1 2 3 4 5))
(map (make-std-deviation 2) '(1 2 3 4 5))
etc.
But, it's not in the spirit of Scheme (right?) because I'm accumulating with side effects. So I rewrote it to look like this:
(define (moving-average l period)
(let loop ([l l] [acc '()])
(if (null? l)
l
(let* ([acc (cons (car l) acc)]
[next
(cond
[(< (length acc) period) (car acc)]
[else (avg (take acc period))])])
(cons next (loop (cdr l) acc))))))
(moving-average '(1 2 3 4 5) 3)
> '(1 2 2 3 4)
Now, this version is more difficult to grok at first glance. So I have a couple questions:
Is there a more elegant way to express the recursive version using some of the built in iteration constructs of racket (like for/fold)? Is it even tail recursive as written?
Is there any way to write the first version without the use of an accumulator variable?
Is this type of problem part of a larger pattern for which there are accepted best practices, especially in Scheme?
It's a little strange to me that you're starting before the first of the list but stopping sharply at the end of it. That is, you're taking the first element by itself and the first two elements by themselves, but you don't do the same for the last element or the last two elements.
That's somewhat orthogonal to the solution for the problem. I don't think the accumulator is making your life any easier here, and I would write the solution without it:
#lang racket
(require rackunit)
;; given a list of numbers and a period,
;; return a list of the averages of all
;; consecutive sequences of 'period'
;; numbers taken from the list.
(define ((moving-average period) l)
(cond [(< (length l) period) empty]
[else (cons (mean (take l period))
((moving-average period) (rest l)))]))
;; compute the mean of a list of numbers
(define (mean l)
(/ (apply + l) (length l)))
(check-equal? (mean '(4 4 1)) 3)
(check-equal? ((moving-average 3) '(1 3 2 7 6)) '(2 4 5))
Well, as a general rule, you want to separate the manner in which you recurse and/or iterate from the content of the iteration steps. You mention fold in your question, and this points in the right step: you want some form of higher-order function that will handle the list traversal mechanics, and call a function you supply with the values in the window.
I cooked this up in three minutes; it's probably wrong in many ways, but it should give you an idea:
;;;
;;; Traverse a list from left to right and call fn with the "windows"
;;; of the list. fn will be called like this:
;;;
;;; (fn prev cur next accum)
;;;
;;; where cur is the "current" element, prev and next are the
;;; predecessor and successor of cur, and accum either init or the
;;; accumulated result from the preceeding call to fn (like
;;; fold-left).
;;;
;;; The left-edge and right-edge arguments specify the values to use
;;; as the predecessor of the first element of the list and the
;;; successor of the last.
;;;
;;; If the list is empty, returns init.
;;;
(define (windowed-traversal fn left-end right-end init list)
(if (null? list)
init
(windowed-traversal fn
(car list)
right-end
(fn left-end
(car list)
(if (null? (cdr list))
right-end
(second list))
init)
(cdr list))))
(define (moving-average list)
(reverse!
(windowed-traversal (lambda (prev cur next list-accum)
(cons (avg (filter true? (list prev cur next)))
list-accum))
#f
#f
'()
list)))
Alternately, you could define a function that converts a list into n-element windows and then map average over the windows.
(define (partition lst default size)
(define (iter lst len result)
(if (< len 3)
(reverse result)
(iter (rest lst)
(- len 1)
(cons (take lst 3) result))))
(iter (cons default (cons default lst))
(+ (length lst) 2)
empty))
(define (avg lst)
(cond
[(null? lst) 0]
[(/ (apply + lst) (length lst))]))
(map avg (partition (list 1 2 3 4 5) 0 3))
Also notice that the partition function is tail-recursive, so it doesn't eat up stack space -- this is the point of result and the reverse call. I explicitly keep track of the length of the list to avoid either repeatedly calling length (which would lead to O(N^2) runtime) or hacking together a at-least-size-3 function. If you don't care about tail recursion, the following variant of partition should work:
(define (partition lst default size)
(define (iter lst len)
(if (< len 3)
empty
(cons (take lst 3)
(iter (rest lst)
(- len 1)))))
(iter (cons default (cons default lst))
(+ (length lst) 2)))
Final comment - using '() as the default value for an empty list could be dangerous if you don't explicitly check for it. If your numbers are greater than 0, 0 (or -1) would probably work better as a default value - they won't kill whatever code is using the value, but are easy to check for and can't appear as a legitimate average

Resources