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.
Related
Edit: Title updated to reflect what my question should have been, and hopefully lead other users here when they have the same problem.
Little bit of a mess, but this is a work-in-progress common lisp implementation of anydice that should output some ascii art representing a probability density function for a hash-table representing dice rolls. I've been trying to figure out exactly why, but I keep getting the error *** - SYSTEM::READ-EVAL-READER: variable BAR-CHARS has no value when attempting to run the file in clisp. The error is originating from the output function.
The code is messy and convoluted (but was previously working if the inner most loop of output is replaced with something simpler), but this specific error does not make sense to me. Am I not allowed to access the outer let* variables/bindings/whatever from the inner most loop/cond? Even when I substitute bar-chars for the list form directly, I get another error that char-decimal has no value either. I'm sure there's something about the loop macro interacting with the cond macro I'm missing, or the difference between setf, let*, multiple-value-bind, etc. But I've been trying to debug this specific problem for hours with no luck.
(defun sides-to-sequence (sides)
(check-type sides integer)
(loop for n from 1 below (1+ sides) by 1 collect n))
(defun sequence-to-distribution (sequence)
(check-type sequence list)
(setf distribution (make-hash-table))
(loop for x in sequence
do (setf (gethash x distribution) (1+ (gethash x distribution 0))))
distribution)
(defun distribution-to-sequence (distribution)
(check-type distribution hash-table)
(loop for key being each hash-key of distribution
using (hash-value value) nconc (loop repeat value collect key)))
(defun combinations (&rest lists)
(if (endp lists)
(list nil)
(mapcan (lambda (inner-val)
(mapcar (lambda (outer-val)
(cons outer-val
inner-val))
(car lists)))
(apply #'combinations (cdr lists)))))
(defun mapcar* (func lists) (mapcar (lambda (args) (apply func args)) lists))
(defun dice (left right)
(setf diceprobhash (make-hash-table))
(cond ((integerp right)
(setf right-distribution
(sequence-to-distribution (sides-to-sequence right))))
((listp right)
(setf right-distribution (sequence-to-distribution right)))
((typep right 'hash-table) (setf right-distribution right))
(t (error (make-condition 'type-error :datum right
:expected-type
(list 'integer 'list 'hash-table)))))
(cond ((integerp left)
(sequence-to-distribution
(mapcar* #'+
(apply 'combinations
(loop repeat left collect
(distribution-to-sequence right-distribution))))))
(t (error (make-condition 'type-error :datum left
:expected-type
(list 'integer))))))
(defmacro d (arg1 &optional arg2)
`(dice ,#(if (null arg2) (list 1 arg1) (list arg1 arg2))))
(defun distribution-to-probability (distribution)
(setf probability-distribution (make-hash-table))
(setf total-outcome-count
(loop for value being the hash-values of distribution sum value))
(loop for key being each hash-key of distribution using (hash-value value)
do (setf (gethash key probability-distribution)
(float (/ (gethash key distribution) total-outcome-count))))
probability-distribution)
(defun output (distribution)
(check-type distribution hash-table)
(format t " # %~%")
(let* ((bar-chars (list 9617 9615 9614 9613 9612 9611 9610 9609 9608))
(bar-width 100)
(bar-width-eighths (* bar-width 8))
(probability-distribution (distribution-to-probability distribution)))
(loop for key being each hash-key of
probability-distribution using (hash-value value)
do (format t "~4d ~5,2f ~{~a~}~%" key (* 100 value)
(loop for i from 0 below bar-width
do (setf (values char-column char-decimal)
(truncate (* value bar-width)))
collect
(cond ((< i char-column)
#.(code-char (car (last bar-chars))))
((> i char-column)
#.(code-char (first bar-chars)))
(t
#.(code-char (nth (truncate
(* 8 (- 1 char-decimal)))
bar-chars)))))))))
(output (d 2 (d 2 6)))
This is my first common lisp program I've hacked together, so I don't really want any criticism about formatting/style/performance/design/etc as I know it could all be better. Just curious what little detail I'm missing in the output function that is causing errors. And felt it necessary to include the whole file for debugging purposes.
loops scoping is perfectly conventional. But as jkiiski says, #. causes the following form to be evaluated at read time: bar-chars is not bound then.
Your code is sufficiently confusing that I can't work out whether there's any purpose to read-time evaluation like this. But almost certainly there is not: the uses for it are fairly rare.
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.
I have a problem with a function showlength which I'm programming in Scheme:
(define showlength
(lambda (m lst)
(cond ((number? m) (list (cons m lst)
(+ 1(length lst))))
((pair? m) (let* ([x (cdr m)]
[y (car m)])
(showlength x lst)
(showlength y lst))))))
The code is meant to take either a number or a pair of numbers and a list(lst) and returns a list showing all values contained in the list and the length of the list. The program works for when I have just a number of example:
(showlength 2 '())
and returns
((2) 1)
but when I try it for a problem consisting of a pair of numbers of example
(showlength (cons 2 3) ' ())
in which the returned value is meant to be
((0 . 1) 3 2) 3)
it shows
((2) 1)
What is wrong with my code?
EDIT: For those who the code isnt that clear to. When a pair of numbers is used, the code is meant to add the cdr of the pair to the list. Then its meant to add the car of the pair to the list( where the list already contains the cdr of the pair from above) and then returns the list and its length
The issue is that in your let statement, you have two independent calls to show length, and you implementation is just returning the value of the first.
In scheme a function only ever returns one value (generally, some implementation provide special mechanisms to allow a value to expect and accept multiple return values. )
My question is where in the world do you expect a zero to come from? The smallest value in the m is 2, and the smallest value that length can return of it's own volition is 1, when lst length is zero.
Whatever it is you're doing you need to step back and check your assumptions, something isn't right.
(define showlength
(lambda (m lst)
(cond ((number? m) (list (cons m lst)
(+ 1(length lst))))
((pair? m) (let* ((x (cdr m))
(y (car m)))
(cons (showlength x lst)
(showlength y lst)))))))
Tying the returns together with cons will get you a single value without losing anything, but it's not the return value you want.
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.
Below is an attempt I've made to create a procedure that returns the function composition given a list of functions in scheme. I've reached an impasse; What I've written tried makes sense on paper but I don't see where I am going wrong, can anyone give some tips?
; (compose-all-rec fs) -> procedure
; fs: listof procedure
; return the function composition of all functions in fs:
; if fs = (f0 f1 ... fN), the result is f0(f1(...(fN(x))...))
; implement this procedure recursively
(define compose-all-rec (lambda (fs)
(if (empty? fs) empty
(lambda (fs)
(apply (first fs) (compose-all-rec (rest fs)))
))))
where ((compose-all-rec (list abs inc)) -2) should equal 1
I'd try a different approach:
(define (compose-all-rec fs)
(define (apply-all fs x)
(if (empty? fs)
x
((first fs) (apply-all (rest fs) x))))
(λ (x) (apply-all fs x)))
Notice that a single lambda needs to be returned at the end, and it's inside that lambda (which captures the x parameter and the fs list) that happens the actual application of all the functions - using the apply-all helper procedure. Also notice that (apply f x) can be expressed more succinctly as (f x).
If higher-order procedures are allowed, an even shorter solution can be expressed in terms of foldr and a bit of syntactic sugar for returning a curried function:
(define ((compose-all-rec fs) x)
(foldr (λ (f a) (f a)) x fs))
Either way the proposed solutions work as expected:
((compose-all-rec (list abs inc)) -2)
=> 1
Post check-mark, but what the heck:
(define (compose-all fns)
(assert (not (null? fns)))
(let ((fn (car fns)))
(if (null? (cdr fns))
fn
(let ((fnr (compose-all (cdr fns))))
(lambda (x) (fn (fnr x)))))))