I am trying to make a memory system where you input something in a slot of memory. So what I am doing is making an Alist and the car of the pairs is the memory location and the cdr is the val. I need the program to understand two messages, Read and Write. Read just displaying the memory location selected and the val that is assigned to that location and write changes the val of the location or address. How do I make my code so it reads the location you want it to and write to the location you want it to? Feel free to test this yourself. Any help would be much appreciated. This is what I have:
(define make-memory
(lambda (n)
(letrec ((mem '())
(dump (display mem)))
(lambda ()
(if (= n 0)
(cons (cons n 0) mem) mem)
(cons (cons (- n 1) 0) mem))
(lambda (msg loc val)
(cond
((equal? msg 'read) (display
(cons n val))(set! n (- n 1)))
((equal? msg 'write) (set! mem
(cons val loc)) (set! n (- n 1)) (display mem)))))))
(define mymem (make-memory 100))
A possible solution:
(define (make-memory n)
(let ([memory (make-vector n 0)]
[protect (lambda (addr)
(if (and (addr . >= . 0) (addr . < . n))
addr
(error "access to outside of memory")))])
(match-lambda*
[`(read ,addr) (cons addr (vector-ref memory (protect addr)))]
[`(write ,addr ,x) (vector-set! memory (protect addr) x)])))
This has the added benefit of not using alists (for speed) and protecting against malicious attempts to access stuff outside the preallocated range ;).
Works as desired:
> (define mem (make-memory 10))
> (mem 'read 0)
(0 . 0)
> (mem 'read 2)
(2 . 0)
> (mem 'write 2 10)
> (mem 'read 2)
(2 . 10)
> (mem 'read 100)
access to outside of memory
This might be a bit hard to grasp if you're just starting out with Scheme.
You can read more about match-lambda and friends here.
Vectors are Scheme's equivalent of arrays in other languages (read this).
Related
I have the following function to check if a positive value is even.
(define (even? n)
(cond
((= n 0) #t)
((< n 0) #f)
(else (even? (- n 2)))
)
)
I am trying to use this function to increment a store counter when a checked value is not even (odd) using both the even? function and a logical not, but I can't seem to figure out the correct syntax.
(define (function a b)
(define (iter a b store)
(cond
((= b 1) (+ store a)
(else
(iter (double a) (halve b) (if (not (even? b)) (+ a store) store)))
)
)
(iter a b 0)
)
Could anyone check my syntax to see what I am doing wrong?
A call of (function 1 1) should return 1
A call of (fucntion 1960 56) should return 109760 but I receive 141120
EDIT:
I realize that my halve funciton must be impromperly defined. I tried to implement a halving function that used only subtraction.
(define (halve n)
(define (iter src store)
(cond
((<= src 0) store)
(else (iter (- src 2) (+ store 1)))
)
)
(iter n 0)
)
Please note that the even? function is built-in, you don't have to implement it. Now regarding the problem - this line is not doing what you think:
(if (not (even? b)) (+ a store))
That expression doesn't update the value of store, it's just evaluating the result of adding a to store and then the value obtained is lost - we didn't save it, we didn't pass it to the recursion, the result of the addition is discarded and then the next line is executed.
In Scheme, we use set! to update a variable, but that's frowned upon, we try to avoid mutation operations - and in this case it's not necessary, we only need to pass the correct value to the recursive call.
UPDATE
Now that you've made it clear that you're implementing the Ethiopian multiplication algorithm, this is how it should be done:
(define (halve n)
(quotient n 2))
(define (double n)
(* 2 n))
(define (function a b)
(define (iter a b store)
(cond
((= a 0) store)
((even? a) (iter (halve a) (double b) store))
(else (iter (halve a) (double b) (+ store b)))))
(iter a b 0))
It works as expected:
(function 1 1)
=> 1
(function 1960 56)
=> 109760
You seem to be missing a ), just before the call to iter.
Absract: The abstract problem is:
a list of values
a list of modifiers, things that act on the values to return new values
(for the example code I'm just multiplying the value by the modifier value)
the list of modifiers is not constrained to be the same size as the list of values.
apply the modifiers to the values, and get back any unused modifiers
Here's a version that that uses two separate functions: one to actually apply the modifiers, one to get the remaining modifiers
;; Return the modified list
(define (apply-mods vals mods)
(if (or (null? vals) (null? mods)) vals
(cons (* (car vals) (car mods)) (apply-mod (cdr vals) (cdr mods)))
)
)
;; trim the modifiers
(define (trim-mods vals mods)
(if (or (null? vals) (null? mods)) mods
(trim-mods (cdr vals) (cdr mods))
)
The idea is that after I apply the list of modifiers, (apply-mods vals mods) I may want to use the remaining
modifiers (trim-mods vals mods) in subsequent operations.
Currently, the best approach I've come up with is the two function approach, but it seems wasteful to iterate though the list twice.
Is there a clean way to return both the modified values, and the unused modifiers?
Concrete The concrete problem is:
my values are musical notes; each has a volume and a duration. Something like:
(vol: 1, dur: 1 beat)(vol: 1 dur: 2 beats)(vol: 1 dur: 1 beat)...
my modifiers are "changes to the volume", each has a volume change and a duration
(dvol: +1 dur: 4 beats)(dvol: -2 dur: 4 beats)...
as I recurse through the lists, I keep track of the net accumulated time to determine which modifier is in effect for a given note.
So in the real problem there is not the easy 1-1 mapping of modifiers to values, and thus I expect to run into situations where I'll apply a list of modifiers to a list of note that is shorter (in terms of duration) than the note list; I'll then want to apply the
remaining modifiers to the next note list (I plan on breaking the overall music into chunks).
Assuming these are the expected results:
> (apply-mods '((1 . 10)) '((1 . 4) (2 . 4) (3 . 4)))
'((2 . 4) (3 . 4) (4 . 2))
'((3 . 2))
> (apply-mods '((1 . 1) (1 . 2) (1 . 1)) '((+1 . 4) (-2 . 4)))
'((2 . 1) (2 . 2) (2 . 1))
'((-2 . 4))
this is a simple loop processing 2 lists in parallel:
(define (apply-mods vals mods)
(let loop ((vals vals) (mods mods) (res null))
(cond
((null? vals) (values (reverse res) mods))
((null? mods) (error "not enough mods"))
(else
(let ((val (car vals)) (mod (car mods)))
(let ((vol (car val)) (dur (cdr val)) (dvol (car mod)) (ddur (cdr mod)))
(cond
; case 1. duration of note = duration of mod => consume note and mod
((= dur ddur)
(loop (cdr vals)
(cdr mods)
(cons (cons (+ vol dvol) dur) res)))
; case 2. duration of note < duration of mod => consume note, push back shorter mod
((< dur ddur)
(loop (cdr vals)
(cons (cons dvol (- ddur dur)) (cdr mods))
(cons (cons (+ vol dvol) dur) res)))
; case 3. duration of note > duration of mod => push back part of note, consume mod
(else
(loop (cons (cons vol (- dur ddur)) (cdr vals))
(cdr mods)
(cons (cons (+ vol dvol) ddur) res))))))))))
It seems that your requirement is even simpler, and you probably only need to cover case 1, but I can only speculate while waiting for an example. In any case, you will be able to adapt this code to your specific need quite easily.
It sounds like you may want a mutable data structure such as a queue.
(make-mod-queue '(dvol: +1 dur: 4 beats)(dvol: -2 dur: 4 beats)...))
#queue((4 (dvol: +1)) (4 (dvol: -2)) ...)
(make-note-queue '(vol: 1, dur: 1 beat)(vol: 1 dur: 2 beats)(vol: 1 dur: 1 beat))
#queue((1 (vol" 1)) (1 (vol: 1)) (2 (vol: 1))
Then a function to combine them
(define (apply-mods note-queue mod-queue)
(let ((new-queue make-empty-queue))
(get-note-dur (lambda ()
(if (emtpy-queue? note-queue)
#f
(car (front-queue note-queue)))))
(get-mod-dur (lambda ()
(if (empty-queue? mod-queue)
#f
(car (front-queue mod-queue)))))
(get-vol
(lambda ()
(if (or (empty-queue? mod-queue) (empty-queue? mod-queue))
#f
(+ (note-vol (front-queue note-queue))
(mod-vol (front-queue mod-queue)))))))
(let loop ((d1 (get-note-dur)) ;;should return #f is note-queue is empty
(d2 (get-mod-dur)) ;;ditto for mod-queue
(vol (get-volume)))
(cond ((not vol)
(cond ((and d2 (not (= d2 (get-mod-dur))))
(set-car! (front-queue mod-queue) d2) new-queue)
new-queue)
((and d1 (not (= d1 (get-note-dur))))
(set-car! (front-queue note-queue) d1) new-queue)
new-queue)
(else new-queue)))
((= d1 d2)
(insert-queue! new-queue (cons d1 (list 'vol: vol)))
(delete-queue! note-queue)
(delete-queue! mod-queue)
(loop (get-note-dur) (get-mod-dur) (get-volume)
((< d1 d2)
(insert-queue! new-queue (cons d1 (list 'vol: vol)))
(delete-queue! note-queue)
(loop (get-note-dur) (- d2 d1) (get-volume)))
((> d1 d2)
(insert-queue! new-queue (cons d2 (list 'vol: vol)))
(delete-queue! mod-queue)
(loop (- d1 d2) (get-mod-dur) (get-volume)))))))
Would return
#queue (1 (vol" 2)) (1 (vol: 2)) (2 (vol: 2)
and your mod-queue (whatever you passed it in as would now be mutated to
#queue (4 (dvol: -2)) ...),
and the original note-queue is now an empty-queue
queues as described in SICP
http://mitpress.mit.edu/sicp/full-text/sicp/book/node62.html
I am trying to write an iterative procedure to do modulo arithmetic in scheme without using the built in procedures modulo, remainder or /. However I ran into a few problems while trying to write the code, which looks like this so far:
(define (mod a b)
(define (mod-iter a b)
(cond ((= b 0) 0)
((< b 0) (+ old_b new_b))))
(mod-iter a (- a b)))
As you can see, I ran into the problem of needing to add the original value of b to the current value of b. I am not sure how to go about that. Also, when i left the second conditional's answer to be primitive data (just to make sure the enitre procedure worked), I would get an "unspecified return value" error, and I'm not sure why it happens because the rest of my code loops (or so it seems?)
Thank you in advance for any insight to this.
When you define your mod-iter function with arguments (a b) you are shadowing the arguments defined in mod. To avoid the shadowing, use different identifiers, as such:
(define (mod a b)
(define (mod-iter ax bx)
(cond ((= bx 0) 0)
((< bx 0) (+ b bx))))
(mod-iter a (- a b)))
Note, this doesn't look like the proper algorithm (there is no recursive call). How do you handle the common case of (> bx 0)? You'll need something like:
(define (mod a b)
(define (mod-iter ax bx)
(cond ((= bx 0) 0)
((< bx 0) (+ b bx))
((> bx 0) ...))) ;; <- something here with mod-iter?
(mod-iter a (- a b)))
First if you don't want to capture a variable name, use different variable names in the inner function. Second i think the arguments are wrong compared to the built-in version. (modulo 5 6) is 5 and (modulo 6 5) is 1. Anyways here is a variation in logrirthmic time. That based on generating a list of powers of b (2 4 8 16 32 ...) is b is 2, all the way up to just under the value of a. Then by opportunistically subtracting these reversed values. That way problems like (mod (expt 267 34) 85) return an answer very quickly. (a few hundred primitive function calls vs several million)
(define (mod a-in b-in)
(letrec ((a (abs a-in))
(sign (if (< 0 b-in) - +))
(b (abs b-in))
(powers-list-calc
(lambda (next-exponent)
(cond ((> b a) '())
((= next-exponent 0)
(error "Number 0 passed as the second argument to mod
is not in the correct range"))
(else (cons next-exponent (powers-list (* b next-exponent))))))))
(let ((powers-list (reverse (powers-list-calc b))))
(sign
(let loop ((a a) (powers-L powers-list))
(cond ((null? powers-L) a)
((> a (car powers-L))
(loop (- a (car powers-L)) powers-L))
(else (loop a (cdr powers-L)))))))))
I am trying to do more than one task in one if condition, here is my code:
(define (dont-tolerate-fools hist0 hist1 hist2 count)
(cond ((> 10 count) 'c)
((< 10 count) (soft-tit-for-tat hist0 hist1 hist2))
((> 10 count) (dont-tolerate-fools hist0 hist1 hist2 (+ 1 count)))))
It didn't work, because I saw that one of the conditions is true it returns it and break. I am trying to make it return 'c for the first 10 time after that it should behave according to something else.
There may be different ways to do it, but I am interesting in how can I do 2 jobs by checking only one if condition?
Thanks in advance.
If you want to do something for the first 10 times you are called, then something else afterwards, the easiest way is to have some kind of "local" variable to count how many times you've been called, such as:
(define func
(let ((count 0))
(lambda ()
(cond
((< count 10)
(set! count (+ count 1))
'a)
(else 'b)))))
(for/list ((i (in-range 15)))
(func))
=> '(a a a a a a a a a a b b b b b)
You can also see in that example that you can have multiple forms or values after the condition:
(cond
((< count 10)
(set! count (+ count 1)) ; action 1
'a) ; action 2
OTOH, if this was simply supposed to be a loop then you're missing a stop condition and one call:
(define (func (n 0))
(cond
((> n 15)
'stop)
((< n 10)
(display 'c)
(func (+ n 1)))
(else
(display 'x)
(func (+ n 1)))))
(func)
=> ccccccccccxxxxxx'stop
The syntax of cond is:
(cond (<predicate> <body> ...)
...)
where <body> ... means that any number of expressions. So you can simply rewrite your code as:
(define (dont-tolerate-fools hist0 hist1 hist2 count)
(cond ((> 10 count)
(dont-tolerate-fools hist0 hist1 hist2 (+ 1 count))
'c)
((< 10 count) (soft-tit-for-tat hist0 hist1 hist2))))
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?