I want to write a function, which converts from a "normal" notation like this: "1+4*2-8" to this pre-notation: "+1-*428".
I hope you get the point here.
Important: It must be in Strings.
What I get so far:
(define (converter lst )
(let ((operand1 (car lst))
(operator (car (cdr lst)))
(operand2 (caddr lst)))
(list operator
(converter operand1)
(converter operand2)))
)
(infixLst->prefixLst '(1 + 2 * 3))
I got two problems here.
1) It's for Lists, I need it work for Strings like "1+3" and not '(1+3)
2) It doesn't work so far (even not for Lists), because it give me some errors regarding the "car", e.g: car: expects a pair, given 1
Soo starting with the List -> String change: (I know that (list is unappropriate here. As well as the other list-methods but I didnt got a better idea so far.
(define (infix->prefix str)
(let ((operand1 (car str))
(operator (cadr str))
(operand2 (caddr str)))
(list operator
(infix->prefix operand1)
(infix->prefix operand2)))
)
(infix->prefix "1 + 2")
The normal notation 1+4*2-8 is called infix notation.
If you simply need to use that notation, Racket has a ready module: (require infix), here's a link to its documentation.
If you want to practice writing your own infix parser, the shunting-yard algorithm can do that. It uses a stack to keep track of the operators in the math expression.
If you want to parse math from a string, you need to first split the string into a list of tokens (numbers and operators). Start with a math->tokens procedure that simply returns a list of the tokens without caring about their meaning. There are many ways to write it. Here is one:
(define (math->tokens s)
(let collect-tokens ((i 0) (tokens '()))
(if (= i (string-length s))
(reverse tokens)
(let ((char (string-ref s i)))
(if (not (char-numeric? char))
(let ((operator (string->symbol (string char))))
(collect-tokens (+ i 1) (cons operator tokens)))
(let collect-number ((j (+ i 1)))
(if (and (< j (string-length s))
(char-numeric? (string-ref s j)))
(collect-number (+ j 1))
(let ((number (string->number (substring s i j))))
(collect-tokens j (cons number tokens))))))))))
For example, (math->tokens "+1-*428") returns the list of tokens (+ 1 - * 428). Now you can apply the shunting-yard algorithm to that list.
Related
This is a problem I come up against all the time. I have a function that
does something useful, but I want a version that does something slightly
different as well.
For example, a substring search that finds all of the
positions where some substring occurs in another, longer piece of text.
Then I discover a use case that only requires finding the first instance
of the substring, or the last, or the n'th. Is there an idiomatic way to
factor out the different behaviors from the larger body of common code?
For example, here are two substring search functions. One returns the
first match. The other returns all matches. (Please ignore the fact that
this is a poor way to do a substring search.)
;; Return the index of the first matching instance of `pattern` in
;; `s`. Returns #f if there is no match.
(define (naive-string-find-first pattern s)
(let* ((p-len (string-length pattern))
(limit (- (string-length s) p-len)))
(let outer ((i 0))
(if (<= i limit)
(let inner ((j i)
(k 0))
(if (< k p-len)
(if (char=? (string-ref s j) (string-ref pattern k))
(inner (+ j 1) (+ k 1))
(outer (+ i 1)))
i))
#f))))
;; Return a list of all positions in `s` where `pattern` occurs.
;; Returns '() if there is no match.
(define (naive-string-find-all pattern s)
(let* ((p-len (string-length pattern))
(limit (- (string-length s) p-len)))
(let outer ((i 0))
(if (<= i limit)
(let inner ((j i)
(k 0))
(if (< k p-len)
(if (char=? (string-ref s j) (string-ref pattern k))
(inner (+ j 1) (+ k 1))
(outer (+ i 1)))
(cons i (outer (+ i 1)))))
'()))))
As you can see, they are almost identical, differing only in the last
two lines. Specifically, one of those lines handles proceeding from a match.
The other handles proceeding from a failure to match anything.
What I would like to be able to do is something like:
(define (naive-string-find-common pattern s match-func fail-func)
(let* ((p-len (string-length pattern))
(limit (- (string-length s) p-len)))
(let outer ((i 0))
(if (<= i limit)
(let inner ((j i)
(k 0))
(if (< k p-len)
(if (char=? (string-ref s j) (string-ref pattern k))
(inner (+ j 1) (+ k 1))
(outer (+ i 1)))
(match-func i)))
(fail-func i)))))
(define (naive-string-find-first-common pattern s)
(let ((match-f (lambda (x) x))
(fail-f (lambda (x) #f)))
(naive-string-find-common pattern s match-f fail-f)))
(define (naive-string-find-all-common pattern s)
(let ((match-f (lambda (x) (cons x (outer (+ x 1))))) ;; <-- Fails, of course.
(fail-f (lambda (x) #f)))
(naive-string-find-common pattern s match-f fail-f)))
Handling of the "find-first" behavior works. The "find-all" version
fails because the specialization procedure has no knowledge of the
named let outer.
Is there an idiomatic way to factor out the needed functionality in
cases like this?
As #soegaard says, wrapper functions that add a "flag" argument are idiomatic and clear.
The "What I would like to do" code could be repaired, for example (in Racket to use check-expect:
#lang r6rs
(import (rnrs) (test-engine racket-tests))
(define (naive-string-find-common pattern s match-func fail-func)
(let* ((p-len (string-length pattern))
(limit (- (string-length s) p-len)))
(let outer ((i 0))
(if (<= i limit)
(let inner ((j i)
(k 0))
(if (< k p-len)
(if (char=? (string-ref s j) (string-ref pattern k))
(inner (+ j 1) (+ k 1))
(outer (+ i 1)))
(match-func i (lambda () (outer (+ i 1))) )))
(fail-func i)))))
(define (naive-string-find-first-common pattern s)
(let ((match-f (lambda (x k) x))
(fail-f (lambda (x) #f)))
(naive-string-find-common pattern s match-f fail-f)))
(define (naive-string-find-all-common pattern s)
(let ((match-f (lambda (x k) (cons x (k))))
(fail-f (lambda (x) '())))
(naive-string-find-common pattern s match-f fail-f)))
(check-expect (naive-string-find-first-common "ab" "abab") 0 )
(check-expect (naive-string-find-first-common "ab" "a-b-") #f )
(check-expect (naive-string-find-all-common "ab" "abab") '(0 2) )
(check-expect (naive-string-find-all-common "ab" "a-b-") '() )
(test)
Is there an idiomatic way to factor out the needed functionality in cases like this?
The way you have done is idiomatic.
If two functions f and g do almost the same work, then make a funktion h that can do both. Make h take an extra argument, that indicates whether it should behave as f or g (here a flag that indicates whether to continue after the first needle is found). Finally define "wrappers" f and g that simply calls h with the appropriate flag(s).
I'm trying to implement Bubble Sort in Common Lisp, and I'm having a tough time getting my bearings.[See Below] is what I've got so far, which follows the algorithm as far as I can tell, but I'm getting the error " Undefined function SORTED called with arguments ()." when I run it. I can't seem to find what's the cause of that.
(defun bubble (lis)
(let ((sorted nil) (j 0))
(do () ((not sorted))
(progn
(setf sorted t)
(do (i j (+ i 1))
(if (< (nth i lis) (nth (+ i 1) lis))
(progn
(swap1 (lis (nth i lis) (nth (+ i 1) lis)))
(setf sorted nil)
)
)
)
)
)
)
)
Each call to NTH needs to iterate over the list. If you treat a list like a vector, you probably should use vectors instead. And in the case you don't really care about being efficient, you might still want to use ELT instead of NTH, since ELT works on any kind of sequence. That way, you can pass either vectors or lists and at least one of them will work reasonably well (as far as bubble sort can be efficient).
You might end up having something like the one from Rosetta Code.
By the way, Rosetta Code has an example of an iterative Bubble sort for lists, so I won't copy it. Instead, here below is a recursive version that I adapted from a Prolog one (by Roman Barták). As such it is not necessarily better, but it uses multiple values, ETYPECASE, DESTRUCTURING-BIND, ... features that are apparently not usually taught.
(defun bubble-sort (list)
(labels
((bsort (list acc)
(etypecase list
(null acc)
(cons (destructuring-bind (head . tail) list
(multiple-value-bind (new-tail max)
(bubble head tail)
(bsort new-tail
(cons max acc)))))))
(bubble (x list)
(etypecase list
(null (values nil x))
(cons (destructuring-bind (y . tail) list
(multiple-value-bind (new-tail max)
(bubble (max x y) tail)
(values (cons (min x y) new-tail)
max)))))))
(bsort list nil)))
There are quite a few things we can do to improve this code.
And something you can do to improve your question. If you ask again please provide the test cases and the specific issue.
Indenting
Lisp has relatively little syntax, but we use indenting to help highlight the structure of the code. Most Lisp aware editors help manage that. The most obvious departure from the conventional indenting approach is closing parentheses on following lines. I've Indented the mergelist function to show a more readable function body - well, at least to me.
(defun bubble (lis)
(let ((sorted nil) (j 0))
(do () ((not sorted))
(progn
(setf sorted t)
(do (i j (+ i 1))
(if (< (nth i lis) (nth (+ i 1) lis))
(progn
(swap1 (lis (nth i lis) (nth (+ i 1) lis)))
(setf sorted nil))))))))
Loop vs DO
DO has a long pedigree in lisp, but to be honest, I always make mistakes with DO, so don't use it very often. I can never remember where to return form goes, the increment. I tend to use LOOP
But first off, we don't need to use progn. Most looping constructs have an implicit progn for the code they are iterating so
(defun bubble-1 (lis)
(let ((sorted nil) (j 0))
(do () ((not sorted))
(setf sorted t)
(do (i j (+ i 1))
(if (< (nth i lis) (nth (+ i 1) lis))
(swap1 (lis (nth i lis) (nth (+ i 1) lis)))
(setf sorted nil))))))
Slightly nicer. Looking at your code there is the call to swap1, which must be a defun supplied somewhere. THis line also has a syntax problem as 'lis' appears as a function call.
Lets try to evaluate the function and see what happens
; in: DEFUN BUBBLE-1
; (LET ((SORTED NIL) (J 0))
; (DO ()
; ((NOT SORTED))
; (SETF SORTED T)
; (DO (I
; J
; (+ I 1))
; (IF (< # #) (SWAP1 #) (SETF #)))))
;
; caught STYLE-WARNING:
; The variable J is defined but never used.
; in: DEFUN BUBBLE-1
; (DO (I
; J
; (+ I 1))
; (IF
; (< (NTH I LIS) (NTH (+ I 1) LIS))
; (SWAP1 (LIS (NTH I LIS) (NTH # LIS)))
; (SETF SORTED NIL)))
; --> BLOCK
; ==>
; (LET (I J (+ I))
; (TAGBODY
; (GO #:G3)
; #:G2
; (TAGBODY)
; (PSETQ + 1)
; #:G3
; (UNLESS IF (GO #:G2))
; (RETURN-FROM NIL (PROGN (< # #) (SWAP1 #) (SETF #)))))
;
; caught WARNING:
; undefined variable: I
; --> BLOCK LET TAGBODY UNLESS
; ==>
; (IF IF
; NIL
; (GO #:G2))
;
; caught WARNING:
; undefined variable: IF
; (LIS (NTH I LIS) (NTH (+ I 1) LIS))
;
; caught STYLE-WARNING:
; undefined function: LIS
; (SWAP1 (LIS (NTH I LIS) (NTH (+ I 1) LIS)))
;
; caught STYLE-WARNING:
; undefined function: SWAP1
;
; compilation unit finished
; Undefined functions:
; LIS SWAP1
; Undefined variables:
; I IF
; caught 2 WARNING conditions
; caught 3 STYLE-WARNING conditions`enter code here`
Wow. THis is telling us a few things
The variable J in the nested DO is not used. Remove it.
The syntax for DO in the nested loop is wrong. It needs to be of the general form
(DO ((var init step))
(termination-test result-form)
statement)
The nested do is missing its termination test. Also the variable declaration for i is missing its initialization.
The Let is kind of redundant you can move the declaration of sorted into the do
(do ((sorted nil)) ((not sorted ) ... )
The form
(SWAP1 (LIS (NTH I LIS) (NTH (+ I 1) LIS)))
has two problems. Firstly SWAP1 is undefined. Secondly the form (LIS (NTH I LIS) (NTH (+ I 1) LIS)) can't possibly be right as LIS appears in a function call position. Anything that appears at the front of a form must be a function. In this cas LIS is a parameter.
Fortunately Common Lisp has an inbuilt function that will swap to values for us - its called rotatef. So the entires form would need to look like
(rotatef (nth I lis) (nth (1+ i) lis))
Once function runs, it has no result form in the do, so the sorted array will never be returned to the caller. You will see no output. You need to think about the fact you have nested loops here.
I would think a bit about your algorithm. As Zephyr Pellerin says above, a recursive solution would be much nicer, so unless your assignment is to use an iterative solution
You should study the answer of David Hodge that details all the problems of your code. Here I offer an iterative version of Bubble Sort that uses the do special form. The only main difference from the algorithm that you tried to implement with your code is the use of a variable end which is decremented each time to reduce the number of tests:
(defun bubble (lis)
(let ((sorted nil)
(end (length lis)))
(do () (sorted lis)
(setf sorted t)
(decf end)
(do ((i 0 (1+ i)))
((>= i end))
(when (< (nth i lis) (nth (1+ i) lis))
(rotatef (nth i lis) (nth (1+ i) lis))
(setf sorted nil))))))
I found a short introduction to Scheme online, and I'm having a bit of trouble with this function:
(define (title-style str)
(let loop ((lc #\space) (i 0) (c (string-ref str 0)))
((if (char=? lc #\space)
(string-set! str i (char-upcase c)))
(if (= (- (string-length str) 1) i)
str
(loop c (+ i 1) (string-ref str (+ i 1)))))))
(display "star wars iv: a new hope")
(display (title-style "star wars iv: a new hope"))
When I try calling it, I get this:
Error: call of non-procedure: #<unspecified>
Call history:
title-style.scm:6: loop
...
title-style.scm:1: g6 <--
That error comes from Chicken Scheme, I am also getting the same results in Chez Scheme.
It converts a string to title case, and from the error messages I got earlier, it does: call of non-procedure: "Star Wars Iv: A New Hope"
I understand what you intend to do, but that's not the right way to structure a conditional expression in Scheme. Also, right before the first if there's a misplaced opening parentheses (which is the one causing the reported error), and you have to advance the recursion in all cases. This should work for non-empty strings:
(define (title-style str)
(let loop ((lc #\space) (i 0) (c (string-ref str 0)))
(cond ((= (- (string-length str) 1) i)
str)
((char=? lc #\space)
(string-set! str i (char-upcase c))
(loop c (+ i 1) (string-ref str (+ i 1))))
(else
(loop c (+ i 1) (string-ref str (+ i 1)))))))
But still, it's not the recommended way to write a solution in Scheme, you're mutating the input string along the way, which is discouraged, and you're thinking in terms of indexes. Besides, you're imposing an extra restriction on your input: that the strings must be mutable, and not all Scheme dialects support this by default.
A functional tail-recursive style is preferred, where we create a new string as output, leaving the original input untouched and leveraging the rich library of list procedures available in the language; this is what I mean:
(define (title-style str)
(let loop ((lc #\space) (lst (string->list str)) (acc '()))
(cond ((null? lst)
(list->string (reverse acc)))
((char=? lc #\space)
(loop (car lst) (cdr lst) (cons (char-upcase (car lst)) acc)))
(else
(loop (car lst) (cdr lst) (cons (car lst) acc))))))
Either way, it works as expected:
(title-style "star wars iv: a new hope")
=> "Star Wars Iv: A New Hope"
I'm having some difficulty understanding how for loops work in scheme. In particular this code runs but I don't know why
(define (bubblesort alist)
;; this is straightforward
(define (swap-pass alist)
(if (eq? (length alist) 1)
alist
(let ((fst (car alist)) (scnd (cadr alist)) (rest (cddr alist)))
(if (> fst scnd)
(cons scnd (swap-pass (cons fst rest)))
(cons fst (swap-pass (cons scnd rest)))))))
; this is mysterious--what does the 'for' in the next line do?
(let for ((times (length alist))
(val alist))
(if (> times 1)
(for (- times 1) (swap-pass val))
(swap-pass val))))
I can't figure out what the (let for (( is supposed to do here, and the for expression in the second to last line is also a bit off putting--I've had the interpreter complain that for only takes a single argument, but here it appears to take two.
Any thoughts on what's going on here?
That's not a for loop, that's a named let. What it does is create a function called for, then call that; the "looping" behavior is caused by recursion in the function. Calling the function loop is more idiomatic, btw. E.g.
(let loop ((times 10))
(if (= times 0)
(display "stopped")
(begin (display "still looping...")
(loop (- times 1)))))
gets expanded to something like
(letrec ((loop (lambda (times)
(if (= times 0)
(display "stopped")
(begin (display "still looping...")
(loop (- times 1)))))))
(loop 10))
This isn't actually using a for language feature but just using a variation of let that allows you to easily write recursive functions. See this documentation on let (it's the second form on there).
What's going on is that this let form binds the name it's passed (in this case for) to a procedure with the given argument list (times and val) and calls it with the initial values. Uses of the bound name in the body are recursive calls.
Bottom line: the for isn't significant here. It's just a name. You could rename it to foo and it would still work. Racket does have actual for loops that you can read about here.
I am trying to make little human like text searching program in scheme
but this program doesn't work properly time to time
and I can't catch the bug for many hours
could somebody tell me what's wrong with my code?
and is it not that good idea for searching text?
when I search the string "exp"
in the text file which contain nothing but just string "explorer"
error arise
and it tells Found 0
(define (search str)
(set! count 0)
(define len (length str))
;null character calculating
(define data-len (- (length data) 1))
;when string length is less than or equal to data-length
(when (and (not (= 0 len)) (>= data-len len))
(define first-char (first str))
(define last-char (last str))
;is it correct?
(define (exact? str len index)
(if (equal? str (drop (take data (+ index len)) index))
#t
#f))
;check first and last character of string if correct, check whether this string is correct completely, if so, skip to next index
(define (loop [index 0])
(when (> data-len index)
(if (and (equal? first-char (list-ref data index))
(equal? last-char (list-ref data (+ index len -1))))
(when (exact? str len index)
(set! count (+ count 1))
(loop (+ index len)))
(loop (+ index 1)))))
(loop))
(send msg set-label (format "Found : ~a" count)))
I know it's been four years, but I'm nostalgic for my SCHEME class, so I made a thing. (I'd comment instead of answering, but I don't have enough reputation yet. ... And I'm probably about to have less.)
(define (find-pattern pat str); Returns a list of locations of PATturn in STRing.
(define (pattern-found? pat-list str-list); Is the pattern (pat-list) at the beginning of this string (str-list)? Also, they're lists, now.
(cond ((null? pat-list) #t); The base case for the recursion.
((null? str-list) #f); Obvious
((eq? (car pat-list) (car str-list)); First letter matches
(pattern-found? (cdr pat-list) (cdr str-list))); Recurse
(else #f)))
(define (look-for-pattern pat-list str-list counter results-list)
(cond ((null? str-list) results-list); Base case
((pattern-found? pat-list str-list)
(look-for-pattern pat-list
(cdr str-list)
(+ counter 1)
(cons counter results-list)))
(else (look-for-pattern pat-list
(cdr str-list)
(+ counter 1)
results-list))))
(look-for-pattern (string->list pat)
(string->list str)
0
'()))
EDIT: I mean it's been four years since the question, not since SCHEME class. That'd be a little creepy, but then again, who knows how I'll feel in three years?