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).
Related
I figured out how to use if statements in scheme, but not quite sure of how to use cond here. I need to change both if to cond. Any suggestions?
(define (pi err)
(let loop ([n 0]
[p +nan.0]
[c 0.0])
(if (< (abs (- c p)) (/ err 4))
(* 4 p)
(loop (add1 n)
c
((if (even? n) + -) c (/ 1 (+ 1 n n)))))))
With only one predicate and a then and else expression you won't get any benefits of converting it to a cond, but it is very easy:
(if predicate-expression
then-expression
else-expression)
is the same as:
(cond
(predicate-expression then-expression)
(else else-expression))
Using your if example it becomes:
(cond
((< (abs (- c p)) (/ err 4)) (* 4 p))
(else (loop ...)))
It's much more interesting if you have nested if like this:
(if predicate-expression
then-expression
(if predicate2-expression
then2-expression
else-expression))
which turns flatter and usually easier:
(cond
(predicate-expression then-expression)
(predicat2e-expression then2-expression)
(else else-expression))
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 need to convert strings to 26-ary and then be able to convert them back.
My current code is:
(define (26-ary-word s)
(let ([len (string-length s)])
(let f ([n 0]
[acc (+
(- (char->integer (string-ref s 0)) 97)
1)]) ; adding 1 so that all strings start with 'b'
(if (< n len)
(f (add1 n) (+ (* acc 26) (- (char->integer (string-ref s n)) 97)))
acc))))
(define (word-ary-26 n)
(let f ([n (/ (- n (modulo n 26)) 26)]
[acc (cons (integer->char (+ (modulo n 26) 97)) '())])
(if (> n 0)
(f (/ (- n (modulo n 26)) 26) (cons (integer->char (+ (modulo n 26) 97)) acc))
(list->string (cdr acc))))) ; remove "b" from front of string
I add 1 to acc to start with, and remove the "b" at the end. This is because multiplying "a" - 97 by 26 is still 0.
This is already ugly, but it doesn't even work. "z" is recorded as "701" when it's in the first position (26^2), which is translated back as "az".
I can add another if clause detecting if the first letter is z, but that's really ugly. Is there any way to do this that sidesteps this issue?
(if (and (= n 0) (= acc 26))
(f (add1 n) 51)
(f (add1 n) (+ (* acc 26) (- (char->integer (string-ref s n)) 97))))
This is the ugly edge case handling code I've had to use.
Honestly, I'm not entirely sure what your code is doing, but either way, it's far more complicated than it needs to be. Converting a base-26 string to an integer is quite straightforward just by using some higher-order constructs:
; (char-in #\a #\z) -> (integer-in 0 25)
(define (base-26-char->integer c)
(- (char->integer c) (char->integer #\a)))
; #rx"[a-z]+" -> integer?
(define (base-26-string->integer s)
(let ([digits (map base-26-char->integer (string->list s))])
(for/fold ([sum 0])
([digit (in-list digits)])
(+ (* sum 26) digit))))
By breaking the problem into two functions, one that converts individual characters and one that converts an entire string, we can easily make use of Racket's string->list function to simplify the implementation.
The inverse conversion is actually slightly trickier to make elegant using purely functional constructs, but it becomes extremely trivial with an extra helper function that "explodes" an integer into its digits in any base.
; integer? [integer?] -> (listof integer?)
(define (integer->digits i [base 10])
(reverse
(let loop ([i i])
(if (zero? i) empty
(let-values ([(q r) (quotient/remainder i base)])
(cons r (loop q)))))))
Then the implementation of the string-generating functions becomes obvious.
; (integer-in 0 25) -> (char-in #\a #\z)
(define (integer->base-26-char i)
(integer->char (+ i (char->integer #\a))))
; integer? -> #rx"[a-z]+"
(define (integer->base-26-string i)
(list->string (map integer->base-26-char (integer->digits i 26))))
I would like to write a simple profiler for Scheme that gives a count of the number of times each function in a program is called. I tried to redefine the define command like this (eventually I'll add the other forms of define, but for now I am just trying to write proof-of-concept code):
(define-syntax define
(syntax-rules ()
((define (name args ...) body ...)
(set! name
(lambda (args ...)
(begin
(set! *profile* (cons name *profile*))
body ...))))))
My idea was to record in a list *profile* each call to a function, then later to examine the list and determine function counts. This works, but stores the function itself (that is, the printable representation of the function name, which in Chez Scheme is #<procedure f> for a function named f), but then I can't count or sort or otherwise process the function names.
How can I write a simple profiler for Scheme?
EDIT: Here is my simple profiler (the uniq-c function that counts adjacent duplicates in a list comes from my Standard Prelude):
(define *profile* (list))
(define (reset-profile)
(set! *profile* (list)))
(define-syntax define-profiling
(syntax-rules ()
((_ (name args ...) body ...)
(define (name args ...)
(begin
(set! *profile*
(cons 'name *profile*))
body ...)))))
(define (profile)
(uniq-c string=?
(sort string<?
(map symbol->string *profile*)))))
As a simple demonstration, here is a function to identify prime numbers by trial division. Function divides? is broken out separately because the profiler only counts function calls, not individual statements.
(define-profiling (divides? d n)
(zero? (modulo n d)))
(define-profiling (prime? n)
(let loop ((d 2))
(cond ((= d n) #t)
((divides? d n) #f)
(else (loop (+ d 1))))))
(define-profiling (prime-pi n)
(let loop ((k 2) (pi 0))
(cond ((< n k) pi)
((prime? k) (loop (+ k 1) (+ pi 1)))
(else (loop (+ k 1) pi)))))
> (prime-pi 1000)
168
> (profile)
(("divides?" . 78022) ("prime-pi" . 1) ("prime?" . 999))
And here is an improved version of the function, which stops trial division at the square root of n:
(define-profiling (prime? n)
(let loop ((d 2))
(cond ((< (sqrt n) d) #t)
((divides? d n) #f)
(else (loop (+ d 1))))))
> (reset-profile)
> (prime-pi 1000)
168
> (profile)
(("divides?" . 5288) ("prime-pi" . 1) ("prime?" . 999))
I'll have more to say about profiling at my blog. Thanks to both #uselpa and #GoZoner for their answers.
Change your line that says:
(set! *profile* (cons name *profile*))
to
(set! *profile* (cons 'name *profile*))
The evaluation of name in the body of a function defining name is the procedure for name. By quoting you avoid the evaluation and are left with the symbol/identifier. As you had hoped, your *profile* variable will be a growing list with one symbol for each function call. You can count the number of occurrences of a given name.
Here's a sample way to implement it. It's written in Racket but trivial to transform to your Scheme dialect.
without syntax
Let's try without macros first.
Here's the profile procedure:
(define profile
(let ((cache (make-hash))) ; the cache memorizing call info
(lambda (cmd . pargs) ; parameters of profile procedure
(case cmd
((def) (lambda args ; the function returned for 'def
(hash-update! cache (car pargs) add1 0) ; prepend cache update
(apply (cadr pargs) args))) ; call original procedure
((dmp) (hash-ref cache (car pargs))) ; return cache info for one procedure
((all) cache) ; return all cache info
((res) (set! cache (make-hash))) ; reset cache
(else (error "wot?")))))) ; unknown parameter
and here's how to use it:
(define test1 (profile 'def 'test1 (lambda (x) (+ x 1))))
(for/list ((i 3)) (test1 i))
=> '(1 2 3)
(profile 'dmp 'test1)
=> 3
adding syntax
(define-syntax define!
(syntax-rules ()
((_ (name args ...) body ...)
(define name (profile 'def 'name (lambda (args ...) body ...))))))
(define! (test2 x) (* x 2))
(for/list ((i 4)) (test2 i))
=> '(0 2 4 6)
(profile 'dmp 'test2)
=> 4
To dump all:
(profile 'all)
=> '#hash((test2 . 4) (test1 . 3))
EDIT applied to your last example:
(define! (divides? d n) (zero? (modulo n d)))
(define! (prime? n)
(let loop ((d 2))
(cond ((< (sqrt n) d) #t)
((divides? d n) #f)
(else (loop (+ d 1))))))
(define! (prime-pi n)
(let loop ((k 2) (pi 0))
(cond ((< n k) pi)
((prime? k) (loop (+ k 1) (+ pi 1)))
(else (loop (+ k 1) pi)))))
(prime-pi 1000)
=> 168
(profile 'all)
=> '#hash((divides? . 5288) (prime-pi . 1) (prime? . 999))
I have written a simple procedure to find the divisors of a number (not including the number itself). I have figured out how to print them, but I would like to have this function return a list containing each of the divisors.
(define (divisors n)
(do ((i 1 (+ i 1)))
((> i (floor (/ n 2))))
(cond
((= (modulo n i) 0)
(printf "~a " i)))))
My idea is to create a local list, adding elements to it where my printf expression is, and then having the function return that list. How might I go about doing that? I am new to Scheme, and Lisp in general.
Do you necessarily have to use have to use do? here's a way:
(define (divisors n)
(do ((i 1 (add1 i))
(acc '() (if (zero? (modulo n i)) (cons i acc) acc)))
((> i (floor (/ n 2)))
(reverse acc))))
But I believe it's easier to understand if you build an output list with a named let:
(define (divisors n)
(let loop ((i 1))
(cond ((> i (floor (/ n 2))) '())
((zero? (modulo n i))
(cons i (loop (add1 i))))
(else (loop (add1 i))))))
Or if you happen to be using Racket, you can use for/fold like this:
(define (divisors n)
(reverse
(for/fold ([acc '()])
([i (in-range 1 (add1 (floor (/ n 2))))])
(if (zero? (modulo n i))
(cons i acc)
acc))))
Notice that all of the above solutions are written in a functional programming style, which is the idiomatic way to program in Scheme - without using mutation operations. It's also possible to write a procedural style solution (see #GoZoner's answer), similar to how you'd solve this problem in a C-like language, but that's not idiomatic.
Just create a local variable l and extend it instead of printing stuff. When done, return it. Like this:
(define (divisors n)
(let ((l '()))
(do ((i 1 (+ i 1)))
((> i (floor (/ n 2))))
(cond ((= (modulo n i) 0)
(set! l (cons i l))))
l))
Note that because each i was 'consed' onto the front of l, the ordering in l will be high to low. Use (reverse l) as the return value if low to high ordering is needed.