Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 8 years ago.
Improve this question
So, I have a Racket struct, stats :
(struct stats (str con dex int wis cha))
And I have a function add-stats:
(define (modify-stats mods base)
(stats (+ (stats-str mods)
(stats-str base))
(+ (stats-con mods)
(stats-con base))
(+ (stats-dex mods)
(stats-dex base))
(+ (stats-int mods)
(stats-int base))
(+ (stats-wis mods)
(stats-wis base))
(+ (stats-cha mods)
(stats-cha base))))
Obviously this is real messy and there's a lot of unwanted repetition involved. I managed to cut it down some to a more-readable version:
(define (modify-stats mods base)
(define (add-stat statid)
(+ (statid mods)
(statid base)))
(stats (add-stat stats-str)
(add-stat stats-con)
(add-stat stats-dex)
(add-stat stats-int)
(add-stat stats-wis)
(add-stat stats-cha)))
But there's still a lot of repetition of "stat(s)" in there. Is there a cleaner way I can preform operations on the fields of two structs of the same type?
UPDATE:
I've managed to make it a little better like so:
(define (stat a-stat stats)
(match a-stat
["str" (stats-str stats)]
["con" (stats-con stats)]
["dex" (stats-dex stats)]
["int" (stats-int stats)]
["wis" (stats-wis stats)]
["cha" (stats-cha stats)]
[_ (error "Not a stat!")]))
(define (modify-stats mods base)
(define (add-stat string)
(+ (stat string mods)
(stat string base)))
(stats (add-stat "str")
(add-stat "con")
(add-stat "dex")
(add-stat "int")
(add-stat "wis")
(add-stat "cha")))
Without resorting to reflection, here's one way to do it:
(define (modify-stats mods base)
(define (get-fields obj)
(map (lambda (getter) (getter obj))
(list stats-str stats-con stats-dex stats-int stats-wis stats-cha)))
(apply stats (map + (get-fields mods) (get-fields base))))
Loath as I am to suggest using macros to improve performance, this macro generates exactly the same code as the OP's first version:
(require (for-syntax racket/syntax))
(define modify-stats
(let-syntax
((bump (lambda (stx)
(define (bump-attr attr)
(with-syntax ((getter (format-id attr "stats-~a" attr #:source attr)))
#'(+ (getter mods) (getter base))))
(syntax-case stx ()
((_ attr ...)
(with-syntax (((bumped ...) (map bump-attr (syntax->list #'(attr ...)))))
#'(lambda (mods base)
(stats bumped ...))))))))
(bump str con dex int wis cha)))
Related
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 :) ^
In the Haskell source code file:
-- >>> sin 5
Typing a shortcut key, you get the results below:
-- λ> sin 5
-- -0.9589242746631385
-- it :: Floating a => a
-- (0.03 secs, 133,480 bytes)
This feature is quite handy.
Does anyone know how to do it with Emacs?
I managed to modify the haskell-mode code:
(require 'subr-x)
(defun my-run-haskell-expr ()
"Get haskell expression"
(interactive)
(search-backward "-- >>>")
(setq my-expr
(string-remove-prefix "-- >>>" (buffer-substring-no-properties (line-beginning-position) (line-end-position))))
(my-haskell-interactive-mode-run-expr my-expr)
)
(defun my-haskell-interactive-mode-run-expr (expr)
"Run the given expression."
(let ((session (haskell-interactive-session))
(process (haskell-interactive-process)))
(haskell-process-queue-command
process
(make-haskell-command
:state (list session process expr 0)
:go (lambda (state)
;; (goto-char (point-max))
;; (insert "\n")
(end-of-line)
(insert "\n")
(beginning-of-line)
(setq haskell-interactive-mode-result-end
(point-max))
(haskell-process-send-string (cadr state)
(haskell-interactive-mode-multi-line (cl-caddr state)))
(haskell-process-set-evaluating (cadr state) t))
:complete
(lambda (state response)
(haskell-process-set-evaluating (cadr state) nil)
(unless (haskell-interactive-mode-trigger-compile-error state response)
(my-haskell-interactive-mode-expr-result state response)))))))
(defun my-haskell-interactive-mode-expr-result (state response)
"Print the result of evaluating the expression."
;; (mapc 'insert (split-string-and-unquote response))
(mapc (lambda (str) (progn
(insert "-- ")
(insert str)
(insert "\n")))
(split-string-and-unquote response "\n")))
(global-set-key (kbd "C-c C-e") 'my-run-haskell-expr)
;; end of haskell inline evaluation
Just bind the function my-get-haskell-expr to a shortcut and it will work.
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.
I fully understand the use of list in lisp but I 've got problem using string.
I try to write my own code of functions like string> or string< from common lisp to understand how lisp deals with string.
For example, abcde is bigger than abbb and returns 1.
I think that I will use the char function or do you think that I must use subseq ? or function that deals with ASCII code ?
Here are cases that I found :
-character 0 of each string are equal, we continue, with the next character.
-charactere 0 are different, one is smaller that other, we stop.
I need help about "go to the next character".
Thanks a lot !!
This is the Common Lisp version. You can just use ELT because
(type-of "a") => (SIMPLE-ARRAY CHARACTER (1))
(defun my-string< (a b &key (start 0))
(cond
((= start (length a) (length b))
nil)
((>= start (min (length a) (length b)))
(error "Undefined"))
((char= (elt a start) (elt b start))
(my-string< a b :start (1+ start)))
((char< (elt a start) (elt b start))
t)))
This is an implementation of a function that given two strings will return either -1, 0 or +1 depending on if the first is less than, equal or greater than the second.
In case one string is the initial part of the other then shorter string is considered to be "less than" the longer.
The algorithm is very simple... loops for every char until either the index gets past one of the strings or if a character is found to be different.
(defun strcmp (a b)
(do ((i 0 (1+ i))
(na (length a))
(nb (length b)))
((or (= i na) (= i nb) (char/= (elt a i) (elt b i)))
(cond
((= i na nb) 0) ;; Strings are identical
((= i na) -1) ;; a finished first
((= i nb) 1) ;; b finished first
((char< (elt a i) (elt b i)) -1) ;; Different char a < b
(t 1))))) ;; Only remaining case
(defun test (a b)
(format t "(strcmp ~s ~s) -> ~s~%"
a b (strcmp a b)))
(test "abc" "abc")
(test "ab" "abc")
(test "abc" "ab")
(test "abd" "abc")
(test "abc" "abd")
The output is
(strcmp "abc" "abc") -> 0
(strcmp "ab" "abc") -> -1
(strcmp "abc" "ab") -> 1
(strcmp "abd" "abc") -> 1
(strcmp "abc" "abd") -> -1
Your problem has been solved already but in case you run into others,
the following method might be useful:
I installed SBCL from source and keep the source around.
That allows me to run M-. on a function name like string<
and it will jump to the definition in your lisp implementation.
In my case I ended up at this macro:
;;; LESSP is true if the desired expansion is for STRING<* or STRING<=*.
;;; EQUALP is true if the desired expansion is for STRING<=* or STRING>=*.
(sb!xc:defmacro string<>=*-body (lessp equalp)
(let ((offset1 (gensym)))
`(with-two-strings string1 string2 start1 end1 ,offset1 start2 end2
(let ((index (%sp-string-compare string1 start1 end1
string2 start2 end2)))
(if index
(cond ((= (the fixnum index) (the fixnum end1))
,(if lessp
`(- (the fixnum index) ,offset1)
`nil))
((= (+ (the fixnum index) (- start2 start1))
(the fixnum end2))
,(if lessp
`nil
`(- (the fixnum index) ,offset1)))
((,(if lessp 'char< 'char>)
(schar string1 index)
(schar string2 (+ (the fixnum index) (- start2 start1))))
(- (the fixnum index) ,offset1))
(t nil))
,(if equalp `(- (the fixnum end1) ,offset1) nil))))))
) ; EVAL-WHEN
There is no direct concept of iteration ("next") with strings, in Scheme. That only applies to lists. So instead you have to iterate with indices:
(define (string<? lhs rhs)
(let* ((lhslen (string-length lhs))
(rhslen (string-length rhs))
(minlen (min lhslen rhslen)))
(let loop ((i 0))
(if (= i minlen) (< lhslen rhslen)
(let ((lhschar (string-ref lhs i))
(rhschar (string-ref rhs i)))
(cond ((char<? lhschar rhschar) #t)
((char<? rhschar lhschar) #f)
(else (loop (+ i 1)))))))))
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.