Displaying x & y coordinate with mouse handler - racket

"Pictured Programs" http://www.facom.ufu.br/~marcelo/PF/pictures_racket.pdf Ch.10 (final exercise 10.2.6) is the book I'm working out of.
I'm trying to use what has been introduced in the book in a linear fashion. The exercise wants an animation that displays the x & y coordinates on the window.
This must be done without conditionals, loops, built-in functions not mentioned, & etc...
I'm having trouble writing the mouse-handler handling the x-mouse & y-mouse in the same expression.
I can't think of a way to track them both (ie... I need a space between the two coordinates in the same mh without throwing an error.
(define (number->image s)
(text (string-append "(" (number->string s)")" "("(number->string s) ")" ) 18 "blue"))
(define (show-coord s)
(number->image s)))
(define (mh s mouse-x mouse-y me)
(string->number (string-append
(number->string mouse-x)
(number->string mouse-y))))
(define (string-world s)
(big-bang s
(check-with number?)
(on-draw show-coord 200 200)
(on-mouse mh)))
(string-world 0)

Instead of returning a number from the mouse handler, how about returning a list of coordinates? Then the list of coordinates can be converted to an appropriate string representation before calling text.
Since the world state is now a list instead of a number, the check-with predicate will need to be changed:
#lang racket
(require picturing-programs)
(define (coord->image s)
(text (string-append "("
(number->string (first s))
" "
(number->string (second s))
")")
18 "blue"))
(define (show-coord s)
(coord->image s))
(define (mh s mouse-x mouse-y me)
(list mouse-x mouse-y))
(define (string-world s)
(big-bang s
(check-with list?)
(on-draw show-coord 200 200)
(on-mouse mh)))
(string-world '(0 0))
Update
OP says that lists have not been introduced in the book yet. OK. We need some way to return the information that we want to display. Let's just return a string! Don't forget that the check-with predicate and the initial world state must match our new approach:
#lang racket
(require picturing-programs)
(define (coord->image s)
(text s 18 "blue"))
(define (show-coord s)
(coord->image s))
(define (mh s mouse-x mouse-y me)
(string-append "("
(number->string mouse-x)
" "
(number->string mouse-y)
")"))
(define (string-world s)
(big-bang s
(check-with string?)
(on-draw show-coord 200 200)
(on-mouse mh)))
(string-world "")

Related

Substring: Starting index out of range with big-bang

"Pictured Programs" http://www.facom.ufu.br/~marcelo/PF/pictures_racket.pdf is the book I'm working out of and Ch.10. I'm trying to use what has been introduced in the book in a linear fashion. The program is suppose to cut the first character off of the string when a mouse moves or clicks which it does, but I can't find a way to stop it from throwing the out of range error.
I've tried several different approaches and spent hours on it unfortunately. This must be done without conditionals, loops, built-in functions not mentioned yet, & etc...
Any tips would be appreciated.
Here is the actual Exercise questions.
(require picturing-programs)
(define (add-str s)
(string-append s "b"))
(define (a-with-b s)
(text s 18 "green"))
(define (chop-first-on-mouse s mouse-x mouse-y me)
(substring s 1 (string-length s)))
(define (string-world s)
(big-bang s
(check-with string?)
(on-tick add-str 1/2)
(on-draw a-with-b 200 200)
(on-mouse chop-first-on-mouse)))
(string-world "a")
So in order to improve the program, there was one piece of code added to the function definition (chop-first-on-mouse ...), which was the built-in function (min). This was the only change that was needed to obtain the desired results.
This appears to give the desired output because the newly defined/refined call to "chop-first-on-mouse" now only deletes one char at a time and also does not throw an error(always stays within range of substring parameters).
While before the original call to "chop-first-on-mouse" would go out of range and it would also delete chars too quickly to analy 's/z' e.
(require picturing-programs)
(define (add-str s)
(string-append s "b"))
(define (a-with-b s)
(text s 18 "green"))
# Only change to program is the built-in function (min) in the substring call below
(define (chop-first-on-mouse s mouse-x mouse-y me)
(substring s (min 1 (string-length s))))
(define (string-world s)
(big-bang s
(check-with string?)
(on-tick add-str 1/2)
(on-draw a-with-b 200 200)
(on-mouse chop-first-on-mouse)))
(string-world "a" )

Scheme racket question about finding vowels in str

I tried to write a code about get-vowels and its running 100% but I'm trying to show these 4 output,
I just want to show these 4 output as well and I couldn't find a solution.
> (define vowels (string->list "aeiouyæøå"))
> (define (vowel? c)
(member c vowels))
> (define (filter p xs)
(define (more) (filter p (cdr xs)))
(cond
((null? xs) '())
((p (car xs)) (cons (car xs) (more)))
(else (more))))
> (define (count-vowels s)
(length (filter vowel? (string->list s))))
> (display (count-vowels "foobarbaz"))
4
example:
output:
4
"ooaa"
You shouldn't name a procedure filter, it clashes with a built-in procedure that does exactly the thing that you intend. In fact, you just need to delete your filter implementation and it'll work :)
(define vowels (string->list "aeiouyæøå"))
(define (vowel? c)
(member c vowels))
(define (count-vowels s)
(length (filter vowel? (string->list s))))
; there's a bit of code duplication here, you could
; refactor it if you want, to avoid repeating yourself
(define (extract-vowels s)
(list->string (filter vowel? (string->list s))))
(count-vowels "foobarbaz")
=> 4
(extract-vowels "foobarbaz")
=> "ooaa"

Use function within a function

I have a function called clean-up which basically does what the already available flatten function does. I then have a function called multiplier, which takes in a list and multiplies all the numbers within it. The one issue is that sometimes there could be a weird syntax for the list used in multiplier, and it doesn't multiply every number together. For example:
Example Input
(multiplier '((1 (2 3)) 4 5 (6)))
Correct Output
720
My Output
*: contract violation
expected: number?
given: '(6 . 1)
argument position: 2nd
other arguments...
We don't like errors now do we? This multiplier function works in a normal-looking list, something like (multiplier '(1 2 3 4 5 6)). So I wrote the clean-up function to turn some confusing-looking list into a normal-looking list. However, I don't know how to call it to clean-up my list before trying to parse through and do the multiplication. I can verify that the clean-up function does its job perfectly. Can anyone help? Here is the code I have for both:
(define (clean-up s)
(cond [(null? s) '()]
[(not (pair? s)) (list s)]
[else (append (clean-up (car s)) (clean-up (cdr s)))]
))
(define multiplier
(lambda (s)
(cond [(null? s) 1]
[(number? (car s)) (* (car s) (multiplier(cdr s)))]
[list? (car s) (append (car s) (multiplier(cdr s)))]
[else (multiplier (cdr s))]
)))
There is no need for the clean-up function to solve the problems encountered in multiplier. However, you could call clean-up on the input first simply with:
scratch.rkt> (multiplier (clean-up '((1 (2 3)) 4 5 (6))))
720
Or, you could create a helper function to do this for you:
(define (multiplier-workaround s)
(multiplier (clean-up s)))
scratch.rkt> (multiplier-workaround '((1 (2 3)) 4 5 (6)))
720
A workaround like this might help you out in a pinch, but it does not fix the real problems in the code.
Some of the problems here may be easier to see with better code formatting. It is bad style to leave hanging parentheses in Lisps as if these are C-style languages; but that probably isn't causing you problems here. Yet it is good style to show the structure of your expressions using indentation. With proper indentation it becomes apparent that there are missing parentheses in the line with the list? predicate:
(define multiplier
(lambda (s)
(cond [(null? s) 1]
[(number? (car s))
(* (car s) (multiplier(cdr s)))]
[list? (car s)
(append (car s) (multiplier (cdr s)))]
[else
(multiplier (cdr s))])))
Further investigation of that line shows that the code is attempting to append (car s) to the result of (multiplier (cdr s)); yet, (car s) is now known to be a list, and multiplier is supposed to return a number! The intention here was surely to multiply the result of calling multiply on the list (car s) together with the result of (multiplier (cdr s)):
(define multiplier
(lambda (s)
(cond [(null? s) 1]
[(number? (car s))
(* (car s)
(multiplier (cdr s)))]
[(list? (car s))
(* (multiplier (car s))
(multiplier (cdr s)))]
[else
(multiplier (cdr s))])))
It isn't clear why the else branch is needed, unless OP wants to be able to process lists such as (a (1 (2 b) (3 (c (4 5) 6) d) e))). For code that is expecting nested lists of numbers, this would be fine:
(define multiplier-2
(lambda (s)
(cond [(null? s) 1]
[(number? (car s))
(* (car s) (multiplier (cdr s)))]
[else
(* (multiplier (car s))
(multiplier (cdr s)))])))
Both functions now work for OP example expression, and the corrected OP code also works for input with spurious values:
scratch.rkt> (multiplier '((1 (2 3)) 4 5 (6)))
720
scratch.rkt> (multiplier-2 '((1 (2 3)) 4 5 (6)))
720
scratch.rkt> (multiplier '(a (1 (2 3)) 4 5 b (6) c))
720
I think buildin flatten have more error handling.
(define (multiplier lst)
(apply * (filter number? (flatten lst))))
;;; TEST
(define test-lst1 (list + (vector 1) '(1 (2 3) c) "w" 4 5 '(6) + - * sqr))
(define test-lst2 '(1(a 2(3 b (c 4(d 5 e(6) (f)))))))
(multiplier test-lst1) ; 720
(multiplier test-lst2) ; 720

LISP extract an element from a list only in a specific case

The function i'm looking for has to return the index of the first , that is out of a pair of " ".
For example, with the sequence
{ " h i , a l l " : 3 , " h o w , i s " : " x " }
'( #\{ #\" #\h #\i #\, #\a #\l ... )
The function should return 11, not 4 (first occurrence of comma) because it is between " ".
I tried with this:
(defun control-comma (x p)
(cond ((eql (car x) #\")
(control-comma (subseq x (+ (position #\" x :start (+ 1 p)) 1)) p))
((eql (car x) #\,)
p)
(t
(control-comma (cdr x) (+ 1 p)))
)
)
Using x as list of input and p as a 0-parameter to count the position, but it doesn't work and seems to be far away from the solution i'm looking for.
Thank you for every suggestion.
Instead of defining a complex function, I suggest you to use the predefined position-if operator:
(defun first-comma (string start)
(let ((in-double-quote nil))
(position-if
(lambda (x)
(case x
((#\") (progn (setf in-double-quote (not in-double-quote)) nil))
((#\,) (not in-double-quote))))
string
:start start)))
CL-USER> (first-comma (coerce "{ \"hi, all\" : 3, \"how, is\" : \"x\" }" 'list) 0)
15
A more complex, recursive solution based again on the idea of scanning the input list one character at time, is given by the following function, where the state “inside double-quote” is encoded through a couple of recursive local functions:
(defun fist-comma (x pos)
(labels ((looking-for-comma (x pos)
(cond ((null x) nil)
((eql (car x) #\,) pos)
((eql (car x) #\") (looking-for-double-quote (cdr x) (1+ pos)))
(t (looking-for-comma (cdr x) (1+ pos)))))
(looking-for-double-quote (x pos)
(cond ((null x) nil)
((eql (car x) #\") (looking-for-comma (cdr x) (1+ pos)))
(t (looking-for-double-quote (cdr x) (1+ pos))))))
(looking-for-comma (nthcdr pos x) pos)))
Finally, note that in both the above functions one should take into account possible escaping of the double quote with appropriate means.

override/overload the + operator to operate on common lisp vectors

I wish to overload the + operator to work on common lisp vectors -- just as it would for vectors in linear algebra. Is it possible to overload with the + operator?
Here is my intended definition:
(defmethod + ((v1 vector) (v2 vector))
Thanks in advance for all the help!
If I were to do this, I would start by doing it in a separate package. I would then write a general function that uses binary operators:
(defun + (&rest addends)
(reduce #'binary+ (cdr addends) :initial-value (car addends)))
(defgeneric binary+ (addend1 addend2))
Then you can define methods on the generic function binary+ that would allow you to add two vectors, a vector and a scalar, ...
Something that would be a suitable wrapper-generating macro:
(defmacro define-operator (op &key (binary-signifier :binary) (package *package*)
"Defines a generic operator OP, being essentially a reduce operation using
a generic function whose name is a concatenation of BINARY-SIGNIFIER and OP."
(let ((op op)
(binary (intern (concatenate 'string
(string binary-signifier)
(string op))
package)))
`(progn
(defun ,op (&rest args)
(reduce (function ,binary) (cdr args) :initial-value (car args)))
(defgeneric ,binary (arg1 arg2)))))
Then you can define methods, as per Joshua Taylor's answer:
(defmethod binary+ ((x number) (y number))
(cl:+ x y))
(defmethod binary+ ((x vector) (y vector))
(map 'vector 'cl:+ x y))
(defmethod binary+ ((x list) (y list))
(map 'list 'cl:+ x y))
This is an extension of Vatine's answer, but with some more detail to make the implementaiton clearer:
(defpackage #:generic-arithmetic
(:use "COMMON-LISP")
(:shadow "+"))
(in-package #:generic-arithmetic)
(defun + (&rest addends)
(reduce 'binary+ (cdr addends) :initial-value (car addends)))
(defgeneric binary+ (addend1 addend2))
(defmethod binary+ ((x number) (y number))
(cl:+ x y))
(defmethod binary+ ((x vector) (y vector))
(map 'vector 'cl:+ x y))
(defmethod binary+ ((x list) (y list))
(map 'list 'cl:+ x y))
(+ 1 1)
;=> 2
(+ #(1 2) #(0 -1))
;=> #(1 1)
(+ '(1 3) '(3 1))
;=> (4 4)
It's probably not a good idea to define generic function +, because, well, this symbol is locked. CLOS is different from object systems in other languages, such as C++, so term `overload' is probably not quite correct.
Actually, you do not need a special function to sum vectors, use map:
CL-USER> (let ((v0 #(1 2 3))
(v1 #(4 5 6)))
(map 'vector #'+ v0 v1))
#(5 7 9)
It's possible to redefine + if you shadow it first:
? (shadow '+)
? (defgeneric + (a &rest b))
? (defmethod + ((a number) &rest b) (apply 'cl:+ a b))
? (+ 1 2)
3
? (+ 2 3 4)
9
? (defmethod + ((a string) &rest b) (apply #'cl:concatenate 'string a b))
? (+ "Hello" "World")
"HelloWorld"
? (+ "Hello" " cruel " "World")
"Hello cruel World"
? (defmethod + ((a vector) &rest b) (apply #'map 'vector 'cl:+ a b))
? (let ((v0 #(1 2 3)) (v1 #(4 5 6))) (+ v0 v1))
#(5 7 9)