scheme - string-appends wrong type to apply error - string

I have this code
(lambda (symbol)
(let*(
(datalist (get-list symbol))
(desc " ")
(html "<table border=\"1\">")
(html (string-append html "<tr><td>" (list-ref datalist 1) "</td><t\
r><td>" (list-ref datalist 2) "</td></tr>"))
)
(do ((p 7 (+ 7 p)))
((> p (-(length datalist) 2)))
(desc (string-append desc "<tr><td>"(list-ref datalist p) "</td><td>"\
(list-ref datalist (+ p 1))"</td></tr>"))
)
(set! html (string-append html desc "</table>"))
html
)
)
I'm basically taking some elements from a datalist and adding some html tags to them. However, when I run the code, I get a "wrong type to apply error" on the desc binding (line 4). What gives? Even when i change it to values such as "foo", i still get the wrong type error.
Any suggestions?

The error is not in the binding, is in the loop's body:
(desc (string-append desc …))
You're trying to apply desc as if it were a procedure - but it's a string. So basically that part of the code is doing something equivalent to this:
("s1" "s2")
Which will result in the reported error. Perhaps you meant to do this?
(set! desc (string-append desc …))
I'll take a guess to figure out what were you trying to implement. And do notice how properly indenting and formatting the code helps to make it clear:
(lambda (symbol)
(let* ((desc " ")
(datalist (get-list symbol))
(html (string-append "<table border=\"1\">"
"<tr><td>"
(list-ref datalist 1)
"</td><tr><td>"
(list-ref datalist 2)
"</td></tr>")))
(do ((p 7 (+ 7 p)))
((> p (- (length datalist) 2)))
(set! desc (string-append desc
"<tr><td>"
(list-ref datalist p)
"</td><td>"
(list-ref datalist (+ p 1))
"</td></tr>")))
(string-append html desc "</table>")))

Related

DrRacket – Finding total number of vowels in list of characters

