I am trying to create a function that accepts a number and then produces text they can temporarily copy into their paper as a space saver. Here are a few examples below:
(define
CITATION-SPACE-2
(string-append
"[1] author information\n"
"title information\n"
"venue information\n"
"year & page information\n"
"[2] author information\n"
"title information\n"
"venue information\n"
"year & page information"))
(define
CITATION-SPACE-3
(string-append
"[1] author information\n"
"title information\n"
"venue information\n"
"year & page information\n"
"[2] author information\n"
"title information\n"
"venue information\n"
"year & page information\n"
"[3] author information\n"
"title information\n"
"venue information\n"
"year & page information"))
(check-expect (citation-space 2) CITATION-SPACE-2)
(check-expect (citation-space 3) CITATION-SPACE-3)
I have been able to define the function using cond and string-append but can't figure out how to have a \n between each line of the result (though not after the last line). Also, I am unsure how to define and simplify the function using the foldr list abstraction.
This is what I have tried so far:
(define (citation-space num)
(local [; data-string : Nat -> String
; produces a space saver
; for a supplied number
(define (data-string num)
(foldl (λ (s1 s2)
(string-append s2 "\n" s1))
(string-append
"[" (number->string num) "]"
" author information")
(list "title information"
"venue information"
"year & page information")))]
(cond
[(zero? num) ""]
[(= num 1) (data-string 1)]
[else (string-append
(citation-space (sub1 num))
"\n"
(data-string num))])))
If you didn't have to do this exercise in ISL, you could use string-join provided by racket/string.
If you didn't have to use foldl or foldr, you could write something like this:
(define (my-join strs sep)
(cond ((null? strs) "")
((= (length strs) 1) (first strs))
(else (string-append (first strs)
sep
(my-join (rest strs) sep)))))
But I think it's possible to solve this problem also with pair of foldl. Used language is Intermediate Student with Lambda:
(define
CITATION-SPACE-2
(string-append
"[1] author information\n"
"title information\n"
"venue information\n"
"year & page information\n"
"[2] author information\n"
"title information\n"
"venue information\n"
"year & page information"))
(define
CITATION-SPACE-3
(string-append
"[1] author information\n"
"title information\n"
"venue information\n"
"year & page information\n"
"[2] author information\n"
"title information\n"
"venue information\n"
"year & page information\n"
"[3] author information\n"
"title information\n"
"venue information\n"
"year & page information"))
(define (data-string number)
(foldl (lambda (s result)
(string-append result "\n" s))
(format "[~a] author information" number)
(list "title information"
"venue information"
"year & page information")))
(define (citation-space number)
(if (zero? number) ""
(let ((strs (map data-string (range 1 (add1 number) 1))))
(foldl (lambda (s result) (string-append result "\n" s))
(first strs)
(rest strs)))))
(check-expect (citation-space 2) CITATION-SPACE-2)
(check-expect (citation-space 3) CITATION-SPACE-3)
EDIT: Solution with one foldl:
(define (data-string number)
(foldl (lambda (s result)
(string-append result "\n" s))
(format "[~a] author information" number)
(list "title information"
"venue information"
"year & page information")))
(define (citation-space num)
(cond
[(zero? num) ""]
[(= num 1) (data-string 1)]
[else (string-append
(citation-space (sub1 num))
"\n"
(data-string num))]))
Related
I am looking to create this function that takes a number and returns a string that gives that number as an item quantity. So far, I cannot think of a way to transfer this number into a string, nor come up with a clause that can change the grammar from 1 item to 2 item(s).
(check-expect (package-quantity 1) "1 item")
(check-expect (package-quantity 2) "2 items")
(define (package-quantity q)
(
When producing quantities for the human reader, there could also be special cases:
;language: Advanced Student
(check-expect (package-quantity 1) "1 item")
(check-expect (package-quantity 2) "1 pair")
(check-expect (package-quantity 3) "3 items")
(: package-quantity (Natural -> String))
(define (package-quantity q)
;; produce description of quantity, with special cases
(cond
[(zero? q) "nothing" ]
[(= q 2) "1 pair" ]
[(= q 12) "1 dozen" ]
[else (string-append
(number->string q)
(cond
[(= q 1) " item" ]
[else " items" ])) ]))
I am trying to make a toy system for writing documents using a macro (doc):
Example #1:
(doc id: 1
title: "First document"
"First sentence."
"Second sentence.")
Intended expansion:
(make-doc (list (list 'id: 1) (list 'title: "First document"))
(list "First sentence" "Second sentence"))
Example #2:
(let ((my-name "XYZ"))
(doc title: "Second document"
id: (+ 1 1)
"First sentence."
(string-append "My name is " my-name ".")
"Last sentence."))
Intended expansion:
(let ((my-name "XYZ"))
(make-doc (list (list 'title: "Second document") (list 'id: (+ 1 1)))
(list "First sentence."
(string-append "My name is " my-name ".")
"Last sentence.")))
More sample calls to this macro are:
(doc id: 1 "First sentence." "Second sentence.")
(doc id: 1 title: "First document" subtitle: "First subdocument"
"First sentence." "Second sentence." "Third sentence.")
First come the metadata specs, then sentences. Metadata must come before the sentences. The macro must accept any number of metadata specs.
Evaluating (doc ...) should return a string, or write the resulting text into a file. But I have not yet implemented this functionality, because I am stuck on the definition of the doc macro (which is the point of this question).
Below is my implementation of the doc macro. Vocabulary: title: "ABC" and id: 123 are called "metadata"; title: and id: are called "metadata IDs".
;;; (metadata-id? 'x:) -> #t
;;; (metadata-id? 'x) -> #f
;;; (metadata-id? "Hi!") -> #f
(define (metadata-id? x)
(cond [(symbol? x)
(let* ([str (symbol->string x)]
[last-char (string-ref str (- (string-length str) 1))])
(char=? last-char #\:))]
[else #f]))
;;; (pair-elements '(1 2 3 4 5)) -> '((1 2) (3 4) (5)).
(define (pair-elements l [acc '()] [temp null])
(cond [(and (null? l) (null? temp)) acc]
[(null? l)
(append acc (list (list temp)))]
[(null? temp)
(pair-elements (cdr l) acc (car l))]
[else
(pair-elements (cdr l)
(append acc (list (list temp (car l)))))]))
(define-syntax doc
(syntax-rules ()
((doc arg . args)
(let* ([orig-args (cons 'arg 'args)]
[metadata-bindings (takef (pair-elements orig-args)
(lambda (e)
(metadata-id? (car e))))]
[sentences (drop orig-args (* 2 (length metadata-bindings)))])
(make-doc metadata-bindings sentences)))))
(define (make-doc metadata-bindings sentences)
;; Do something ...
;; Placeholder stubs:
(writeln metadata-bindings)
(writeln sentences))
Using this implementation, evaluating example #1 prints as expected:
((id: 1) (title: "First document"))
("First sentence." "Second sentence.")
However, evaluating example #2 prints:
((id: (+ 1 1)) (title: "Second document"))
("First sentence." (string-append "My name is " my-name ".") "Last sentence.")
Apparently, the arguments were not evaluated. The expected result of example #2 is supposed to be this instead:
((id: 2) (title: "Second document"))
("First sentence." "My name is XYZ." "Last sentence.")
What is wrong with the implementation of the doc macro? How can I make the macro evaluate some of its arguments?
The reason is that you're quoting 'args, which results in it being an s-expression after macro expansion, not evaluated with function application. To fix this, you probably want make use of quasiquote. This'll also require you to rework how you specify the macro pattern. I suggest using the ... notation. Here's a sketch of what I'm describing:
(define-syntax doc
(syntax-rules ()
[(doc arg rest-args ...)
(let* ([orig-args `(arg ,rest-args ...)]
; the rest is the same
))]))
I'm not sure if this is the proper way, but I've managed to write a helper macro parse-args using syntax-case in Racket. It works like this:
(parse-args title: "Interesting document"
id: (+ 1 2)
"First sentence."
(string-append "Second sentence" "!")
"Last sentence.")
The above gets transformed into a list:
'((metadata title: "Interesting document")
(metadata id: 3)
(sentences "First sentence."
"Second sentence!"
"Last sentence."))
Implementation:
(begin-for-syntax
;;; (metadata-id? 'x:) -> #t; (metadata-id? 'x) -> #f.
(define (metadata-id? x)
(cond [(symbol? x)
(let* ([str (symbol->string x)]
[last-char (string-ref str (- (string-length str) 1))])
(char=? last-char #\:))]
[else #f])))
(define-syntax (parse-args stx)
(syntax-case stx ()
[(_ arg1 arg2) ; If no sentences.
(metadata-id? (syntax->datum (syntax arg1)))
(syntax `((metadata arg1 ,arg2)))]
[(_ arg1 arg2 rest-args ...)
(metadata-id? (syntax->datum (syntax arg1)))
(syntax `((metadata arg1 ,arg2) ,#(parse-args rest-args ...)))]
[(_ sentence rest-sentences ...)
(syntax (list `(sentences ,sentence ,rest-sentences ...)))]))
Notice how I used a "fender" ((metadata-id? (syntax->datum (syntax arg1)))). This is the crucial feature missing in syntax-rules macros, which is why I implemented the macro using syntax-case instead.
Now that I am able to parse the arguments, all that remains is to use parse-args in the definition of doc.
(define-syntax (doc stx)
(syntax-case stx ()
((doc arg rest-args ...)
(syntax (apply make-doc
(group-args (parse-args arg rest-args ...)))))))
group-args rearranges the list returned by parse-args like so:
(group-args '((metadata a: 1)
(metadata b: 2)
(sentences "ABC" "DEF")))
;; Returns:
;; '(((a: 1)
;; (b: 2))
;; ("ABC" "DEF"))
;; The car is an assoc list of metadata.
;; The cadr is the list of sentences.
Implementation:
;;; 'lst' is valid even if there is no 'metadata'.
;;; 'lst' is valid even if there is no 'sentences'.
;;; However, if there is a 'sentences', it must be the last item in the list.
(define (group-args lst [metadata-acc '()])
(define tag-name car)
(define remove-tag cdr)
(cond [(null? lst) (list metadata-acc '())]
[(eq? 'metadata (tag-name (car lst)))
(group-args (cdr lst)
(cons (remove-tag (car lst))
metadata-acc))]
[(eq? 'sentences (tag-name (car lst)))
(cons metadata-acc
(list (remove-tag (car lst))))]
[else
(error "Invalid values" lst)]))
make-doc can now be defined like this:
;;; 'metadata' is an assoc list of metadata.
;;; 'sentences' is a list of strings.
(define (make-doc metadata sentences)
;; ... create the document ...
;; Placeholder stubs:
(display "ID: ")
(displayln (cadr (assq 'id: metadata)))
(display "Title: ")
(displayln (cadr (assq 'title: metadata)))
(displayln sentences))
Usage:
(let ((my-name "XYZ"))
(doc title: "Second document"
id: (+ 1 1)
"First sentence."
(string-append "My name is " my-name ".")
"Last sentence."))
Prints:
ID: 2
Title: Second document
(First sentence. My name is XYZ. Last sentence.)
I would recommend you to use the syntax/parse library, since it's so much easier to write this kind of macro with it.
#lang racket
(require syntax/parse/define)
(define (make-doc x y) `(make-doc ,x ,y))
(begin-for-syntax
;; metadata-id? :: symbol? -> boolean?
(define (metadata-id? x)
(define str (symbol->string x))
(define len (string-length str))
;; Need to check that len > 0.
;; Otherwise, the empty identifier (||)
;; would cause an "internal" error
(and (> len 0)
(char=? (string-ref str (sub1 len)) #\:)))
(define-splicing-syntax-class key-val-class
(pattern (~seq key:id val:expr)
#:when (metadata-id? (syntax-e #'key)))))
(define-simple-macro (doc key-val:key-val-class ... xs ...)
(make-doc (list (list (quote key-val.key) key-val.val) ...)
(list xs ...)))
;;;;;;;;;;;;;;;;;
(doc id: 1
title: "First document"
"First sentence."
"Second sentence.")
;; '(make-doc ((id: 1) (title: "First document")) ("First sentence." "Second sentence."))
(let ([my-name "XYZ"])
(doc title: "Second document"
id: (+ 1 1)
"First sentence."
(string-append "My name is " my-name ".")
"Last sentence."))
;; '(make-doc
;; ((title: "Second document") (id: 2))
;; ("First sentence." "My name is XYZ." "Last sentence."))
(let ([|| 1])
(doc || 2))
;; '(make-doc () (1 2))
I'm trying to create an array of lists with its elements being: Surname , Name and Age.
Here is my code in AutoLISP:
(defun C:DP_ADINREG ( / prenume nume varsta inreg)
(initget 1)
(setq prenume (getstring "\nIntroduceti prenumele: "))
(initget 1)
(setq nume (getstring "\nIntroduceti numele: "))
(initget 7)
(setq varsta (getint "\nIntroduceti varsta: "))
(setq inreg (list (cons 'pn prenume) (cons 'nf nume)
(cons 'v varsta))
DP_DATA (append DP_DATA (list inreg))
)
(princ)
)
(defun C:DP_LISTARE ( / curent inreg n)
(setq curent DP_DATA
n 1)
(while curent
(setq inreg (car curent))
(princ (strcat "\nInregistrarea #" (itoa n)
": " (cdr (assoc 'pn inreg))
", " (cdr (assoc 'nf inreg))
". Varsta " (itoa (cdr (assoc 'v inreg)))
)
)
(setq curent (cdr curent)
n (1+ n)
)
)
(princ)
)
Problem is, when trying to access the second function, it gives me an error called:
Bad argument type : fixnump : nil.
Now I have no idea where the problem actually is.
Any ideas?
The error:
; error: bad argument type: fixnump: nil
Arises when a function requiring an integer argument is supplied with a value of nil. Hence, this error is arising from the evaluation of the second of your two itoa expressions:
(itoa (cdr (assoc 'v inreg)))
(Since the first itoa expression is being supplied with the variable n, which cannot be nil).
This implies that the following expression returns nil:
(cdr (assoc 'v inreg))
Which implies that one of the association lists within the list held by your global variable DP_DATA does not contain a dotted pair with key v. I would therefore suggest checking the value held by your global variable DP_DATA.
Aside: note that initget has no effect on a getstring prompt - you can achieve the same effect using a basic while loop, e.g.:
(while (= "" (setq prenume (getstring "\nIntroduceti prenumele: ")))
(princ "\nPlease enter a first name.")
)
(while (= "" (setq nume (getstring "\nIntroduceti numele: ")))
(princ "\nPlease enter a surname.")
)
You can account for null values in your association list using some basic error checking:
(defun C:DP_ADINREG ( / prenume nume varsta )
(while (= "" (setq prenume (getstring "\nIntroduceti prenumele: ")))
(princ "\nPlease enter a first name.")
)
(while (= "" (setq nume (getstring "\nIntroduceti numele: ")))
(princ "\nPlease enter a surname.")
)
(initget 7)
(setq varsta (getint "\nIntroduceti varsta: ")
DP_DATA (cons (list (cons 'pn prenume) (cons 'nf nume) (cons 'v varsta)) DP_DATA)
)
(princ)
)
(defun C:DP_LISTARE ( / n )
(setq n 0)
(foreach lst (reverse DP_DATA)
(princ
(strcat
"\nInregistrarea #" (itoa (setq n (1+ n)))
": " (cond ((cdr (assoc 'pn lst))) (""))
", " (cond ((cdr (assoc 'nf lst))) (""))
". Varsta " (itoa (cond ((cdr (assoc 'v lst))) (0)))
)
)
)
(princ)
)
The above will return a blank first name/surname where not present, and an age of 0 where not present; you could alternatively return an error if these values are not present, e.g.:
(defun C:DP_LISTARE ( / n nf pn v )
(setq n 1)
(foreach lst (reverse DP_DATA)
(if
(and
(setq pn (cdr (assoc 'pn lst)))
(setq nf (cdr (assoc 'nf lst)))
(setq v (cdr (assoc 'v lst)))
)
(princ (strcat "\nInregistrarea #" (itoa n) ": " pn ", " nf ". Varsta " (itoa v)))
(princ (strcat "\nMissing data for item " (itoa n)))
)
(setq n (1+ n))
)
(princ)
)
I'm doing a problem which asks me to write a function that consumes a
list (dict1) and a list (act) that contains an action (remove or add) and a value. The updates should adhere to the following specifications:
• If the first element of act is “remove" and the key is in the dictionary, then the matching value in the associated list should be removed.
• If the matching value happens to be the last element in the associated list, then the key should remain in the dictionary, but the associated list becomes empty. If the value is not in the dictionary, the dictionary does not change.
• If the value of act is "add" and the key is in the dictionary, then the new value
should be added to the associated list in the dictionary if it does not already exist. If the value already exists in the associated list, the updated dictionary would not change.
• If the value of act is “add" and the key does not exist in the dictionary, then a
new association list entry for the key should be added to the dictionary.
For example:
(define dict1 (list (list "Num" (list 5 1.3 -1))
(list "Char" (list #\p))
(list "Str"
(list "cs" "CS" "Computer Science"))))
Then
(update dict1 (list "add" true)) =>
(list (list "Num" (list 5 1.3 -1))
(list "Bool" (list true))
(list "Char" (list #\p))
(list "Str" (list "cs" "CS" "Computer Science")))
(update dict1 (list "remove" "cs")) =>
(list (list "Num" (list 5 1.3 -1))
(list "Char" (list #\p))
(list "Str" (list "CS" "Computer Science")))
I could only come up with the first step, below is what I have so far:
(define (update dict1 act)
(cond
[(equal? (first act) "remove") (remove-value dict1 (second act))]
[(equal? (first act) "add") (add-value dict1 (second act))]))
For this question I'm only allowed to use member? or remove.
I knew that I've been asking a lot of questions in the past couple of days, but I am new to racket and I am doing my best to learn it :( Please help
no set! no local version
; please tell us which language you use (in front of code)
#|
In Beginning Student Language variabe can't be function
error: function call: expected a function after the open parenthesis, but found a variable
(define (f fn) (fn 1))
(f add1)
|#
; use "Advanced Student" language or "#lang racket".
#lang racket
(define dict1
(list (list "Num" (list 1 2 3))
(list "Char" (list #\p))
(list "Bool" '())
(list "Str" (list "a" "b" "c"))))
(define (index-title action)
(cond
[(number? (second action)) 0]
[(char? (second action)) 1]
[(boolean? (second action)) 2]
[(string? (second action)) 3]
[else (error "type error")]))
(define (my-remove word lst)
(cond
[(empty? lst) empty]
[(equal? word (first lst))
(rest lst)]
[else
(cons (first lst)
(my-remove word (rest lst)))]))
(define (exist? word lst)
(cond
[(empty? lst) #f]
[(equal? word (first lst)) #t]
[else
(exist? word (rest lst))]))
(define (add-if-not-exist word data)
(if (exist? word data)
data
(cons word data)))
(define (action-to-data word data action)
(cond
[(equal? action "add")
(add-if-not-exist word data)]
[(equal? action "remove")
(my-remove word data)]))
(define (aux-build-list i n dict act a-function)
(cond
[(= i n) empty]
[else
(cons (a-function i dict act)
(aux-build-list (+ i 1) n dict act a-function))]))
(define (my-build-list n dict act a-function)
(aux-build-list 0 n dict act a-function))
(define (build-new-sub-dict n dict act)
(cond
[(= n (index-title act))
(list (first (list-ref dict n))
(action-to-data (second act) (second (my-list-ref dict n)) (first act)))]
[else
(list-ref dict n)]))
(define (my-list-ref lst n)
(cond
[(< n 0) (error "error")]
[(= n 0) (first lst)]
[else
(my-list-ref (rest lst) (- n 1))]))
(define (update dict act)
(set! dict1
(my-build-list (length dict)
dict
act
(lambda (n dict act) (build-new-sub-dict n dict act)))))
;;; Test
(update dict1 '("add" 2))
(update dict1 '("remove" 3))
(update dict1 '("add" 4))
(update dict1 '("add" 4))
(update dict1 '("remove" 1))
(update dict1 '("remove" 2))
dict1
I have a file named test.txt, it contains
"hello this is a test file"
I want to read it from the file so that every word represents lists of character and every paragraph represents lists of words means that I want to store them into a nested list like:
(list(list (h e l l o)) (list(t h i s))(list(i s)) (list(a)) (list(t e s t)) (list(f i l e))))
I am totally new in lisp and have a lot of confusion about this problem.
Solution without any dependencies
(defun split (l &key (separators '(#\Space #\Tab #\Newline)) (acc '()) (tmp '()))
(cond ((null l) (nreverse (if tmp (cons (nreverse tmp) acc) acc)))
((member (car l) separators)
(split (cdr l) :separators separators
:acc (if tmp (cons (nreverse tmp) acc) acc)
:tmp '()))
(t
(split (cdr l) :separators separators
:acc acc
:tmp (cons (car l) tmp)))))
(defun read-file-lines (file-path)
(with-open-file (f file-path :direction :input)
(loop for line = (read-line f nil)
while line
collect line)))
(defun read-file-to-word-characters (file-path)
(mapcan (lambda (s) (split (coerce s 'list)))
(read-file-lines file-path)))
(read-file-to-word-characters "~/test.lisp.txt")
;; ((#\h #\e #\l #\l #\o) (#\t #\h #\i #\s) (#\i #\s) (#\a) (#\t #\e #\s #\t)
;; (#\f #\i #\l #\e))
Convert the characters to one-letter strings:
;; apply to elements of nested list (= a tree) the conversion function `string`
(defun map-tree (fn tree)
(cond ((null tree) '())
((atom tree) (funcall fn tree))
(t (mapcar (lambda (branch) (map-tree fn branch)) tree))))
(map-tree #'string (read-file-to-word-characters "~/test.lisp.txt"))
;; (("h" "e" "l" "l" "o") ("t" "h" "i" "s") ("i" "s") ("a") ("t" "e" "s" "t")
;; ("f" "i" "l" "e"))
Content of "~/test.lisp.txt":
hello this
is a test file
Solution using cl-ppcre (Edi Weitz's congenial regex package)
;; look here in an answer how to use cl-ppcre:split
;; https://stackoverflow.com/questions/15393797/lisp-splitting-input-into-separate-strings
(ql:quickload :cl-ppcre)
(defun read-file-lines (file-path)
(with-open-file (f file-path :direction :input)
(loop for line = (read-line f nil)
while line
collect line)))
(defun string-to-words (s) (cl-ppcre:split "\\s+" s))
(defun to-single-characters (s) (coerce s 'list))
(defun read-file-to-character-lists (file-path)
(mapcan (lambda (s)
(mapcar #'to-single-characters
(string-to-words s)))
(read-file-lines file-path)))
(read-file-to-character-lists "~/test.lisp.txt")
;; ((#\h #\e #\l #\l #\o) (#\t #\h #\i #\s) (#\i #\s) (#\a) (#\t #\e #\s #\t)
;; (#\f #\i #\l #\e))
;; or use above's function:
(map-tree #'string (read-file-to-character-lists "~/test.lisp.txt"))
;; (("h" "e" "l" "l" "o") ("t" "h" "i" "s") ("i" "s") ("a") ("t" "e" "s" "t")
;; ("f" "i" "l" "e"))
;; or:
(defun to-single-letter-strings (s) (cl-ppcre:split "\\s*" s))
(defun read-file-to-letter-lists (file-path)
(mapcan (lambda (s)
(mapcar #'to-single-letter-strings
(string-to-words s)))
(read-file-lines file-path)))
(read-file-to-letter-lists "~/test.lisp.txt")
;; (("h" "e" "l" "l" "o") ("t" "h" "i" "s") ("i" "s") ("a") ("t" "e" "s" "t")
;; ("f" "i" "l" "e"))