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?
Related
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.
I am working on this school assignment and i kept running into this issue in the last line of the code below. The error is list-ref: contract violation. So, i was hoping that i can get help rewriting that last line so that i am able to use recursion because i am not allowed to use loops or begin as part of the assignment.
(define (second lst)
(cond [(and(list? lst)(not(null? lst)) (not(null? (cdr lst)))) (first (rest lst))]
[else '()]))
(define (extract-helper lst size counter)
(cond [(equal? size counter) counter]
[else (second (list-ref lst counter))(extract-helper (list-ref lst (+ counter 1)) size (+ counter 1))]))
could someone help me with clarification to one of the possible solution to exercise 3.19. the procedure mystery is infinite loop in case list cycle is given as argument. nevertheless when we use procedure eq? to check if list contains the cycle, it works and provides true value.
(define (last-pair x)
(if (null? (cdr x))
x
(last-pair (cdr x))
)
)
(define (make-cycle x)
(set-cdr! (last-pair x) x)
)
(define (mystery x)
(define (loop x y)
(if (null? x)
y
(let ((temp (cdr x)))
(set-cdr! x y)
(loop temp x)
)
)
)
(loop x '())
)
(define t (list 1 2 3))
(define w (make-cycle t))
(eq? (mystery t) t)
it looks like magic. I would appreciate for any help.
mystery reverses an array "in-place" by repeatedly snipping off the cdr of each entry and replacing that with the cdr of the previous x.
If this list has no loop, then it will end up reversed by the time you get back to the original '(). If there is a loop, you'll have the original array's pointer.
This is definitely a tricky to understand issue. If you make a box-and-pointer diagram it will definitely help and you'll only need to draw 3 diagrams.
Automatically Generating Diagrams of Lists
In the process of doing SICP myself, I found myself wanting a way to visualize list mutation (and to skip the numerous "draw a list diagram of..." exercises). I wrote a small function for doing so and I thought you might find it helpful if I shared it.
These diagrams are an example of this function being run on x each time loop (within the mystery function) is ran.
The following code is what I used for generating these diagrams. I wrote this code as a Scheme novice, but it's very simple to use: the function (list->graphviz) accepts a parameter lst which is the list you'd like a diagram of, as well as an optional argument graph-name which gives the graph a special name.
(define* (list->graphviz lst #:optional graph-name)
"""Convert a list into a set of Graphviz instructions
`lst' is the list you'd like a diagram of
`graph-name` is an optional parameter indicating the name you'd like to give the graph."""
(define number 0)
(define result "")
(define ordinals '())
(define (result-append! str)
(set! result (string-append result str)))
(define* (nodename n #:optional cell)
(format #f "cons~a~a" n (if cell (string-append ":" cell) "")))
(define* (build-connector from to #:optional from-cell)
(format #f "\t~a -> ~a;~%" (nodename from from-cell) (nodename to)))
(define (build-shape elt)
(define (build-label cell)
(cond ((null? cell) "/");; "∅") ; null character
((pair? cell) "*");; "•") ; bullet dot character
(else (format #f "~a" cell))))
(set! number (+ number 1))
(format #f "\t~a [shape=record,label=\"<car> ~a | <cdr> ~a\"];~%"
(nodename number)
(build-label (car elt))
(build-label (cdr elt))))
(define* (search xs #:optional from-id from-cell)
(let ((existing (assq xs ordinals)))
(cond
;; if we're not dealing with a pair, don't bother making a shape
((not (pair? xs)) (result-append! "\tnothing [shape=polygon, label=\"not a pair\"]\n"))
((pair? existing)
(result-append! (build-connector from-id (cdr existing) from-cell)))
(else
(begin
(result-append! (build-shape xs))
(set! ordinals (assq-set! ordinals xs number))
(let ((parent-id number))
;; make a X->Y connector
(if (number? from-id)
(result-append! (build-connector from-id parent-id from-cell)))
;; recurse
(if (pair? (car xs)) (search (car xs) parent-id "car"))
(if (pair? (cdr xs)) (search (cdr xs) parent-id "cdr"))))))))
(search lst)
(string-append "digraph " graph-name " {\n" result "}\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; Here is where `mystery' begins ;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define t '(1 2 3))
(set-cdr! (cddr t) t)
(define (mystery x)
(define (loop x y graph-num)
(display (list->graphviz x (format #f "graph~a" graph-num)))
(if (null? x)
y
(let ((temp (cdr x)))
(set-cdr! x y)
(loop temp x (+ 1 graph-num)))))
(loop x '() 0))
(mystery t)
The code above code generates Graphviz graph description statements, which must then be processed by dot (Graphviz) to be rendered to a graphical format.
For example, you can run the code above and pipe it into dot:
$ scheme generate_box_ptr.scm | dot -o ptrs.ps -Tps
This command generates a postscript file which has the advantage of separating each list into it's own page if you've run list->graphviz more than once. dot can also output PNGs, PDFs and many other file formats as the manpage describes.
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 new to Scheme, so can anyone give me an example? There's no local variable in Scheme, so how can I keep track of the number of zeros that being encountered.
I tried
#lang scheme
(define zeroes
(lambda (ll)
(cond ((null? ll)
0)
(else (= 0 (car ll))))
(zeroes (cdr ll))
)
)
But the compiler complained:
cdr: expects argument of type <pair>; given ()
Thanks,
Here's my solution (since the OP's already posted theirs):
(define (count-zeroes lst)
(let loop ((lst lst)
(count 0))
(cond ((null? lst) count)
((zero? (car lst)) (loop (cdr lst) (+ count 1)))
(else (loop (cdr lst) count)))))
Of course, no treatment of this subject can be considered complete without talking about fold, which is usually used to "summarise" a list down to a single object (like we're doing for this question):
(define (count-zeroes lst)
(fold (lambda (elem count)
(if (zero? elem) (+ count 1) count))
0 lst))
Just figured out the solution,
(define count
(lambda (lst)
(cond ((null? lst) 0)
((= 0 (car lst)) (+ 1 (count (cdr lst))))
(else (+ 0 (count (cdr lst))))
)
)
)
I'm keeping this at a hint level for now.
Your function is doing two things. First it computes 0 if its argument is an empty list, or #t or #f if its argument is a list that begins with 0 or not. Then it throws that result out and calls itself recursively on the rest of the list.
You're going to have to do two things to make this work: 1) combine the results of the individual zero tests somehow (for a thought experiment, look at your code; how would it ever return the value 2 if the list had two zeroes?); 2) "bottom out" successfully when it calls itself recursively on an empty list.