I am trying to create a program that consumes xyz, with digits in decreasing order, and produces 1089. I have to take xyz, reverse the digits, determine the difference between xyz and it's reverse and call it diff, add diff and it's reverse and then get the answer of 1089. I've been trying for hours but I am unable to figure out how to create the code. So far I have an attempt with only functions but I still can't get it to work. What am I doing wrong?:
1)
(define h 100)
(define t 10)
(define o 1)
(define (front xyz)
(number->string (substring xyz 0 1)))
(define (mid xyz)
(number->string (substring xyz 1 2)))
(define (back xyz)
(number->string (substring xyz 2 3)))
(define (reversexyz xyz)
(string->number (+ (* (back xyz) h) (* (mid xyz) t) (* (front xyz) o))))
(define (diff abc)
(- xyz (reversexyz)))
(define (frontdiff abc)
(number->string (substring frontdiff 0 1)))
(define (middiff abc)
(number->string (substring middiff 1 2)))
(define (backdiff abc)
(number->string (substring backdiff 2 3)))
(define (reversediff xyz)
(number->string (+ (* (backdiff abc) h) (* (middiff abc) t) (* (frontdiff abc) o))))
(define (magic xyz)
(+ diff reversediff))
Based on this explanation this should be as easy as:
(define (pad0 str) ; add leading 0's to a string, 3 characters wide
(~a #:width 3 #:align 'right #:left-pad-string "0" str))
(define (reverse-num n) ; reverse a number
(string->number (list->string (reverse (string->list (pad0 (number->string n)))))))
(define (magic xyz) ; the magic happens here
(define diff (abs (- (reverse-num xyz) xyz)))
(+ diff (reverse-num diff)))
Testing:
> (magic 123)
1089
> (magic 678)
1089
> (magic 321)
1089
> (magic 546)
1089
FWIW, after this modification, there are still 90 numbers between 100 and 999 (inclusive) where the algorithm doesn't work:
> (for/sum ((i (in-range 100 1000)) #:when (not (= (magic i) 1089))) 1)
90
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 :) ^
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 have started to build a small game in racket using the 2htdp/universe library. My code so far:
#lang racket
(require 2htdp/image 2htdp/universe)
(define BIRD-IMG (scale .2 (object:image% ...)) ; Image URL: http://i.stack.imgur.com/Vz26B.png
(struct world (bird) #:transparent)
(struct pos (x y) #:transparent)
(struct bird (pos img) #:transparent)
(define-values (WIDTH HEIGHT)
(values 600 600))
(define DEFAULT-STATE (world (bird (pos (/ WIDTH 2) (/ HEIGHT 2)) BIRD-IMG)))
(define (move-bird w x y dir)
(world
(bird
(pos
(let
([new-x (+ (pos-x (bird-pos (world-bird w))) x)]
[new-y (+ (pos-y (bird-pos (world-bird w))) y)])
(values
(cond
[(> new-x WIDTH) WIDTH]
[(< new-x 0) 0]
[else new-x])
(cond
[(> new-y HEIGHT) HEIGHT]
[(< new-y 0) 0]
[else new-y]))))
(case dir
[("up") BIRD-IMG]
[("down") (rotate 180 BIRD-IMG)]
[("left") (rotate 90 BIRD-IMG)]
[("right") (rotate -90 BIRD-IMG)]
[else (bird-img (world-bird w))]))))
(define (render w)
(place-image (bird-img (world-bird w))
(pos-x (bird-pos (world-bird w)))
(pos-y (bird-pos (world-bird w)))
(empty-scene WIDTH HEIGHT)))
(define (handle-keys w key)
(case key
[("up") (move-bird w 0 -5 key)]
[("down") (move-bird w 0 5 key)]
[("left") (move-bird w -5 0 key)]
[("right") (move-bird w 5 0 key)]
[else w]))
(big-bang DEFAULT-STATE
(on-draw render)
(on-key handle-keys)
(on-tick (lambda (w) w) 20)
(name "Bird Simulator 2016"))
My problem: When I try to press the arrow keys to move the bird in a direction, there is an error in the 'move-bird' function:
result arity mismatch;
expected number of values not received
expected: 1
received: 2
values...:
Running it through DrRacket's debugger, I can see that it is where the variables from the let have gone out of scope, but the program is at a lower level than the outermost world struct. I am confused because the arity mismatch error didn't name any particular place/function, and I certainly don't see any place where more values are given then are required. The world struct is passed only a bird struct, and the bird struct only a pos and an img. It might have to do with the let inside of the pos struct, but I am not sure. Please help!
I'm writing a scheme program for an assignment that creates "planets" when the user clicks, and starts/stops the planets from orbiting each other when a checkbox is clicked. We are supposed to implement this with a thread. However, thread-suspend does not seem to work when I click the checkbox, but resume does.
Thanks for any help you can offer! Here is the code:
#lang racket
(require racket/gui)
(require racket/block)
;; Small 2d vector library for the Newtonian physics
(define (x v) (vector-ref v 0))
(define (y v) (vector-ref v 1))
(define (x! v value) (vector-set! v 0 value))
(define (y! v value) (vector-set! v 1 value))
(define (v* v value) (vector-map (lambda (x) (* x value)) v))
(define (v+ v w) (vector-map + v w))
(define (v- v w) (vector-map - v w))
(define (v-zero! v) (vector-map! (lambda (x) 0) v))
(define (v-dot v w) (let ((vw (vector-map * v w))) (+ (x vw) (y vw))))
(define (v-mag v) (sqrt (v-dot v v)))
(define sem (make-semaphore))
;; Planet object
(define planet%
(class object%
(public m p v calculate-force move draw)
(init-field (mass 1)
(position (vector 0 0 ))
(velocity (vector 0 0 ))
(force (vector 0 0 )))
(define (m) mass)
(define (p) position)
(define (v) velocity)
;; Use Newton's law of gravitation.
;; I assume the gravitational constant is one
(define (calculate-force planet-list)
(v-zero! force)
(for-each (lambda (other-planet)
(when (not (equal? this other-planet))
(let* ((direction (v- (send other-planet p) position))
(dist (max 1 (v-mag direction)))
(other-mass (send other-planet m))
(new-force (v* direction (/ (* mass other-mass) (* dist dist))))
)
(vector-map! + force new-force))))
planet-list)
)
;; Simple Euler integration of acceleration and velocity
(define (move)
(let ((acc (v* force (/ 1.0 mass))))
(vector-map! + velocity acc)
(vector-map! + position velocity)))
;; Draw a circle
(define (draw dc)
(send dc set-brush brush)
(send dc set-pen pen)
(send dc draw-ellipse (x position) (y position) radius radius ))
;; Initialize to random velocity, mass, and color
(x! velocity (random))
(y! velocity (random))
(set! mass (+ 1 (* 10 (random))))
(define radius (* 5 (sqrt mass)))
(define color
(let* ((r (random))
(b (real->floating-point-bytes r 4)))
(make-object color% (bytes-ref b 0) (bytes-ref b 1) (bytes-ref b 2) )))
(define brush (make-object brush% color))
(define pen (make-object pen% color))
;; Don't forget the super-new!
(super-new)
))
;; Abstract the list-handling for a list of planets
(define planet-list%
(class object%
(public add-planet calculate-force move draw)
(init-field (planets '()))
(define (add-planet planet)
(set! planets (cons planet planets)))
(define (calculate-force)
(for-each (lambda (planet)
(send planet calculate-force planets))
planets))
(define (move)
(for-each (lambda (planet)
(send planet move))
planets))
(define (draw dc)
(for-each (lambda (planet)
(send planet draw dc))
planets))
(super-new)
)
)
(define planet-list (new planet-list%))
;; The GUI
(define frame (new frame%
(label "Planets")
(min-width 120)
(min-height 80)
))
(send frame create-status-line)
(send frame show #t)
(define h-panel
(new horizontal-panel%
(parent frame)
(stretchable-height #f)
(style '(border))
(border 2)))
(define run-checkbox
(new check-box%
(parent h-panel)
(label "Run animation")
(callback
(lambda (button event)
(cond [(send run-checkbox get-value)(thread-resume (thread-a))]
[(not (send run-checkbox get-value)) (thread-suspend (thread-a))]
)))
))
(define my-canvas%
(class canvas%
(override on-paint on-event)
(define (on-paint)
(let ((dc (send this get-dc))
(w (send this get-width))
(h (send this get-height)))
(send dc clear)
(send planet-list draw dc)
))
(define (on-event event)
(when (send event button-down?)
(let ((x (send event get-x))
(y (send event get-y)))
(send frame set-status-text (format "Mouse at ~a ~a" x y))
(send planet-list add-planet (new planet% (position (vector x y))))
(send this refresh)))
)
(super-new)
(send (send this get-dc) set-background (make-object color% 8 8 64))
))
(define canvas
(new my-canvas%
(parent frame)
(style '(border))
(min-width 640)
(min-height 480)))
;; planet animator
(define thread-a (lambda ()
(let loop ()
(sleep/yield .1)
(send planet-list calculate-force)
(send planet-list move)
(send canvas refresh)
(loop))))
; this creates the thread-a and starts the program
(thread-suspend (thread thread-a))
It's actually miraculous that you got this working as much as it does.
The problem is that thread-a is not a thread. It's not a function that produces a thread. It's a function that runs forever, moving planets around and updating the canvas.
So when your checkbox's callback does (thread-suspend (thread-a)), for example, the thread-suspend never actually happens. The call to thread-a just starts running and never returns.
The reason the GUI doesn't lock up (which it normally would if an event callback didn't return) is that thread-a periodically calls sleep/yield, which allows the GUI event loop to process more events. (That's why I said the code is miraculous.)
The fix is to define thread-a as the thread itself:
(define thread-a
(thread
(lambda ()
(let loop () ....))))
(thread-suspend thread-a)
and change the other references from (thread-a) to just thread-a.
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)))))))))