What is the most transparent and elegant string to decimal number procedure you can create in Scheme?
It should produce correct results with "+42", "-6", "-.28", and "496.8128", among others.
This is inspired by the previously posted list to integer problem: how to convert a list to num in scheme?
I scragged my first attempt since it went ugly fast and realized others might like to play with it as well.
Much shorter, also makes the result inexact with a decimal point, and deal with any +- prefix. The regexp thing is only used to assume a valid syntax later on.
#lang racket/base
(require racket/match)
(define (str->num s)
;; makes it possible to assume a correct format later
(unless (regexp-match? #rx"^[+-]*[0-9]*([.][0-9]*)?$" s)
(error 'str->num "bad input ~e" s))
(define (num l a)
(match l
['() a]
[(cons #\. l) (+ a (/ (num l 0.0) (expt 10 (length l))))]
[(cons c l) (num l (+ (* 10 a) (- (char->integer c) 48)))]))
(define (sign l)
(match l
[(cons #\- l) (- (sign l))]
[(cons #\+ l) (sign l)]
[_ (num l 0)]))
(sign (string->list s)))
Here is a first shot. Not ugly, not beautiful, just longer than I'd like. Tuning another day. I will gladly pass the solution to someone's better creation.
((define (string->number S)
(define (split L c)
(let f ((left '()) (right L))
(cond ((or (not (list? L)) (empty? right)) (values L #f))
((eq? c (car right)) (values (reverse left) (cdr right)))
(else (f (cons (car right) left) (cdr right))))))
(define (mkint L)
(let f ((sum 0) (L (map (lambda (c) (- (char->integer c) (char->integer #\0))) L)))
(if (empty? L) sum (f (+ (car L) (* 10 sum)) (cdr L)))))
(define list->num
(case-lambda
((L) (cond ((empty? L) 0)
((eq? (car L) #\+) (list->num 1 (cdr L)))
((eq? (car L) #\-) (list->num -1 (cdr L)))
(else (list->num 1 L))))
((S L) (let*-values (((num E) (split L #\E)) ((W F) (split num #\.)))
(cond (E (* (list->num S num) (expt 10 (list->num E))))
(F (* S (+ (mkint W) (/ (mkint F) (expt 10 (length F))))))
(else (* S (mkint W))))))))
(list->num (string->list S)))
Related
(define (compose f1 f2)
(lambda (p2) (f1 (f2 p2))))
(define (self-compose f n)
(if (= n 1) (compose f f)
(compose f (self-compose f (- n 1)))))
(define (sort-step l f)
(cond ((eq? l '()) '())
((eq? (cdr l) '()) (list (car l)))
((f (car l) (cadr l)) (cons (car l) (sort-step (cdr l) f)))
(else (cons (cadr l) (sort-step (cons (car l) (cddr l)) f)))))
How to use self-compose with sort-step to sort?
Tried:
(define (sort-f l f)
(self-compose (sort-step l f) (length l)))
test:
(sort-f '(8 4 6 5 3) >) ===> arity mismatch;
the expected number of arguments does not match the given number
expected: 1
given: 0
(sort-step l f) is not a function of one argument as compose expects, it's a list.
Since you probably want to "thread" the list through the composition, you need to compose a function that takes a list and returns a list.
You can get one by rearranging sort-step slightly into a curried function:
(define (sort-step f)
(lambda (l)
(cond ((null? l) '())
((null? (cdr l)) l)
((f (car l) (cadr l)) (cons (car l) ((sort-step f) (cdr l))))
(else (cons (cadr l) ((sort-step f) (cons (car l) (cddr l))))))))
Now (sort-step f) is a function from list to list and you can say
(define (sort-f l f)
((self-compose (sort-step f) (length l)) l))
The l param can also be thread by a lambda in the self-compose without rewriting sort-step:
(define (sort-f l f)
((self-compose (lambda (l) (sort-step l f)) (length l)) l))
I am getting "Error: Invalid lambda: (lambda (insert-all))."
(define permutations
(lambda (L)
(let
((insert-all
(lambda (e Ls)
(let
((insert-one
(lambda (L)
(letrec
((helper
(lambda(L R)
(if (null? R)
(list (append L(list e)R))
(helper (append L (list (car R) ) ) (cdr R) )
))))
(helper '() L)))))
(apply append(map insert-one Ls)))))))
(cond ((null? L) '() )
((null?(cdr L)) (list L))
(else (insert-all (car L) (permutations ((cdr L))))))))
It is supposed to return all permutations of a given list.
The form that you have provided in not valid scheme. Specifically, your highest-level let form does not have a body. You might be thinking that the cond clause is the body but owing to your parenthesis it is not part of the let. Honestly, this is the fault of your formatting. Here is a 'properly' formatted Scheme form:
(define (permutations L)
(let ((insert-all
(lambda (e Ls)
(let ((insert-one
(lambda (L)
(let helper ((L '()) (R L))
(if (null? R)
(list (append L (list e) R))
(helper (append L (list (car R)))
(cdr R)))))))
(apply append (map insert-one Ls))))))
(cond ((null? L) '())
((null? (cdr L)) (list L))
(else (insert-all (car L)
(permutations (cdr L)))))))
At least it compiles and runs, although it doesn't produce the right answer (although I don't know what the proper input it):
> (permutations '(a b c))
((c b a))
> (permutations '((a b) (1 2)))
(((1 2) (a b)))
Here is an implementation that works:
(define (permutations L)
(define (insert-all e Ls)
(apply append
(map (lambda (e)
(map (lambda (x) (cons e x)) Ls))
e)))
(cond ((null? L) '())
((null? (cdr L)) (map list (car L)))
(else (insert-all (car L)
(permutations (cdr L))))))
> (permutations '((a b) (1 2) (x y)))
((a 1 x) (a 1 y) (a 2 x) (a 2 y) (b 1 x) (b 1 y) (b 2 x) (b 2 y))
The basic structure of your code was fine; just the implementation of your insert-one and helper were lacking.
I'm trying to write a procedure that "encapsulates" (i.e. puts in a list) elements of a list between a "separator" element.
(my-proc '(1 + 2))
=> ((1) (2))
(my-proc '(x * y + z ^ 2 + 1 + 5))
=> ((x * y) (z ^ 2) (1) (5))
(my-proc '((x + 1) * y + 5))
=> (((x + 1) * y) (5))
In this case the procedure can be hard-coded to define the + symbol as the separator.
Assume that foldr (fold right operation) is defined, I'd prefer that it'd be in terms of it.
I'm not giving a full solution since this looks really homework-y.
(define (split-expr expr)
(foldr (lambda (e es)
(if (eq? e '+)
<???> ; do split
(cons (cons e (car es))
(cdr es))))
<???> ; what should start be?
es))
Just for fun, here's a version in continuation-passing style (no foldr, probably not suitable as a homework answer):
(define split/cps
(λ (sep ls)
(let loop ([ls ls] [k (λ (item acc)
(if item (cons item acc) acc))])
(cond
[(null? ls)
(k #f '())]
[(eq? sep (car ls))
(loop (cdr ls)
(λ (item acc)
(k #f (if item (cons item acc) acc))))]
[else
(loop (cdr ls)
(λ (item acc)
(k (if item
(cons (car ls) item)
(list (car ls)))
acc)))]))))
Here's another way to do it, also without foldr:
(define split/values
(λ (sep ls)
(let loop ([ls ls])
(cond
[(null? ls)
'()]
[else
(let-values ([(a d) (car-to-sep sep ls)])
(if (null? a)
(loop d)
(cons a (loop d))))]))))
(define car-to-sep
(λ (sep ls)
(let loop ([ls ls] [a '()])
(cond
[(null? ls)
(values '() '())]
[(eq? sep (car ls))
(values '() (cdr ls))]
[else
(let-values ([(a d) (loop (cdr ls) a)])
(values (cons (car ls) a) d))]))))
Although the following code works perfectly well in DrRacket environment, it generates the following error in WeScheme:
Inside a cond branch, I expect to see a question and an answer, but I see more than two things here.
at: line 15, column 4, in <definitions>
How do I fix this? The actual code is available at http://www.wescheme.org/view?publicId=gutsy-buddy-woken-smoke-wrest
(define (insert l n e)
(if (= 0 n)
(cons e l)
(cons (car l)
(insert (cdr l) (- n 1) e))))
(define (seq start end)
(if (= start end)
(list end)
(cons start (seq (+ start 1) end))))
(define (permute l)
(cond
[(null? l) '(())]
[else (define (silly1 p)
(define (silly2 n) (insert p n (car l)))
(map silly2 (seq 0 (length p))))
(apply append (map silly1 (permute (cdr l))))]))
Another option would be to restructure the code, extracting the inner definitions (which seem to be a problem for WeScheme) and passing around the missing parameters, like this:
(define (insert l n e)
(if (= 0 n)
(cons e l)
(cons (car l)
(insert (cdr l) (- n 1) e))))
(define (seq start end)
(if (= start end)
(list end)
(cons start (seq (+ start 1) end))))
(define (permute l)
(cond
[(null? l) '(())]
[else (apply append (map (lambda (p) (silly1 p l))
(permute (cdr l))))]))
(define (silly1 p l)
(map (lambda (n) (silly2 n p l))
(seq 0 (length p))))
(define (silly2 n p l)
(insert p n (car l)))
The above will work in pretty much any Scheme implementation I can think of, it's very basic, standard Scheme code.
Use local for internal definitions in the teaching languages.
If you post your question both here and at the mailing list,
remember to write you do so. If someone answers here, there
is no reason why persons on the mailing list should take
time to answer there.
(define (insert l n e)
(if (= 0 n)
(cons e l)
(cons (car l)
(insert (cdr l) (- n 1) e))))
(define (seq start end)
(if (= start end)
(list end)
(cons start (seq (+ start 1) end))))
(define (permute2 l)
(cond
[(null? l) '(())]
[else
(local [(define (silly1 p)
(local [(define (silly2 n) (insert p n (car l)))]
(map silly2 (seq 0 (length p)))))]
(apply append (map silly1 (permute2 (cdr l)))))]))
(permute2 '(3 2 1))
Okay this is my 4th question today on Scheme, still pretty new to Scheme, as I needed for one of my sub-function I asked earlier in the day.
Basically this will return me the difference of 2 lists. Say you've got (1,5) and (5,1) this function should return me 8. As that's the distance between l to w
Here is what I have. Note: if I change the (list (- (car l) (car w))) into (write ..... ) the function will work, but outputs 2 number which I have no idea how to use those number as inputs of my other function.
So I try to put it into list, but doesn't really work out, it returns me with no error but weird stuff
(define (difference l w) ; calc heuristic function estimation
(if (> (car l) (car w))
(list (- (car l) (car w)))
(if (< (car l) (car w))
(list (- (car w) (car l)))))
(if (< (list-ref l 1) (list-ref w 1))
(list (- (list-ref l 1) (list-ref w 1)))
(if (> (list-ref l 1) (list-ref w 1))
(list (- (list-ref w 1) (list-ref l 1)))))
)
Here is the code returned me
> (difference '(9 1) '(3 1))
#<procedure:...0\assigment 2.ss:50:3>
Any ideas? try to use lambda end-up the same thing.
Well first of all, there's a typo in your code...
(lits (- (car w) (car l)))))
should be...
(list (- (car w) (car l)))))
EDIT: Would something like this work?
(define (difference lst1 lst2)
(if (> (car lst1) (car lst2))
(+ (- (car lst1) (car lst2)) (difference (cdr lst1) (cdr lst2)))
(+ (- (car lst2) (car lst1)) (difference (cdr lst1) (cdr lst2))))
)
I know it's an old question, but I just wrote something like this. Here's my solution
(define (difference l1 l2)
(apply + (map abs (map - l1 l2))))