trouble recognizing \ as a character - scheme

I'm making a syntax analyzer for school that reads a c++ test file in scheme and outputs another in html with the program now colored based on their id. However, I'm having trouble with it recognizing the \ as a character. The teacher said we don't have to worry about respecting the formatting, so line breaks and indents aren't necessary. Here is my code as well as the test file:
#lang racket
(require 2htdp/batch-io)
;shortcuts
(define htmlformat "<!DOCTYPE html> <html> <head> <link rel='stylesheet' href='styles.css'> <title>output.html</title> </head> <body>")
(define htmlformat2 "</body> </html>")
(define number "<span class='number'>")
(define specials "<span class='special'>")
(define ids "<span class='identifier'>")
(define reserved "<span class='reserved'>")
(define comments "<span class='comment'>")
(define libraries "<span class='library'>")
(define endspan "</span>")
;opens input file
(define infile "test.cpp")
;read input file
;char by char
(define file->list-of-chars
(lambda (filename)
(flatten
(map string->list
(read-1strings filename)))))
;char to strings, shows up in reverse order
(define list-of-chars->list-of-strings
(lambda (loc aux result)
(cond
[(empty? loc) result]
[(char-whitespace? (car loc))
(list-of-chars->list-of-strings (cdr loc)
'()
(cons
(list->string aux)
result))]
[(char-punctuation? (car loc))
(list-of-chars->list-of-strings (cdr loc)
'()
(cons
(list->string
(cons (car loc) '()))
(cons
(list->string aux)
result)))]
[else
(list-of-chars->list-of-strings (cdr loc)
(append aux (cons (car loc) '()))
result)])))
; char to list of strings, shows up in corret order
(define file->list-of-strings
(lambda (filename)
(reverse
(list-of-chars->list-of-strings
(file->list-of-chars infile) '() '()))))
(define lst (file->list-of-strings infile))
;regex matching
(define match
(λ (strng)
(cond
[(regexp-match #rx"^[+-]?([0-9]+\\.?[0-9]*|\\.[0-9]+)$" strng) (string-append number strng endspan)]
[(equal? strng "<iostream>") (string-append libraries "<" endspan libraries "iostream" endspan libraries ">" endspan)]
[(regexp-match #rx"^\\<(.)+\\>$" strng) (string-append libraries "strng" endspan)]
[(regexp-match #rx"^(asm|double|new|switch|auto|else|operator|template|break|enum|private|this|case|extern|printf|protected|throw|catch|float|public|try|char|for|register|typedef|class|friend|return|union|const|goto|short|unsigned|continue|if|signed|virtual|default|inline|sizeof|void|delete|int|static|volatile|do|long|struct|while)+$" strng) (string-append reserved strng endspan)]
[(regexp-match #rx"^([A-Z]|[a-z]|\\_)(.)*$" strng) (string-append ids strng endspan)]
[(regexp-match #rx"^(\\#|\\[|\\]|\\{|\\}|\\+|\\-|\\/|\\<|\\>|\\<=|\\>=|\\=|\\(|\\)|\\*|\\'|\\;|\\!|\\$|\\%|\\^|\\&|\\?|\"|\\||,)$" strng) (string-append specials strng endspan)]
[(regexp-match #rx"^\\//(.)*$" strng) (string-append comments strng endspan)]
[else ""])))
;applies match to all elements of a list of strings
(define mapp
(λ (lst)
(cond
[(null? lst) '()]
[else (cons (match (car lst))(mapp (cdr lst)))])))
;assigns html format to list of strings
(define htmlList (mapp lst))
; list of strings to single string
(define list-of-strings->string
(lambda (strlst)
(string-join strlst " ")))
;; usage example
;; (define strlst (file->list-of-strings input-filename))
;; (list-of-strings->string strlst)
; converts list of strings to a single string
(define singlestring (list-of-strings->string htmlList))
;creates output file
(define outfile "output.html")
;creates single string adding html header and footer
(define finalstring (string-append htmlformat singlestring htmlformat2))
;writes everything into output file
(write-file outfile finalstring)
test code:
#include <iostream>
int main(int argc, char *argv[])
{
int i = 0;
for (i = 0; i < 10; i++)
{
printf("%i", i);
}
printf("\n");
return 0;
}

Use
[(char-whitespace? (car loc))
...]
[(eqv? (car loc) #\\)
...]
to recognize backslash.
Note: #\a means the character a and thus #\\ means the character \.

What do you mean "recognize \"?
You can "escape the escape code" by using "\\"
printf("\\");
That should print "\".
If you want to print 2, you can do printf("\\\\")... it goes on.
Other than that, I don't understand your question.

Related

Why do I get "application: not a procedure" with this for loop in Racket?

The following code reads a csv file and based on its content generates a Prolog program:
#!/usr/bin/env racket
#lang racket/base
(define (overwrite-s-to-f fname s); Will create fname and write overwriting the previous content.
(with-output-to-file #:exists 'truncate fname (lambda () (displayln s))))
(define (c-o-a-line-to-f fname s); Will append a string to fname or create it if does not exist. Appends a new line.
(with-output-to-file #:exists 'append fname (lambda () (displayln s))));
(define fname "women.csv")
(define pl-fname "females-by-Racket.pl")
(require racket/file)
(define content (file->lines fname))
(define disc-line (string-append ":-discontiguous(" (string-replace (car content) "Name," "") ").\n"))
(overwrite-s-to-f pl-fname disc-line)
(define list-of-verbs (string-split (string-replace (car content) "Name," "") ","))
(require racket/string racket/system)
(for ((row content));content is a list of strings
(let ((list-of-cs (string-split row ",")))
(when (equal? (car (cdr list-of-cs)) "+")
(displayln row)(let ((cmd (string-append "awesome("(car list-of-cs)").")))(c-o-a-line-to-f pl-fname cmd)(displayln cmd)))
(when (equal? (car (cdr (cdr list-of-cs))) "+")(displayln row)(let ((cmd (string-append "and_intelligent("(car list-of-cs)").")))
(c-o-a-line-to-f pl-fname cmd)(displayln cmd))))); TODO: when for each columns 2-last of women.csv
The content of women.csv:
Name,awesome,and_intelligent,performed_once,extreme1,extreme2,extreme3,extreme4,donkey_thing,dark_eyes,pigmented_face,pigmented_genitals,bleached,had_no_surgeries,has_augmented_breasts
adriana_chechik,+,,,+,?,+,+,,-,,,,,
alysa_gap,+,,,,?,+,+,,-,,,,,
anna_de_ville,+,,,,,+,+,,+,-,+,-,-,
aurora_jolie,+,+,,,,,,,+,+,+,,+,
autumn_falls,,,,,,,,,+,+,-,+,+,
casey_calvert,+,,,,,,,,+,+,+,,,
dahlia_sky,+,,,,,,+,,,,,,,
dominica_lito,+,,,,,,+,,,,,,,
ella_knox,,,,,,,,,+,+,+,,+,
isabella_clark,+,,,,,,+,,,,,,,
jade_kush,,,,,,,,,+,+,,,+,
juelz_ventura,+,,,,,+,,,-,-,,,-,+
kapri_styles,,,,,,,,,+,,+,,,
kristina_milan,,,,,,,,,+,+,,,+,
kylie_sinner,+,+,,,,,,,+,,,,-,
leigh_raven,+,,,,,+,,,+,+,,,,
maserati,,,,,,,,,+,+,,,+,
miosotis,,,,,,,,,+,+,,,+,
scarlett_bloom,,,,,,,,,+,+,+,,-,
sheena_shaw,,,,,,,,,-,,+,,-,
sofia_rose,,,,,,,,,+,,,,+,
teanna_trump,+,,,,,,,,+,,+,,,
veronica_avluv,+,,,,,,+,,,,,,,
yudi_pineda,+,,,,,,,,+,+,,,,
females-by-Racket.pl is to look like so:
:-discontiguous(awesome,and_intelligent,performed_once,extreme1,extreme2,extreme3,extreme4,donkey_thing,dark_eyes,pigmented_face,pigmented_genitals,bleached,had_no_surgeries,has_augmented_breasts).
awesome(adriana_chechik).
awesome(alysa_gap).
awesome(anna_de_ville).
awesome(aurora_jolie).
and_intelligent(aurora_jolie).
awesome(casey_calvert).
awesome(dahlia_sky).
awesome(dominica_lito).
awesome(isabella_clark).
awesome(juelz_ventura).
awesome(kylie_sinner).
and_intelligent(kylie_sinner).
awesome(leigh_raven).
awesome(teanna_trump).
awesome(veronica_avluv).
awesome(yudi_pineda).
but with more predicates (up to n-1 for each woman where n is the number of columns in women.csv)
The names of the columns or the numbers thereof in women.csv are likely to be frequently changed.
That is partly why I wish to avoid manually coding for every when. The other concerns are the sheer amount of the lines to code (15 whens for each column) and the risk of error/typo.
Is it doable to loop through every cell in list-of-cs in such way that it is taken from list-of-verbs?
I've tried this but to no avail (the comment show the error message that I got):
(for ((row content))
(let ((list-of-cs (cdr (string-split row ","))))
(for ((cell list-of-cs))
; application: not a procedure; expected a procedure
; that can be applied to arguments
(set! list-of-verbs (cdr (list-of-verbs)))
(let ((verb (car list-of-verbs)))
(when (equal? cell "+")
(displayln row)
(let ((cmd (string-append verb "(" (car row) ").")))
(c-o-a-line-to-f pl-fname cmd)))
))))
named let is a useful form to be familiar with:
#lang scheme
(define (csv->attributes rows) ;; ListOfString -> ListOfString
;; produce "column-header(row-name)" for "+" entries in csv (see example)
(let ([fields (string-split (car rows) ",")])
(let next-row ([rows (cdr rows)] [result (list)])
(cond
[(null? rows) (reverse result) ]
[else
(let* ([cells (string-split (car rows) ",")]
[name (car cells)])
(let next-cell ([cells (cdr cells)] [fields (cdr fields)] [result result])
(cond
[(null? cells) (next-row (cdr rows) result) ]
[else (next-cell
(cdr cells) (cdr fields)
(if (string=? (car cells) "+")
(cons (string-append (car fields) "(" name ")") result)
result)) ]))) ]))))
(define trio '("Name,fast,slow,sidles"
"Achilles,+,,"
"Tortoise,,+,"
"Crab,,+,+"))
Welcome to DrRacket, version 8.5 [cs].
Language: scheme, with debugging.
> (csv->attributes trio)
("fast(Achilles)" "slow(Tortoise)" "slow(Crab)" "sidles(Crab)")
>

Racket: how to sort dot-separated numbers

How does one sort dot-separates numbers, like version numbers of software, in Racket?
For example
'("1.1.2" "1.0.0" "1.3.3" "1.0.7" "1.0.2")
sorted into
'("1.0.0" "1.0.2" "1.0.7" "1.1.2" "1.3.3")
Split each string up on #\. and turn it into a list of numbers, and sort based on that transformation. Example using SRFI-67 to compare lists:
#lang racket
(require srfi/67)
(define versions '("1.1.2" "1.0.0" "1.12.1" "1.3.3" "1.0.7" "1.0.2"))
(define (sort-versions vlst)
(sort vlst (lambda (a b) (< (list-compare integer-compare a b) 0))
#:key (lambda (v) (map string->number (string-split v ".")))
#:cache-keys? #t))
(writeln (sort-versions versions))
Plain Scheme from scratch:
;; Convert a character into a number
;; Example: (char->number #\3) => 3
(define (char->number char)
(case char
((#\0) 0)
((#\1) 1)
((#\2) 2)
((#\3) 3)
((#\4) 4)
((#\5) 5)
((#\6) 6)
((#\7) 7)
((#\8) 8)
((#\9) 9)))
;; Convert a list of characters into a decimal number.
;; Example: (list->decimal '(#\1 #\2 #\3)) => 123
(define (list->decimal digits)
(let loop ((digits digits)
(value 0))
(if (pair? digits)
(loop (cdr digits)
(+ (* value 10)
(char->number (car digits))))
value)))
;; Convert a version string into list of decimals.
;; Example: (version->list "1.2.3") => (1 2 3)
(define (version->list version)
(let loop ((chars (string->list version))
(fragment '())
(result '()))
(if (pair? chars)
(let ((char (car chars))
(chars (cdr chars)))
(if (char=? char #\.)
(loop chars
'()
(cons (list->decimal fragment)
result))
(loop chars
(cons char fragment)
result)))
(reverse (cons (list->decimal fragment)
result)))))
;; Convert a list of version numbers into a string.
;; Example: (list->version '(1 2 3)) => "1.2.3"
(define (list->version numbers)
(let loop ((numbers numbers)
(result "")
(delimiter ""))
(if (pair? numbers)
(loop (cdr numbers)
(string-append result
delimiter
(number->string (car numbers)))
".")
result)))
;; Check if a version is lower than the other.
;; Example: (version<? '(1 2 3) '(1 2)) => #f
(define (version<? v1 v2)
(if (pair? v1)
(if (pair? v2)
(let ((m1 (car v1))
(m2 (car v2)))
(cond
((< m1 m2) #t)
((> m1 m2) #f)
(else (version<? (cdr v1)
(cdr v2)))))
#f)
(if (pair? v2)
#t
#f)))
;; Sort versions.
(define (sort-versions versions)
(map list->version
(sort version<?
(map version->list versions))))
;; Example
(let ((unsorted '("1.1.2" "1.0.0" "1.3.3" "1.0.7" "1.0.2"))
(sorted '("1.0.0" "1.0.2" "1.0.7" "1.1.2" "1.3.3")))
(equal? (sort-versions unsorted)
sorted))
The above converts all version strings into lists of decimals, sorts the list and converts the lists of decimals back into strings. The last step can be avoided as explained in Shawn's answer. This makes it necessary to preserve the original version string while sorting the versions. This is possible by boxing both representations of the version. The comparison has to unbox the list representation. The result is created by unboxing the string representation. The following shows this alternative implementation.
;; Convert a character into a number
;; Example: (char->number #\3) => 3
(define (char->number char)
(case char
((#\0) 0)
((#\1) 1)
((#\2) 2)
((#\3) 3)
((#\4) 4)
((#\5) 5)
((#\6) 6)
((#\7) 7)
((#\8) 8)
((#\9) 9)))
;; Convert a list of characters into a decimal number.
;; Example: (list->decimal '(#\1 #\2 #\3)) => 123
(define (list->decimal digits)
(let loop ((digits digits)
(value 0))
(if (pair? digits)
(loop (cdr digits)
(+ (* value 10)
(char->number (car digits))))
value)))
;; Convert a version string into list of decimals.
;; Example: (version->list "1.2.3") => ("1.2.3" 1 2 3)
(define (version->list version)
(let loop ((chars (string->list version))
(fragment '())
(result '()))
(if (pair? chars)
(let ((char (car chars))
(chars (cdr chars)))
(if (char=? char #\.)
(loop chars
'()
(cons (list->decimal fragment)
result))
(loop chars
(cons char fragment)
result)))
(cons version
(reverse (cons (list->decimal fragment)
result))))))
;; Convert a list of version numbers into a string.
;; Example: (list->version '("1.2.3" 1 2 3)) => "1.2.3"
(define list->version car)
;; Check if a version is lower than the other.
;; Example: (version<? '("1.2.3" 1 2 3) '("1.2" 1 2)) => #f
(define (version<? v1 v2)
(let loop ((v1 (cdr v1))
(v2 (cdr v2)))
(if (pair? v1)
(if (pair? v2)
(let ((m1 (car v1))
(m2 (car v2)))
(cond
((< m1 m2) #t)
((> m1 m2) #f)
(else (loop (cdr v1)
(cdr v2)))))
#f)
(if (pair? v2)
#t
#f))))
;; Sort versions.
(define (sort-versions versions)
(map list->version
(sort version<?
(map version->list versions))))
;; Example
(let ((unsorted '("1.1.2" "1.0.0" "1.3.3" "1.0.7" "1.0.2"))
(sorted '("1.0.0" "1.0.2" "1.0.7" "1.1.2" "1.3.3")))
(equal? (sort-versions unsorted)
sorted))
You can convert each string "X.Y.Z" into a number, sort the list of numbers, and convert the numbers back to strings. You can use lots of ideas of encoding X.Y.Z as a number, for example, Goedel's encoding, chinese remainder theorem, etc, etc.

Replacing a String in a List in Racket

I am trying to replace a string in the list with another given string, using abstract list functions and lambda only.
The function consumes lst, a list of strings, str, the string you are replacing, and rep, the string you are replacing str with.
Here is an example:
(replace (list "hi" "how" "are" "you") "hi" "bye") -> (list "bye" "how" "are" "you")
Written below is the code that I wrote in recursion and it works.
(define (replace lst str rep)
(cond [(empty? lst) empty]
[(equal? match (first lst))
(cons rep (replace-all (rest lst) match rep))]
[else (cons (first lst) (replace-all (rest lst) match rep))]))
Below that code is what I have tried but I'm not sure how to fix it to make it produce what I want.
(define (replace lst str rep)
(map (lambda (x) (string=? x str)) lst))
Any and all help is appreciated, thanks!
Almost there! you just have to ask, for each string: is this the one I want to replace? then replace it - otherwise leave it untouched:
(define (replace lst str rep)
(map (lambda (x) (if (string=? x str) rep x))
lst))

Call of non procedure <#unspecific>

I'm trying to convert sexps to xml, I have a recursive function that goes through a list representing an xml tag and its child tags, and then prints them to the standard output with correct indentation.
I'm using the chicken scheme compiler.
source:
(use srfi-13)
(use extras)
;Returns the length of a list
(define (len lst)
(define (len-help lst count)
(cond ((not (eq? lst '())) (len-help (cdr lst) (+ count 1)))
(else count)))
(len-help lst 0))
(define (const-l fil len)
;makes a constant list of symbol fil len times
(cond ((> len 0) (cons fil (const-l fil (- len 1))))
(else '())))
;makes a string out of a list of tag attribute strings
(define (make-attribute-string tag-atribs)
(cond ((eq? tag-atribs '()) "")
(else (string-join tag-atribs " "))))
(define (indent num)
(string-join (const-l " " num) ""))
;makes a tag structure from args
;tag-name is a symbol
;tag-attribs is a lis of tag attribute strings
;i.e.: '("att1='val1'" "att2='val2'")
(define (make-tag tag-label tag-atribs tag-elements)
`(,tag-label ,(make-attribute-string tag-atribs) ,tag-elements))
(define (tag-name tag)
(car tag))
(define (tag-atribs tag)
(cadr tag))
(define (tag-elems tag)
(caddr tag))
(define (print-tag tag close ind)
(cond ((eq? close #f) (printf "~A<~A ~A>" (indent ind) (tag-name tag) (tag-atribs tag)))
((eq? close #t) (printf "~A<~A/>" (indent ind)(tag-name tag)))))
(define (display-heir tag)
(define (recursive-display tag indent)
(print-tag tag #f indent)
(newline)
(cond ((not (eq? (tag-elems tag) '()))
(map (lambda (tg) (
(recursive-display tg (+ indent 1))))
(tag-elems tag))))
(print-tag tag #t indent)
(newline))
(recursive-display tag 0))
(define tg3 (make-tag 'Person '("name='Joe'" "age='5'" "sex='Male'") '()))
(define tg4 (make-tag 'Person '("name='Sally'" "age='1'" "sex='Female'") '()))
(define tg2 (make-tag 'children '() (list tg3 tg4)))
(define tg1 (make-tag 'Person '("name='Bob'" "age='21'" "sex='Male'") (list tg2)))
;this doesnt work, stops working after printing first element in innermost
;level of the heirarchy, should work like the next block with some additional
;newlines
(display-heir tg1)
;this displays the tags correctly
(print-tag tg1 #f 0)
(newline)
(print-tag tg2 #f 1)
(newline)
(print-tag tg3 #f 2)(print-tag tg3 #t 0)
(newline)
(print-tag tg4 #f 2)(print-tag tg4 #t 0)
(newline)
(print-tag tg2 #t 1)
(newline)
(print-tag tg1 #t 0)
I compiled it with normal settings csc xml.scm -o xml.exe
I get the following
C:\Users\jorda\Documents\iupprac\more>csc xml.scm
C:\Users\jorda\Documents\iupprac\more>xml
<Person name='Bob' age='21' sex='Male'>
<children >
<Person name='Joe' age='5' sex='Male'>
<Person/>
Error: call of non-procedure: #<unspecified>
Call history:
xml.scm:45: newline
xml.scm:46: tag-elems
xml.scm:50: print-tag
xml.scm:40: ##sys#check-output-port
xml.scm:40: indent
xml.scm:21: const-l
xml.scm:12: const-l
xml.scm:12: const-l
xml.scm:21: string-join
xml.scm:40: ##sys#print
xml.scm:40: ##sys#write-char-0
xml.scm:40: tag-name
xml.scm:40: ##sys#print
xml.scm:40: ##sys#print
xml.scm:51: newline
xml.scm:47: g105 <--
If you remove the (display-heir tg1) it gives the correct output with the code that follows after that line:
<Person name='Bob' age='21' sex='Male'>
<children >
<Person name='Joe' age='5' sex='Male'><Person/>
<Person name='Sally' age='1' sex='Female'><Person/>
<children/>
<Person/>
The problem here is the procedure that you pass to map:
(define (display-heir tag)
(define (recursive-display tag indent)
(print-tag tag #f indent)
(newline)
(cond ((not (eq? (tag-elems tag) '()))
(map (lambda (tg) (
(recursive-display tg (+ indent 1))))
(tag-elems tag))))
(print-tag tag #t indent)
(newline))
If you indent this correctly, you may spot the problem more easily:
(define (display-heir tag)
(define (recursive-display tag indent)
(print-tag tag #f indent)
(newline)
(cond ((not (eq? (tag-elems tag) '()))
(map (lambda (tg) (
(recursive-display tg (+ indent 1))))
(tag-elems tag))))
(print-tag tag #t indent)
(newline))
(recursive-display tag 0))
As you can (hopefully) see, the call to recursive-display is wrapped in an extra set of parentheses. This means it will try to call the result of recursive-display as a procedure (which it isn't, it's void or #<unspecified>)

How to count the number of occurrences of each word in scheme

I'm trying to read a string from a text file; and to provide a "statistics" about the occurrence of each word using scheme and to provide the most used words.
exp:
string = "one two, tree one two"
and getting :
one: 2
two: 2
tree: 1
I can count each word by using a simple function counter and display the result on the screen, but I can't find a way to use this result to display for example the most 5 used words for example in a huge input text -a book for example-.
update :
Here is my solution for my question but the input should be sorted, like this (a a a a b b b b b m m m )
(define frequency (lambda(ls)
(if (null? ls) '() (freq_aux (car ls) 1 (cdr ls) '() ))))
(define freq_aux (lambda(l n ls tmp ) ( if(null? ls)
(cons (cons n l) tmp) (if(equal? l (car ls))
(freq_aux l (+ 1 n) (cdr ls) tmp)
(freq_aux (car ls) 1 (cdr ls) (cons (cons n l) tmp))))))
Here is a hint from another StackOverflow question (I can't find it).
(define (tokenize file)
(with-input-from-file file
(lambda ()
(let reading ((lines '()) (words '()) (chars '()))
(let ((char (read-char)))
(if (eof-object? char)
(reverse lines)
(case char
((#\newline) (reading (cons (reverse (cons (reverse chars) words)) lines) '() '()))
((#\space) (reading lines (cons (reverse chars) words) '()))
(else (reading lines words (cons char chars))))))))))
This returns a list of lines which is a list of words which is a list of characters. You could get a list of strings with:
(map list->string (apply append (tokenize <someffile>)))
From that:
(define (frequency-alist words)
(let ((alist '()))
(let scanning ((words words))
(if (null? words
alist
(let ((word (car words)))
(cond ((assoc word alist)
=> (lambda (al-item)
(set-cdr! al-item (+ 1 (cdr al-item)))))
(else (set! alist (cons (cons word 1) alist))))
(scanning (cdr words)))))))

Resources