I want to read from stdin element by element but I don't know how to stop when I insert a new line.
Here is my code:
(define readNext
(lambda (tmp)
(let ([a (read)])
(if (equal? a ??????)
tmp
(readNext (cons (read) tmp))))))
I found a solution that works as I expected.
(define a (open-input-string (read-line)))
(define readNext
(lambda (tmp)
(let ([b (read a)])
(if (equal? b eof)
tmp
(readNext (append tmp (list b)))))))
(readNext '())
EDIT: It won't stop on newline but for eof
The function read will read an entire datum.
If you want to read characters until you hit newline,
you will have to one character at a time.
The newline character is written #\newline.
Something like this:
#lang racket
(define read-a-line-as-list
(lambda ()
(let ([c (read-char)])
(if (equal? c #\newline)
'()
(cons c (read-a-line-as-list))))))
(define read-a-line
(lambda ()
(list->string (read-a-line-as-list))))
(read-a-line)
I'm doing it like this
(for ((_ (in-naturals)))
(define l (read-line))
#:break (eof-object? l)
(displayln l))
might not be the most idiomatic, but it works. Use for/list or similar to do something more useful with the lines being read.
Related
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 am attempting to read and write a matrix from file "data.txt".
The matrix is lists with strings inside of them.
When I am writing I want to write from the begining an override the data. Basically I delete the file every time. I need bether solusion for this.
May main problem is that after a couple readings and writhings of the file corrupts.
system error: Access is denied.; errno=5
My code:
;reading file returning matix of strings
(define (file-reader file-name)
(define pointer (open-input-file file-name))
(define (helper line)
(cond
((equal? line eof) '())
((cons (list line) (helper (read-line pointer))))))
(list-matr (helper (read-line pointer)))
)
;converting matrix of string to matrix of lists with strings inside
(define (list-matr str-matr)
(define (helper str-matr line-num)
(cond
((null? str-matr) '())
((= line-num 1) (cons (map (lambda (x) (string-append x "?")) (string-split (caar str-matr) "? ")) (helper (cdr str-matr) (+ line-num 1))))
((cons (string-split (caar str-matr) " ") (helper (cdr str-matr) (+ line-num 1))))))
(helper str-matr 1))
;saving in file
(define (writer file-name questions answers)
(cond
((file-exists? file-name) (delete-file file-name)))
(write-to-file file-name (string-append (string-join questions) "\n"))
(define (helper cur-l ans)
(cond
((null? ans))
((helper (write-to-file file-name (string-append (string-join (car ans)) "\n")) (cdr ans)))))
(helper '() answers)
)
(define (write-to-file path string)
(call-with-output-file path #:exists 'append
(lambda (newline)
(display string newline))))
Commands for calling the functions.
(file-reader "data.txt")
(writer "data.txt" questions answers)
I think the problem coming from that I don't close the files, but I can't figure out where to put the command for that.
If my code is very bad you can give me other examples for reading and writing matrix from file.
Thank you.
You are correct that the file will corrupt - it's never properly closed.
Without overwriting the file each time, you will need something outside of the normal R5RS/R7RS-small specification, and I'm not aware off the top of my head of any (final) SRFI that allows random file access. That said, many/most Scheme implementations provide some form of low-level I/O interface. The disadvantage of such is that you will have to track the structure very carefully so as to overwrite or add only the correct amount, which will probably be more work than rewriting the entire file.
I would recommend restructuring this completely. First, the call-with-output-file/with-output-to-file procedures will automatically overwrite the output file unless flagged otherwise (in most implementations - though the specifications state that the behaviour is undefined). They will also automatically close the file upon completion. Similar behaviour for the call-with-input-file/with-input-from-file procedures.
You can probably simplify everything by something like the following:
; reader
; this could be further simplified by replacing the cons call with
; (cons (<parse-procedure> l) r), to parse the input at the same time
(define (matrix-read filename)
(with-input-from-file filename (lambda ()
(let loop ((l (read-line))
(r '()))
(if (eof-object? l)
(reverse r)
(loop (read-line) (cons l r))))))
; I don't understand the input/output format...
; writer
(define (matrix-write filename data)
(with-output-to-file filename (lambda ()
(for-each
(lambda (l)
; again, I don't know the actual structure outside of a list
(display l)
(newline))
data))))
If you explain the input format, I can modify the answer.
I'm trying to write a macro in racket/scheme that operates like a for loop across some arbitrary code such that the body of the loop is unrolled. For example, the following code
(macro-for ((i '(0 1 2 3))
(another-macro
(with i)
(some (nested i))
(arguments (in (it (a b c i))))))
should have the same result as if the code had been written as
(another-macro
(with 0)
(some (nested 0))
(arguments (in (it (a b c 0))))))
(another-macro
(with 1)
(some (nested 1))
(arguments (in (it (a b c 1))))))
(another-macro
(with 2)
(some (nested 2))
(arguments (in (it (a b c 2))))))
I've made an attempt of implementing it but I'm new to macros and they don't seem to work as I expect them to. Here's my attempt - which doesn't compile because match apparently is not allowed to be used within macros - but hopefully it conveys the idea I'm trying to achieve.
(module test racket
(require (for-syntax syntax/parse))
(begin-for-syntax
(define (my-for-replace search replace elem)
(if (list? elem)
(map (lambda (e) (my-for-replace search replace e)) elem)
(if (equal? elem search)
replace
elem))))
(define-syntax (my-for stx)
(syntax-case stx ()
((my-for args-stx body-stx)
(let ((args (syntax-e #'args-stx)))
(if (list? args)
(map (lambda (arg)
(match arg
((list #'var #'expr)
(my-for-replace #'var #'expr #'body))
(else
(raise-syntax-error #f
"my-for: bad variable clause"
stx
#'args))))
args)
(raise-syntax-error #f
"my-for: bad sequence binding clause"
stx
#'args))))))
(define-syntax (my-func stx)
(syntax-parse stx
((my-func body)
#'body)))
(my-for ((i '(0 1 2)))
(my-func (begin
(display i)
(newline))))
)
Here's how I would write that (if I were going to write something like that):
First, we need a helper function that substitutes in one syntax object wherever an identifier occurs in another syntax object. Note: never use syntax->datum on something that you intend to treat as an expression (or that contains expressions, or definitions, etc). Instead, recursively unwrap using syntax-e and after processing put it back together just like it was before:
(require (for-syntax racket/base))
(begin-for-syntax
;; syntax-substitute : Syntax Identifier Syntax -> Syntax
;; Replace id with replacement everywhere in stx.
(define (syntax-substitute stx id replacement)
(let loop ([stx stx])
(cond [(and (identifier? stx) (bound-identifier=? stx id))
replacement]
[(syntax? stx)
(datum->syntax stx (loop (syntax-e stx)) stx stx)]
;; Unwrapped data cases:
[(pair? stx)
(cons (loop (car stx)) (loop (cdr stx)))]
;; FIXME: also traverse vectors, etc?
[else stx]))))
Use bound-identifier=? when you're implementing a binding-like relationship, like substitution. (This is a rare case; usually free-identifier=? is the right comparison to use.)
Now the macro just interprets the for-clause, does the substitutions, and assembles the results. If you really want the list of terms to substitute to be a compile-time expression, use syntax-local-eval from racket/syntax.
(require (for-syntax racket/syntax))
(define-syntax (macro-for stx)
(syntax-case stx ()
[(_ ([i ct-sequence]) body)
(with-syntax ([(replaced-body ...)
(for/list ([replacement (syntax-local-eval #'ct-sequence)])
(syntax-substitute #'body #'i replacement))])
#'(begin replaced-body ...))]))
Here's an example use:
> (macro-for ([i '(1 2 3)]) (printf "The value of ~s is now ~s.\n" 'i i))
The value of 1 is now 1.
The value of 2 is now 2.
The value of 3 is now 3.
Notice that it replaces the occurrence of i under the quote, so you never see the symbol i in the output. Is that what you expect?
Disclaimer: This is not representative of typical Racket macros. It's generally a bad idea to go searching and replacing in unexpanded forms, and there are usually more idiomatic ways to achieve what you want.
If the for-loop is to be evaluated at compile-time, you can use the builtin for loop.
#lang racket/base
(require (for-syntax syntax/parse
racket/base)) ; for is in racket/base
(define-syntax (print-and-add stx)
(syntax-parse stx
[(_ (a ...))
; this runs at compile time
(for ([x (in-list (syntax->datum #'(a ...)))])
(displayln x))
; the macro expands to this:
#'(+ a ...)]))
(print-and-add (1 2 3 4 5))
Output:
1
2
3
4
5
15
UPDATE
Here is an updated version.
#lang racket
(require (for-syntax syntax/parse racket))
(define-syntax (macro-for stx)
(syntax-parse stx
[(_macro-for ((i (a ...))) body)
(define exprs (for/list ([x (syntax->list #'(a ...))])
#`(let-syntax ([i (λ (_) #'#,x)])
body)))
(with-syntax ([(expr ...) exprs])
#'(begin expr ...))]))
(macro-for ((i (1 2 3 4)))
(displayln i))
Output:
1
2
3
4
Ryan Culpepper's answer only supports use of one induction variable, so here's an extension which supports multiple induction variables:
(begin-for-syntax
;; syntax-substitute : Syntax Identifier Syntax -> Syntax
;; Replace id with replacement everywhere in stx.
(define (instr-syntax-substitute stx id replacement index)
(let loop ([stx stx])
(cond [(and (identifier? stx)
(bound-identifier=? stx id))
replacement]
[(syntax? stx)
(datum->syntax stx (loop (syntax-e stx)) stx stx)]
;; Special handling of (define-instruction id ...) case
[(and (pair? stx)
(syntax? (car stx))
(equal? (syntax-e (car stx)) 'define-instruction))
(let ((id-stx (car (cdr stx))))
(cons (loop (car stx))
(cons (datum->syntax id-stx
(string->symbol
(format "~a_~a"
(symbol->string
(syntax-e id-stx))
index))
id-stx
id-stx)
(loop (cdr (cdr stx))))))]
;; Unwrap list case
[(pair? stx)
(cons (loop (car stx)) (loop (cdr stx)))]
;; Do nothing
[else stx]))))
(begin-for-syntax
(define instr-iter-index 0)
(define (instr-iter-arg body arg argrest)
(let loop ([body body]
[arg arg]
[argrest argrest])
(let ([i (car (syntax-e arg))]
[ct-sequence (cadr (syntax-e arg))]
[replaced-bodies '()])
(for ([replacement (syntax-e ct-sequence)])
(let ([new-body (instr-syntax-substitute body
i
replacement
instr-iter-index)])
(if (null? argrest)
(begin
(set! replaced-bodies
(append replaced-bodies (list new-body)))
(set! instr-iter-index (+ instr-iter-index 1)))
(let* ([new-arg (car argrest)]
[new-argrest (cdr argrest)]
[new-bodies (loop new-body
new-arg
new-argrest)])
(set! replaced-bodies
(append replaced-bodies new-bodies))))))
replaced-bodies))))
(provide instr-for)
(define-syntax (instr-for stx)
(syntax-case stx ()
[(instr-for args body)
(with-syntax ([(replaced-body ...)
(let ([arg (car (syntax-e #'args))]
[argrest (cdr (syntax-e #'args))])
(instr-iter-arg #'body arg argrest))])
#'(begin replaced-body ...))]))
im trying to load a sxml file... i manage to do that in scheme. now i want to go through it using recursion and located items that i want. my code is like this,
(define file (read(open-input-file "test1.sxml")))
(define myfunc
(lambda (S)
(if (eq? "foo" (car S))
(display "found\n")
(display "not found\n")
)
(if (null? (cdr S))
(display "\n")
(myfunc(cdr S)))))
but it seems that it goes through only the first line of the sxml file. how can i make it go through all the file until the end?
1) You need to search through all of the sublists of the structure. Your code right now only looks at the top-most elements.
2) You usually don't want to have multiple statements in a row (like your two if statements)
3) You probably want to look for symbols, not strings, in your SXML file. Regardless, you must use equal? to compare strings.
Thus, your function becomes
(define myfunc
(lambda (S)
(cond
((null? S) #f)
((pair? (car S)) (or (myfunc (car S)) (myfunc (cdr S)))) ; search on sublists
((equal? "foo" (car S)) #t) ; if found, return true
(else (myfunc (cdr S))))))
(define (read-all-input)
(local ((define line (bytes->list (read-bytes 4))))
(if (eof-object? line)
empty
(cons line (read-all-input)))))
(void (read-all-input))
The above code fails because bytes->list expects an argument of type byte string, but is given #
#lang scheme
(define (read-all-input)
(let ((b (read-bytes 4)))
(cond
((eof-object? b) empty)
(else (cons b (read-all-input)))
)))
(void (read-all-input))
This function reads bytes into a list of bytes.
I'm not really sure what you want to obtain but this here's my try:
(define read-all-input
(lambda ()
(let ((line (read-bytes 4)))
(if (eof-object? line)
'()
(cons (bytes->list line) (read-all-input))))))