I am using DrRacket on the Beginner Language mode.
Code below:
(define vowels '(#\a #\e #\i #\o #\u))
(define total 0)
(define (any-in-list lst check)
(cond
[(empty? lst) (+ 0 total)]
[(member? (first lst) check) (add1 total)]
[else (any-in-list (rest lst) check)]))
(define (count-vowels string)
(any-in-list (string->list string) vowels))
(count-vowels "how do i do this?")
The total value stays stuck at 1. After debugging, I realized that the 2nd cond statement evaluates to #true and then stops. How can I keep it going for the rest of the list after updating the total value?
You forgot to recurse when you found a match.
Also, since total is 0, (+ 0 total) is always 0, and (add1 total) is always 1.
Don't try to use global variables and mutation - recurse and use the recursive value.
(cond
; The empty list contains nothing, so the result is 0.
[(empty? lst) 0]
; If the first element is a member, the result is
; one more than the count in the tail.
[(member? (first lst) check) (add1 (any-in-list (rest lst) check))]
; Otherwise, the count is the same as in the tail.
[else (any-in-list (rest lst) check)]))
molbdnilo's answer explains the OP's issue and provides a correct solution;
since "Beginner Language" is mentioned, it may be worth
looking at how a solution might be constructed using the method
for which BSL (Beginning Student language) in DrRacket is apparently intended.
Following the HtDF (How to Design Functions) recipe, one can write the following
stub, incorporating signature and purpose, and "check-expect" examples:
(Note: layout differs slightly from HtDF conventions)
(define (count-vowels str) ;; String -> Natural ) *stub define* ;; *signature*
;; produce the count of vowel characters in str ) *purpose statement*
0 ) ) *stub body* (a valid result)
(check-expect (count-vowels "") 0 ) ) *examples*
(check-expect (count-vowels "a") 1 ) )
(check-expect (count-vowels "b") 0 ) )
(check-expect (count-vowels "ab") 1 ) )
(check-expect (count-vowels "ae") 2 ) )
The first check-expect already passes; now write inventory and template;
count-vowels will have to do something with each character in the string, but there is no
standard BSL function or template for this. However there is a template for doing something
with the elements of a list:
(define (fn lox) ;; (Listof X) -> Y ) *template*
(cond )
[(empty? lox) ... ] #|base case|# ;; Y )
[else (... #|something|# ;; X Y -> Y )
(first lox) (fn (rest lox))) ])) )
(define vowels (list #\a #\e #\i #\o #\u)) ) *inventory*
(member? x lox) ;; X (Listof X) -> Bool )
(string->list str) ;; String -> (Listof Char) )
So count-vowels can be a composition of string->list with a function derived from this
template, for which stub, signature, and check-expects are:
(define (count-vowels-in-list loc) ;; (Listof Char) -> Natural
0)
(check-expect (count-vowels-in-list empty) 0 )
(check-expect (count-vowels-in-list (cons #\a '())) 1 ) ;; (+ 1 0)
(check-expect (count-vowels-in-list (cons #\b '())) 0 ) ;; (+ 0 0)
(check-expect (count-vowels-in-list (list #\a #\b)) 1 )
(check-expect (count-vowels-in-list (list #\a #\e)) 2 )
Expanding the template and looking at the first check-expect, the |base case| can be filled in:
(define (count-vowels-in-list loc) ;; (Listof Char) -> Natural
(cond
[(empty? loc) 0 ]
[else (|something| (first loc) (count-vowels-in-list (rest loc))) ]))
For the next two check-expects, (rest loc) will be '(), so (|something| #\a 0) => 1 but
(|something| #\b 0) => 0
What distinguishes #\a from #\b is that (member? #\a vowels) => #true but
(member? #\b vowels) => #false so a descriptive name for |something| is add-1-if-vowel:
(define (add-1-if-vowel chr n) ;; Char Natural -> Natural
(if (member? chr vowels)
(add1 n)
n))
So a complete solution developed by following this systematic design method is:
(define vowels (list #\a #\e #\i #\o #\u))
(define (add-1-if-vowel chr n) ;; Char Natural -> Natural
(if (member? chr vowels)
(add1 n)
n))
(define (count-vowels-in-list loc) ;; (Listof Char) -> Natural
(cond
[(empty? loc) 0 ]
[else (add-1-if-vowel (first loc) (count-vowels-in-list (rest loc))) ]))
(define (count-vowels str) ;; String -> Natural
(count-vowels-in-list (string->list str)))
(check-expect (count-vowels "") 0 )
(check-expect (count-vowels "a") 1 )
(check-expect (count-vowels "b") 0 )
(check-expect (count-vowels "ab") 1 )
(check-expect (count-vowels "ae") 2 )
(check-expect (count-vowels "how do i do this?") 5 ) ;; ^ (this is how :) ^

Split String by Delimiter and Include Delimiter - Common Lisp

How can I split a string by a delimiter in Common Lisp, like is done in SPLIT-SEQUENCE, but also add the delimiter in the list of strings?
For example, I could write:
(split-string-with-delimiter #\. "a.bc.def.com")
and the result would be ("a" "." "bc" "." "def" "." "com").
I've tried the following code (make-adjustable-string makes a string that can be extended with vector-push-extend):
(defun make-adjustable-string (s)
(make-array (length s)
:fill-pointer (length s)
:adjustable t
:initial-contents s
:element-type (array-element-type s)))
(defun split-str (string &key (delimiter #\ ) (keep-delimiters nil))
"Splits a string into a list of strings, with the delimiter still
in the resulting list."
(let ((words nil)
(current-word (make-adjustable-string "")))
(do* ((i 0 (+ i 1))
(x (char string i) (char string i)))
((= (+ i 1) (length string)) nil)
(if (eql delimiter x)
(unless (string= "" current-word)
(push current-word words)
(push (string delimiter) words)
(setf current-word (make-adjustable-string "")))
(vector-push-extend x current-word)))
(nreverse words)))
But this doesn't print out the last substring/word. I'm not sure what's going on.
Thanks for the help ahead of time!
If you're just looking for a solution, and not for an exercise, you can use cl-ppcre:
CL-USER> (cl-ppcre:split "(\\.)" "a.bc.def.com" :with-registers-p t)
("a" "." "bc" "." "def" "." "com")
Something like this?
copy sub-strings using subseq
using LOOP makes collecting things easier
Example:
(defun split-string-with-delimiter (string
&key (delimiter #\ )
(keep-delimiters nil)
&aux (l (length string)))
(loop for start = 0 then (1+ pos)
for pos = (position delimiter string :start start)
; no more delimiter found
when (and (null pos) (not (= start l)))
collect (subseq string start)
; while delimiter found
while pos
; some content found
when (> pos start) collect (subseq string start pos)
; optionally keep delimiter
when keep-delimiters collect (string delimiter)))
Example:
CL-USER 120 > (split-string-with-delimiter "..1.2.3.4.."
:delimiter #\. :keep-delimiters nil)
("1" "2" "3" "4")
CL-USER 121 > (split-string-with-delimiter "..1.2.3.4.."
:delimiter #\. :keep-delimiters t)
("." "." "1" "." "2" "." "3" "." "4" "." ".")
CL-USER 122 > (split-string-with-delimiter "1.2.3.4"
:delimiter #\. :keep-delimiters nil)
("1" "2" "3" "4")
CL-USER 123 > (split-string-with-delimiter "1.2.3.4"
:delimiter #\. :keep-delimiters t)
("1" "." "2" "." "3" "." "4")
Or modified to work with any sequence (lists, vectors, strings, ...):
(defun split-sequence-with-delimiter (sequence delimiter
&key (keep-delimiters nil)
&aux (end (length sequence)))
(loop for start = 0 then (1+ pos)
for pos = (position delimiter sequence :start start)
; no more delimiter found
when (and (null pos) (not (= start end)))
collect (subseq sequence start)
; while delimiter found
while pos
; some content found
when (> pos start) collect (subseq sequence start pos)
; optionally keep delimiter
when keep-delimiters collect (subseq sequence pos (1+ pos))))
The problem is after the end condition of the do* loop. When variable i reaches the end of the string, the do* loop is exited but there is still a current-word which has not been added yet to words. When the end condition is met you need to add x to current-word and then current-word to words, before exiting the loop:
(defun split-string-with-delimiter (string delimiter)
"Splits a string into a list of strings, with the delimiter still
in the resulting list."
(let ((words nil)
(current-word (make-adjustable-string "")))
(do* ((i 0 (+ i 1))
(x (char string i) (char string i)))
((>= (+ i 1) (length string)) (progn (vector-push-extend x current-word) (push current-word words)))
(if (eql delimiter x)
(unless (string= "" current-word)
(push current-word words)
(push (string delimiter) words)
(setf current-word (make-adjustable-string "")))
(vector-push-extend x current-word)))
(nreverse words)))
However, note that this version is still buggy in that if the last character of string is a delimiter, this will be included into the last word, i.e. (split-string-with-delimiter "a.bc.def." #\.) => ("a" "." "bc" "." "def.")
I'll let you add this check.
In any case, you might want to make this more efficient by looking ahead for delimiter and extracting all the characters between the current i and the next delimiter at once as one single substring.
For the case that you want to split with many delimiters, and keep them:
(defun split-string-with-delims (str delims)
(labels ((delim-p (c)
(position c delims))
(tokens (stri test)
(when (> (length stri) 0)
(let ((p (position-if test stri)))
(if p
(if (= p 0)
(cons (subseq stri 0 (1+ p))
(tokens (subseq stri (1+ p) nil) test))
(cons (subseq stri 0 p)
(tokens (subseq stri p nil) test)))
(cons stri nil))))))
(tokens str #'delim-p)))
And you can call it either:
(split-string-with-delims ".,hello world,," '(#\. #\, #\ ))
; => ("." "," "hello" " " "world" "," ",")
or:
(split-string-with-delims ".,hello world,,!!" "., ")
; => ("." "," "hello" " " "world" "," "," "!!")
Concerning your code, since there is subseq, i'd go for Rainer Joswig's way(above), instead of your make-adjustable-string + vector-push-extend.

Generate a random string in the fastest way

I am currently using this:
(defvar my-charset
(eval-when-compile
(concat (number-sequence 48 57) (number-sequence 65 90) (number-sequence 97 122)))
"Char set in terms of number list.")
(defvar my-charset-length
(eval-when-compile
(length (concat (number-sequence 48 57) (number-sequence 65 90) (number-sequence 97 122))))
"Length of my-charset.")
(defun my-generate-string (&optional max-length min-length)
"Generate a random string."
(let (string)
(dotimes (_i (+ (random (- (or max-length 10) (or min-length 5) -1)) (or min-length 5)))
(push (aref my-charset (random my-charset-length)) string))
(concat string)))
Any method to make it faster?
Or any other way to generate the string much faster?
There is a small performance gain to be made by using data (and control) structures more efficiently.
(defconst our-charset "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
(defconst our-charset-length (length our-charset))
(defun my-generate-string (&optional max-length min-length)
"Generate a random string."
(let (string)
(dotimes (_i (+ (random (- (or max-length 10) (or min-length 5) -1)) (or min-length 5)))
(push (aref our-charset (random our-charset-length)) string))
(concat string)))
(defun our-generate-string (&optional max-length min-length)
(let* ((max-length (or max-length 10))
(min-length (or min-length 5))
(length (+ min-length (random (- max-length min-length -1))))
(string (make-string length ?0)))
(dotimes (i length string)
(aset string i
(aref our-charset (random our-charset-length))))))
(defmacro measure-time (&rest body)
`(let ((time (current-time)))
,#body
(float-time (time-since time))))
(/
(apply #'+
(mapcar
(lambda (ignore) (measure-time (my-generate-string 1000 999)))
(number-sequence 0 999)))
1000)
;; 0.0018966329990000002
(/
(apply #'+
(mapcar
(lambda (ignore) (measure-time (our-generate-string 1000 999)))
(number-sequence 0 999)))
1000)
;; 0.0009833975549999997
Your results may differ depending on hardware and randomness, but our-generate-string should be faster.
You may also want to tweak your calling convention a little.
(defun our-randomized-string (charset length)
(let ((charset-length (length charset))
(string (make-string length ?0)))
(dotimes (i length string)
(aset string i
(aref charset (random charset-length))))))
(/
(apply #'+
(mapcar
(lambda (ignore) (measure-time (our-randomized-string our-charset 1000)))
(number-sequence 0 999)))
1000)
;; 0.0009300809320000015
Note that our-randomized-string is not necessarily faster than our-generate-string, but being able to fix parameters outside the function rather than determining them within might end up being a benefit. In this version, the character set can also be swapped easier than in the other one.

loop over characters in string, Common Lisp

How would I loop over the characters in a string of text in Common-lisp?
Here's what I want to do, but in Ruby:
string = "bacon"
string.each_char do |c|
putc c
end
(map nil #'princ "bacon")
or
(loop for c across "bacon" do (princ c))
Looping over a string can be done using loop like so:
(let ((string "bacon"))
(loop for idex from 0 to (- (length string)) 1)
do
(princ (string (aref string idex)) ) ))
;=> bacon
;=> NIL
To gather up the characters in string as a list use collect in the loop instead of do like so:
(let ((string "bacon"))
(loop for idex from 0 to (- (length string)) 1)
collect
(princ (string (aref string idex)) ) ))
;=> bacon
;=> ("b" "a" "c" "o" "n")

Clojure macro for string template replacement

This is my first Clojure macro -- I am an uber-noob.
Yesterday I posted and refined a string template replacement function. Several people suggested that the keys could be replaced at compile-time. Here is my first attempt:
(defn replace-templates*
"Return a String with each occurrence of a substring of the form {key}
replaced with the corresponding value from a map parameter.
#param str the String in which to do the replacements
#param m a map of template->value
#thanks kotarak https://stackoverflow.com/questions/6112534/
follow-up-to-simple-string-template-replacement-in-scala-and-clojure"
[^String text m]
(let [builder (StringBuilder.)]
(loop [text text]
(cond
(zero? (count text))
(.toString builder)
(.startsWith text "{")
(let [brace (.indexOf text "}")]
(if (neg? brace)
(.toString (.append builder text))
(if-let [[_ replacement] (find m (subs text 1 brace))]
(do
(.append builder replacement)
(recur (subs text (inc brace))))
(do
(.append builder "{")
(recur (subs text 1))))))
:else
(let [brace (.indexOf text "{")]
(if (neg? brace)
(.toString (.append builder text))
(do
(.append builder (subs text 0 brace))
(recur (subs text brace)))))))))
(def foo* 42)
(def m {"foo" foo*})
(defmacro replace-templates
[text m]
(if (map? m)
`(str
~#(loop [text text acc []]
(cond
(zero? (count text))
acc
(.startsWith text "{")
(let [brace (.indexOf text "}")]
(if (neg? brace)
(conj acc text)
(if-let [[_ replacement] (find m (subs text 1 brace))]
(recur (subs text (inc brace)) (conj acc replacement))
(recur (subs text 1) (conj acc "{")))))
:else
(let [brace (.indexOf text "{")]
(if (neg? brace)
(conj acc text)
(recur (subs text brace) (conj acc (subs text 0 brace))))))))
`(replace-templates* ~text m)))
(macroexpand '(replace-templates "this is a {foo} test" {"foo" foo*}))
;=> (clojure.core/str "this is a " foo* " test")
(println (replace-templates "this is a {foo} test" {"foo" foo*}))
;=> this is a 42 test
(macroexpand '(replace-templates "this is a {foo} test" m))
;=> (user/replace-templates* "this is a {foo} test" user/m)
(println (replace-templates "this is a {foo} test" m))
;=> this is a 42 test
Is there a better way to write this macro? In particular, the expanded version of each value is not getting namespace-qualified.
I would try reduce the repeated stuff. I adjusted the function to use your macro approach of an accumulator and let replace-templates* do the rest via (apply str ...). In that way one can re-use the function in the macro.
(defn extract-snippets
[^String text m]
(loop [text text
snippets []]
(cond
(zero? (count text))
snippets
(.startsWith text "{")
(let [brace (.indexOf text "}")]
(if (neg? brace)
(conj snippets text)
(if-let [[_ replacement] (find m (subs text 1 brace))]
(recur (subs text (inc brace)) (conj snippets replacement))
(recur (subs text 1) (conj snippets \{)))))
:else
(let [brace (.indexOf text "{")]
(if (neg? brace)
(conj snippets text)
(recur (subs text brace) (conj snippets (subs text 0 brace))))))))
(defn replace-templates*
[text m]
(apply str (extract-snippets text m)))
(defmacro replace-templates
[text m]
(if (map? m)
`(apply str ~(extract-snippets text m))
`(replace-templates* ~text ~m)))
Note: in your macro, you didn't unquote the m. So it only works, because you had def'd it before. It wouldn't with (let [m {"a" "b"}] (replace-templates "..." m)).
Change (defn m {"foo" foo*}) to (def m {"foo" foo*}) and it seems to work.

Resources