I'm learning Scheme. I want to build script-fu filters for Gimp, so I was using tinyscheme to execute the scripts I made, but it seems like tinyscheme has a very limited set of functions, functions like max, min and even?, are missing. (I'd like someone to prove me wrong here :( )
Ok, actually, I just want to execute a Scheme script with scheme48. How do I do that?
for example, how do I execute the following file with scheme48?
(define (addx inNum inX)
(if (> (* inNum inX) 999) 0
(+ (* inNum inX) (addx inNum (+ 1 inX)))))
(display
(- (+ (addx 3 1) (addx 5 1)) (addx 15 1)))
I also was not able to run a scheme-script with scheme48 successfully (and I couldn’t find a hint in the manual yet). You may alternatively use Guile (assuming, you are working on linux or something like that):
#!/usr/local/bin/guile -s
!#
(define (addx in-num in-x)
(if (> (* in-num in-x) 999)
0
(+ (* in-num in-x) (addx in-num (+ 1 in-x)))))
(display (- (+ (addx 3 1) (addx 5 1)) (addx 15 1)))
(newline)
Save it and then run:
$chmod u+x test.scm
./test.scm
233168
$
(by the way: Please don’t format Scheme like C).
EDIT
According to a post of Mike Sperber on the Scheme48 mailing list, shebanging will not work. Explicitely invoking Scheme48 is to be done this way:
#!/bin/bash
scheme48 -a batch << EOF
(letrec ((fac (lambda (n)
(if (= n 1)
1
(* n (fac (- n 1)))))))
(fac 5))
EOF
$ ./test.scm
120
Related
is there a way too convert a list like this into a normal string?
list->string does not work because it isn't a list of chars.
It is a bit problematic because the list consists of symbols and numbers :/
(list + 4 * 5 - 3 6) //-> "+4*5-36"
Standard Scheme
For numbers:
(number->string 123 10) ; ==> "123"
For symbols:
(symbol->string 'test) ; ==> "test"
So you can check what type it is and use the correct procedure to convert to string. You can use string-append so join more strings together.
(string-append (symbol->string '+)
(number->string 4)
(symbol->string '*)
(number->string 5)
(symbol->string '-)
(number->string 3)
(number->string 6))
; ==> "+4*5-36"
If you make a procedure any->string you can make a one level list to string like this with SRFI-1:
(foldr (lambda (e a) (string-append (any->string e) a))
""
'(+ 4 * 5 - 3 6))
; ==> "+4*5-36"
Racket
Racket has format. If you do (format "~a" data) it will produce a string:
(format "~a" '(+ 4 * 5 - 3 6))
; ==> "(+ 4 * 5 - 3 6)"
Note that the first element of (list + 4 * 5 - 3 6) isn't the symbol + since the variable + gets evaluated to a procedure that adds stuff. eg. (+ 3 4) ; ==> 7 and + ; ==> #<procedure:+> (in racket; implementation specific)
I will show you in mit-scheme:
(define input '(+ 4 * 5 - 3 6))
(fold-right (lambda (x acc)
(string-append ((cond ((number? x) number->string )
((symbol? x) symbol->string ))
(else (error "unknown case" x))
x)
acc))
""
input)
Example:
1 ]=>
(define input '(+ 4 * 5 - 3 6))
;Value: input
...
;Value: "+4*5-36"
In case the list contains more kind of symbolic expressions, apart from numbers and symbols, you extend the cond-statement with other cases.
Also, do not forget to quote the input, otherwise + gets evaluated to a strange value.
I am currently using Dr Racket to do the programming and the task that I am required to do is to give a prompt to a user for an input file. Using the integer values in the input file, the program will execute two functions (two-lhs and two-rhs) that calculates sum of N squares, and output the result to a prompted output file; having the value from two-lhs to be listed on the left side and the value from two-rhs on the right side.
For example: suppose there is a file named 'data' in the directory where line one has the integer 25 and line two has 7, and line three has 9. User that inputs 'data' as an input file and 'testing' as an output file, the output file named 'testing' will be created in the directory with following values and format:
(results from two-lhs) (results from two-rhs)
5525 5525
140 140
285 285
This is my current code with comments of my understanding:
#lang racket
(define squared ;helper function for two lhs
(lambda (x) (* x x)))
(define Two-LHS
(lambda (n)
(cond((= n 0) 0)
(else
(+ (squared n) (Two-LHS(- n 1)))))))
(define Two-RHS
(lambda (n)
(cond ((= n 0) 0)
(else
(/ (* n (+ n 1) (+ (* n 2) 1)) 6)))))
(define in ;function that reads in the input file from user
(lambda ()
(let((pin(open-input-file (symbol->string (read))))) ;prompts the user for input file. pin = the input-port
(let f ((x(read pin))) ;f is a procedure that reads the input port?
(if(eof-object? x) ; x reads the value inside pin and if x happens to be end of file object
(begin ; then closes the input-port
(close-input-port pin)
'())
(cons (Two-LHS x)(cons (Two-RHS x)(f(read pin))))) ;else using the x, executes two lhs and rhs until x reaches
)))) ; end of file to close the port
(define write-lst
(lambda (lst outp) ;lst = input file, outp = output file
(if(eq? lst '()) ; if input file contains an empty list
(close-output-port outp) ; the output-port will be closed
(begin ; else execute begin
(write (car lst) outp) ; which writes the first element of the list to the output file
(display #\space outp) ; will add whitespace after each element to the output file.
(newline outp) ; was thinking this would add newline on the output file after each iteration, but need a way to add newline after every 2 whitespace.
(write-lst (cdr lst) outp))))) ;recurses back to write-lst function with the next element in the list without
;the first element until it becomes an empty list so that output-port could close.
(define out ;will be renamed to two-sum, since this is the function that will write to the output file.
(lambda (lst) ;lst = input file
(let((pout(open-output-file (symbol->string (read))))) ; prompts the user for the output file, pout = the output-port
(write-lst lst pout); uses write-list function to write out to output file
)))
(out (in))
The output file I get running my code is:
5525
5525
140
140
285
285
How can I make the output file to be formatted correctly?
Any help in the right direction would be extremely appreciated!
Thank you.
We can levarage Racket's fprintf procedure to make things easier, and iterate over the list two elements at a time - assuming that it has an even number of elements:
(define write-lst
(lambda (lst outp)
(if (null? lst)
(close-output-port outp)
(begin
(fprintf outp "~a ~a~n" (car lst) (cadr lst))
(write-lst (cddr lst) outp)))))
The trick is here, in the format string: "~a ~a~n". It states: print an object, a whitespace, another object and a new line. And we pass the current element (car lst) and the second element (cadr lst) - in fact, we could just use the first and second procedures, which are easier to understand. Finally, in the recursion we advance two elements: (cddr lst).
We are trying to implement a Draft Sight/AutoCad script that will transform a SVG file into a CAD drawing.
The principal idea is to read the file line by line (performed by ReadSVGData), split the svg definitions by spaces (ReadHTMLItemData), read the individual HTML attributes into a list and based on the type of the SVG item draw a CAD element. So much in regards to the principal...
The unususal part is, that whenever the Html Attributes, like "id="Box_8_0"" are sent to the findchar function, by attrlis function, the script fails, although the same arrangement went well before
Does anybody have a hint where my mistake is hidden?
(defun findchar (FindChar Text)
(setq
;current location in string
coord 1
;Init Return Coordinate
ReturnCoord 0
;Length of Searched Item, to enable string searching
FindCharLen (strlen FindChar)
;Nil Count: Requires as regular expressions like (/t) are identified as two times ascii char 9
NilCnt 0
;Storage of last Char Ascii to identify regular expressions
LastCharAsci -1
)
;iterate the String and break in case of the first occurence
(while (and (<= coord (strlen Text) ) (= ReturnCoord 0))
;Current Character
(setq CurChar (substr Text coord FindCharLen))
;Find Searched String
(if (= FindChar CurChar)
(setq ReturnCoord coord)
)
;Check for regular expression
(if (and (= LastCharAsci 9) (= (ascii CurChar) 9))
(setq NilCnt (+ NilCnt 1))
)
;Update String position and String
(setq LastCharAsci (ascii CurChar))
(setq coord (+ coord 1))
)
;return variable
(- ReturnCoord NilCnt)
)
(defun attrlis (HTMLAttr)
(setq Koordi 0)
(progn
(setq CharLoc (findchar "<" HTMLAttr))
(princ HTMLAttr)
(terpri)
)
(+ Koordi 1)
)
(defun ReadHTMLItemData(HTMLItem)
(setq
coord 1
HTMLItmBgn 1
Attributes 0
CurChar 0
Dictionary 0
)
;(princ HTMLItem)
;(terpri)
(while (<= coord (strlen HTMLItem))
(setq CurChar (substr HTMLItem coord 1))
(if (or (= (ascii CurChar) 32) (= (ascii CurChar) 62))
(progn
(if (> (- coord HTMLItmBgn) 0)
(progn
(setq htmlattr (substr HTMLItem HTMLItmBgn (- coord HTMLItmBgn)))
(setq Result (attrlis htmlattr))
(princ Result)
(setq HTMLItmBgn (+ coord 1))
)
)
)
)
(setq coord (+ coord 1))
)
)
(defun ReadLineContents(Line)
(if (/= Line nil)
(progn
;(princ Line)
;(terpri)
(setq
Bgn (findchar "<" Line)
End (findchar ">" Line)
ItemDef (substr Line (+ Bgn (strlen "<")) End)
)
(ReadHTMLItemData ItemDef)
)
)
)
(defun C:ReadSVGData()
(setq SVGFile (open (getfiled "Select a file" "" "svg" 0) "r"))
(setq Line 1)
(while (/= Line nil)
(setq Line (read-line SVGFile))
(ReadLineContents Line)
)
(close SVGFile)
(princ "Done")
)
Reading the following file:
<svg class="boxview" id="boxview" style="width:1198.56px; height:486.8004px; display:block;" viewBox="0 0 1198.56 486.8004">
<g id="BD_box">
<rect class="box" id="Box_8_0" x="109.21" y="394.119" width="58.512" height="62.184" box="4047"></rect>
</g>
</svg>
EDIT
Change of substring Index, based on satraj's answer
The problem lies in the way the "substr" Autolisp function is used. The start index of substr always starts from index 1 (not from 0). So your code must be changed such that the start index are initialized as 1. The following lines in your code fails.
(setq CurChar (substr HTMLItem coord 1))
(setq htmlattr (substr HTMLItem HTMLItmBgn (- coord HTMLItmBgn)))
Since coord and HTMLItemBgn variables are initialized as 0, the substr function fails.
Also, why not use "vl-string-search" function if you want to find the position of a text in a string? you can get rid of the findchar function.
An Example:
(setq CharLoc (vl-string-search "<" HTMLAttr))
In general, if you want to debug failures in AutoLisp, add the following function to your lisp file and it will print a stack trace in case of failures, which will enable you to locate exact place where the error occured.
(defun *error* (msg)
(vl-bt)
)
This question is divided into two parts.
Part one:
I run this ...
1 (handler-case (posix:kill 1 0)
2 (error (the-condition) (prin1 (type-of the-condition)) (terpri)
3 (princ the-condition) (terpri)))
... and get this output:
SYSTEM::SIMPLE-OS-ERROR
UNIX error 1 (EPERM): Operation not permitted
I can use #'princ-to-string and parse the string to get the error number. But is there a more direct way to retrieve errno? Something like #'file-error-pathname, but for errno instead?
Part two:
Where in the documentation could I have found the answer to Part one?
Released version
The released version 2.49 does not have an accessor for the errno.
You can get it, however, thusly:
[4]> (setq c (nth-value 1 (ignore-errors (posix:kill 1 0))))
#<SYSTEM::SIMPLE-OS-ERROR #x00000002002634A1>
[5]> (describe c)
#<SYSTEM::SIMPLE-OS-ERROR #x000000020021AF69> is an instance of the CLOS class #1=#<STANDARD-CLASS SYSTEM::SIMPLE-OS-ERROR>.
Slots:
SYSTEM::$FORMAT-CONTROL =
"UNIX error ~S (EPERM): Operation not permitted
"
SYSTEM::$FORMAT-ARGUMENTS = (1)
"UNIX error ~S (EPERM): Operation not permitted
" is a simple 1 dimensional array (vector) of CHARACTERs, of size 47 (a ISO-8859-1 string).
(1) is a list of length 1.
[6]> (car (slot-value c 'SYSTEM::$FORMAT-ARGUMENTS))
1
Development version
The dev version in the tip of the mercurial repo has os-error instead:
[1]> (setq c (nth-value 1 (ignore-errors (posix:kill 1 0))))
#<OS-ERROR #x0000000200253301>
[2]> (describe c)
#<OS-ERROR #x0000000200253301> is an instance of the CLOS class #1=#<STANDARD-CLASS OS-ERROR>.
Slots:
SYSTEM::$CODE = 1
1 is an integer, uses 1 bit, is represented as a fixnum.
[6]> (apropos "os-error")
OS-ERROR class
OS-ERROR-CODE function
EXT::OS-ERROR-CODE-1
[10]> (os-error-code c)
1
Given that:
(define output "")
or that
(define output "goodInput")
When I run those defines in my code, I get:
ERROR: In procedure memoization:
ERROR: Bad define placement (define output "").
Why is that ?
EDIT:
; Formal function of the code
(define (double->sum myString)
(define myVector 0)
(set! myVector (breaking myString))
(define output "")
(define returnValue (checkLegit myVector)) ; check the number of legitimate characters ,they need to be either numbers or "."
(define flag 0)
(if (not(= returnValue (vector-length myVector))) (set! output "Input error") (set! flag (+ flag 1)))
(define i 0) ; the length of the vector
(define count 0) ; the value of all the numbers in the vector
(if
(= flag 1)
(do ()
((= i (vector-length myVector))) ; run until the end of the vector
(cond
((char=? (vector-ref myVector i) #\.) ; check if we found a dot
(set! output (appending output count)) (set! output (appendingStrings output ".")) (set! count 0)
)
(else (set! count (+ count (char->integer(vector-ref myVector i)) )) (set! count (- count 48))
); end of else
) ; end of cond
(set! i (+ i 1)) ; inc "i" by 1
); end of do
) ; end do
; if flag = 1 , then the input is in a correct form
(if (= flag 1) (set! output (appending output count)))
(if (= flag 1)
output
"Input error")
) ; END
The problem is not in the string definition itself (there are no strange characters, or anything like that), it's in the place within the code where that definition is happening: you're inside a procedure, and the last line in a procedure can not be a define. Try returning something after the definition and it should work fine.
I guess that you've just started writing the procedure, just keep going after the define and write the rest of the code. For the time being, use a placeholder value at the end, so the interpreter won't complain:
(define (double->sum myString)
(define myVector 0)
(set! myVector (breaking myString))
(define output "")
'ok)
Also a matter of style - although it's ok to define-and-set a variable like that, it's more idiomatic to use a let expression for defining local variables. This is what I mean:
(define (double->sum myString)
(let ((myVector (breaking myString))
(output ""))
'ok))
In that way, you won't have to use set!, which mutates the variable and goes against the functional-programming style preferred in Scheme.