How do I write a function that takes both a scoring function (which I've written already) and a list of pairs of strings as input (which I'm confused on how to write), and returns a modified list of pairs of strings, where the returned list should contain all the optimal string pairs from the input, scored according to the input function.
Example input:
'( ("hello" "b_low") ("hello_" "b_l_ow") ("hello" "_blow") ("hello" "blow") ("h_e_llo" "bl_o__w") )
Example output:
( ("hello" "b_low") ("hello_" "b_l_ow") ("hello" "_blow") )
the function takes a list of pairs of strings as shown above. It also takes in a function. It uses this function that it takes in as a means to evaluate the list of pairs of strings. It then returns a list of pairs of strings containing all of the pairs of strings that had the highest match-score based on the function it was given to evaluate them with. In other words, (("hello" "b_low") ("hello_" "b_l_ow") ("hello" “_blow")) all had the same score of -3, but ("h_e_llo" “bl_o__w”)) has a score of -12, thus it is dropped from the list.
The functions to compute alignemt:
(define (char-scorer char1 char2)
(cond
((char=? char1 char2) 2)
((or (char=? char1 #\_ ) (char=? #\_ char2)) -2)
(else -1)))
(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 (char-scorer (string-ref s1 index) (string-ref s2 index)))(+ index 1)))))
I would divide the operation into two steps.
Compute the maximum score. Here's a function that can do that.
(define (get-maximum-score lst scoring-func)
(apply max (map (lambda (x) (scoring-func (car x) (cadr x))) lst)))
Filter the list by selecting the items that match the maximum score and drop the rest.
(define (get-maximum-score-items lst scoring-func)
(define max-score (get-maximum-score lst scoring-func))
(define (helper in out)
(if (null? in)
out
(if (eq? max-score (scoring-func (caar in) (cadar in)))
(helper (cdr in) (append out (list (car in))))
(helper (cdr in) out))))
(helper lst '())
)
Now get the result.
(print
(get-maximum-score-items
'(("hello" "b_low") ("hello_" "b_l_ow") ("hello" "_blow") ("hello" "blow") ("h_e_llo" "bl_o__w"))
alignment-score))
Related
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.
What I'm currently trying to do is have two sets of integers in a text file be used as parameters for executing a function that calculates the symmetric difference of two sets. The format of the text file is that on first line, there is a set of numbers each separated by a space and on the second line, there is another set of different numbers that's separated by spaces. For example:
1 2 3 4
5 6 1 2
I have successfully implemented a function that is able to read the file and a function that is able to calculate the symmetric difference of two sets, that takes as input of two lists that's interpreted as sets:
function that reads the file:
(define in
(lambda ()
(let ((pin(open-input-file (symbol->string (read)))))
(let g ((x(testchar pin)))
(if (eof-object? x)
(begin
(close-input-port pin)
'())
(write x))
))))
and
function that calculates the symmetric difference:
(define Sym-Dif
(lambda (L1 L2)
(cond ((null? L1) L2)
((union (intersection L1 L2) (intersection L2 L1))))))
In order to use the values from the file, I tried to implement a helper function that examines each characters from the text file such that when it hits the newline character, it recursively builds the first list and when it hits the end of file character, it recursively builds the second list:
helper function:
(define testchar
(lambda(x)
(let f()
(let ((c(read-char x)))
(cond
((eof-object? c) '())
((equal? c #\newline) (begin (list c) (testchar x)))
((char? c) (begin (append c)(write c)(testchar x))))))))
but when running the helper function with function that reads the file, I'm getting #\1#\space#\2#\space#\3#\space#\4#\5#\space#\6#\space#\1#space#\2()
How can I make the helper function to return lists instead of characters?
Any help would be greatly appreciated.
P.s I am using Dr. Racket for this.
"test.txt" contains two lines:
1 2 3 4
5 6 1 2
As sets
How about using the built-in module racket/set?
(require racket/set)
(define (lines->sets filepath)
(let* ((lines (file->lines filepath))
(lists (map (lambda (s) (string-split s " ")) lines)))
(values (list->set (list-ref lists 0)) (list->set (list-ref lists 1)))))
(define-values (set1 set2) (lines->sets "test.txt"))
(set-symmetric-difference set1 set2)
The problem of your code is, it calculates the intersection (union of two intersections) instead of the real symmetric difference (union of differences).
output:
(set "6" "3" "5" "4")
But if you want to have it as lists and not sets:
As lists
(define (lines->lists filepath)
(let* ((lines (file->lines filepath))
(lists (map (lambda (s) (string-split s " ")) lines)))
(values (list-ref lists 0) (list-ref lists 1))))
(define-values (list1 list2) (lines->lists "test.txt"))
;; translated from CL code in http://www.lee-mac.com/listsymdifference.html
(define (list-symmetric-difference l1 l2)
(append
(filter-not (lambda (x) (member x l2)) l1)
(filter-not (lambda (x) (member x l1)) l2)))
(list-symmetric-difference list1 list2)
output:
'("3" "4" "5" "6")
The problem is to:
Write a function (encode L) that takes a list of atoms L and run-length encodes the list such that the output is a list of pairs of the form (value length) where the first element is a value and the second is the number of times that value occurs in the list being encoded.
For example:
(encode '(1 1 2 4 4 8 8 8)) ---> '((1 2) (2 1) (4 2) (8 3))
This is the code I have so far:
(define (encode lst)
(cond
((null? lst) '())
(else ((append (list (car lst) (count lst 1))
(encode (cdr lst)))))))
(define (count lst n)
(cond
((null? lst) n)
((equal? (car lst) (car (cdr lst)))
(count (cdr lst) (+ n 1)))
(else (n)))))
So I know this won't work because I can't really think of a way to count the number of a specific atom in a list effectively as I would iterate down the list. Also, Saving the previous (value length) pair before moving on to counting the next unique atom in the list. Basically, my main problem is coming up with a way to keep a count of the amount of atoms I see in the list to create my (value length) pairs.
You need a helper function that has the count as additional argument. You check the first two elements against each other and recurse by increasing the count on the rest if it's a match or by consing a match and resetting count to 1 in the recursive call.
Here is a sketch where you need to implement the <??> parts:
(define (encode lst)
(define (helper lst count)
(cond ((null? lst) <??>)
((null? (cdr lst)) <??>))
((equal? (car lst) (cadr lst)) <??>)
(else (helper <??> <??>))))
(helper lst 1))
;; tests
(encode '()) ; ==> ()
(encode '(1)) ; ==> ((1 1))
(encode '(1 1)) ; ==> ((1 2))
(encode '(1 2 2 3 3 3 3)) ; ==> ((1 1) (2 2) (3 4))
Using a named let expression
This technique of using a recursive helper procedure with state variables is so common in Scheme that there's a special let form which allows you to express the pattern a bit nicer
(define (encode lst)
(let helper ((lst lst) (count 1))
(cond ((null? lst) <??>)
((null? (cdr lst)) <??>))
((equal? (car lst) (cadr lst)) <??>)
(else (helper <??> <??>)))))
Comments on the code in your question: It has excess parentheses..
((append ....)) means call (append ....) then call that result as if it is a function. Since append makes lists that will fail miserably like ERROR: application: expected a function, got a list.
(n) means call n as a function.. Remember + is just a variable, like n. No difference between function and other values in Scheme and when you put an expression like (if (< v 3) + -) it needs to evaluate to a function if you wrap it with parentheses to call it ((if (< v 3) + -) 5 3); ==> 8 or 2
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.