I am new to racket. Please help me.
In my code, I defined show1. When I call show1 from within another function, the bit image is not being drawn. But, when I call the function separately, as (show1 a), it works.
is there any solution to print out of show1 function
(require racket/draw)
(require racket/gui)
(define target (make-bitmap 60 60)) ; A 30x30 bitmap
(define dc (new bitmap-dc% [bitmap target]))
(define board
(lambda(ls call x y)
;(send dc draw-rectangle
; 0 0 ; Top-left at (0, 10), 10 pixels down from top-left
; 60 60)
(if (even? call)
(send dc set-brush "lightblue" 'solid)
(send dc set-brush "white" 'solid))
(send dc set-pen "black" 0 'transparent)
(send dc draw-rectangle x y 20 20)
(cond
[(equal? (list-ref ls call) 'x)(printx x y) ]
[(equal? (list-ref ls call) 'o)(printy x y) ]
[(number? (list-ref ls call)) ])
(cond
[(< call 2) (board ls (+ call 1) (+ x 20) 0)]
[(= call 2) (board ls (+ call 1) 0 20)]
[(and (> call 2) (< call 5)) (board ls (+ call 1) (+ x 20) 20)]
[(= call 5) (board ls (+ call 1) 0 40)]
[(and (> call 5) (< call 8)) (board ls (+ call 1) (+ x 20) 40)])
target))
(define printx
(lambda (x y)
(send dc set-pen "red" 2 'solid)
(send dc draw-line x y (+ x 18) (+ y 18))
(send dc draw-line (+ x 18) y x (+ y 18))))
(define printy
(lambda (x y)
(send dc set-pen "red" 2 'solid)
(send dc set-brush "green" 'transparent)
(send dc draw-rounded-rectangle x y 20 20 10)))
(require unstable/list)
(require racket/mpair)
(define sot 3)
(define a (build-list (* sot sot) values))
(define dummy 1)
(define play1
(lambda (dummy)
(set! dummy (+ 1 dummy))
(play (- dummy 1))
(play1 dummy)
))
(define show1
(lambda (ls)
(board a 0 0 0)))
" 0 1 2"
" 3 4 5"
" 6 7 8"
(newline)
(printf "Above shown is the address of the tic-tac-toe box \n")
;(newline)
(define firs
(lambda (value addr pla)
(cond
[(> addr (- (* sot sot) 1)) (error "input error run it again")]
[(number? (list-ref a addr)) (set! a (list-set a addr pla)) (show1 a) (win a)]
[else (printf "error the box is already filled run it again\n") (firs value (read) pla)] )show1))
;(set! dummy (- dummy 1))
;[(error "error the box is already filled run it again")]
(define play
(lambda (dummy)
(cond
[(> dummy (* sot sot)) (printf "MATCH DRAW \n")(exit)]
[(even? dummy) (print "second player") (newline) (set! dummy (+ 1 dummy))(firs dummy (read) 'o)]
[(not (even? dummy)) (print "first player")(newline) (firs dummy (read) 'x)])))
(define win
(lambda (a)
(cond [(and (equal? (list-ref a 0) (list-ref a 3)) (equal? (list-ref a 0) (list-ref a 6))) (cond [(equal? (list-ref a 0) 'x) (print "player 1 wins")(newline) (exit)]
[(equal? (list-ref a 0) 'o) (print "player 2 wins")(newline) (exit)])]
[(and (equal? (list-ref a 1) (list-ref a 4)) (equal? (list-ref a 1) (list-ref a 7))) (cond [(equal? (list-ref a 1) 'x) (print "player 1 wins")(newline) (exit)]
[(equal? (list-ref a 1) 'o) (print "player 2 wins")(newline) (exit)])]
[(and (equal? (list-ref a 2) (list-ref a 5)) (equal? (list-ref a 2) (list-ref a 8))) (cond [(equal? (list-ref a 2) 'x) (print "player 1 wins")(newline) (exit)]
[(equal? (list-ref a 2) 'o) (print "player 2 wins")(newline) (exit)])]
[(and (equal? (list-ref a 0) (list-ref a 1)) (equal? (list-ref a 0) (list-ref a 2))) (cond [(equal? (list-ref a 0) 'x) (print "player 1 wins")(newline) (exit)]
[(equal? (list-ref a 0) 'o) (print "player 2 wins")(newline) (exit)])]
[(and (equal? (list-ref a 3) (list-ref a 4)) (equal? (list-ref a 3) (list-ref a 5))) (cond [(equal? (list-ref a 3) 'x) (print "player 1 wins")(newline) (exit)]
[(equal? (list-ref a 3) 'o) (print "player 2 wins")(newline) (exit)])]
[(and (equal? (list-ref a 6) (list-ref a 7)) (equal? (list-ref a 6) (list-ref a 8))) (cond [(equal? (list-ref a 6) 'x) (print "player 1 wins")(newline) (exit)]
[(equal? (list-ref a 6) 'o) (print "player 2 wins")(newline) (exit)])]
[(and (equal? (list-ref a 0) (list-ref a 4)) (equal? (list-ref a 0) (list-ref a 8))) (cond [(equal? (list-ref a 0) 'x) (print "player 1 wins")(newline) (exit)]
[(equal? (list-ref a 0) 'o) (print "player 2 wins")(newline) (exit)])]
[(and (equal? (list-ref a 2) (list-ref a 4)) (equal? (list-ref a 2)(list-ref a 6))) (cond [(equal? (list-ref a 2) 'x) (print "player 1 wins")(newline) (exit)]
[(equal? (list-ref a 2) 'o) (print "player 2 wins")(newline) (exit)])]
[else (board a 0 0 0)]
)));[(equal? value 8) (newline)"match draw"])))
(show1 a)
(play1 dummy)
Wow! A lot of code. I have a meta-suggestion, and a suggestion.
1) Meta-suggestion: programming is all about learning how to figure out problems by yourself. In this case, you want to see if you can strip out the parts of this giant program that don't affect the answer, to find a small program that shows the problem.
2) In this case, I think your problem is simply that values are printed when they're the result of top-level expressions, and not otherwise. To take a simple example, compare
#lang racket
(+ 3 4)
with
#lang racket
(+ (+ 1 2) 4)
Why doesn't the second one print "3", which is the result of (+ 1 2) ? It appears to me that this is the same reason that the result of show1 is not being displayed.
Caveat: per point #1, it's hard to read the code because there's so much of it...
Related
I am trying to produce a list of lists which has *.
Here is what I have so far:
(define (position loc count)
(cond [(empty? loc)empty]
[else (cons (list (first loc) count)
(position (rest loc) (add1 count)))]
))
So:
(position (string->list "**.*.***..") 0)
would produce:
(list
(list #\* 0) (list #\* 1) (list #\. 2) (list #\* 3) (list #\. 4) (list #\* 5)
(list #\* 6) (list #\* 7) (list #\. 8) (list #\. 9))
Basically I am trying to get
(list (list (list #\* 0) (list #\* 1))
(list (list #\* 3))
(list (list #\* 5)(list #\* 6) (list #\* 7)))
I thought about using foldr but not sure if that will work. Any help would be appreciated.
It's not exactly a foldr solution though, you need a function that modifies it's behaviour based on prior input in order to group the continuous star characters. Check out my use of a boolean to switch behaviour upon finding a match.
(define (combine-continuous char L)
(let loop ((L L) (acc '()) (continuing? #t))
(cond ((null? L) (list (reverse acc)))
((equal? (caar L) char)
(if continuing?
(loop (cdr L) (cons (car L) acc) #t)
(cons (reverse acc)
(loop (cdr L) (list (car L)) #t))))
(else (loop (cdr L) acc #f)))))
(combine-continuous #\* (position (string->list "**.*.***..") 0))
=->
;Value 19: (((#\* 0) (#\* 1)) ((#\* 3)) ((#\* 5) (#\* 6) (#\* 7)))
I'm trying to make a function that takes a non-empty string representing a Racket function and an index of that string. If the index refers to a right parenthesis, then the index of the matching left parentheses is returned. Else false.
> (find-paren "(if (zero? x) (* 2 x) x)" 11)
false
> (find-paren "(if (zero? x) (* 2 x) x)" 12)
4
> (find-paren "(+ (* 2 (- 5 3)) (/ (+ 4 2) 3))" 14)
8
> (find-paren "(+ (* 2 (- 5 3)) (/ (+ 4 2) 3))" 15)
3
> (find-paren "(+ (* 2 (- 5 3)) (/ (+ 4 2) 3))" 30)
0
And I'm trying to do this the quickest way possible so no explode, substring, string->list, string-ith.` I've been stuck on this problem for almost an hour now. If the string was symetric then my function would work:
(define (find-paren expr i)
(cond [(not (equal? #\) (string-ref expr i))) false]
[else (- (string-length expr) i)]))
But it's not symmetric. I also created a function that counts how many times a character appears in a string, but I'm not sure if it would help that much:
(define (char-count c s)
(local [(define (loop i count)
(cond
[(negative? i) count]
[(char=? c (string-ref s i))
(loop (sub1 i) (add1 count))]
[else
(loop (sub1 i) count)]))]
(loop (sub1 (string-length s)) 0)))
Any help would be great in ISL+
If you are to work with actual Racket expression, you will sooner rather than later need to turn the string representation into a list of tokens using a lexer.
The program below shows how to find pairs of matching left and right parentheses.
Given that list, it is easy to find the left parenthesis that match a given right parenthesis.
If you a solution that works directly on the string representation, you need to mimick the algorithm in pair-parens-loop.
; a TOKEN consists of a lexeme (a 'left, 'right or a char)
; and the position from which the lexeme was read.
(define-struct token (lexeme pos))
; left? and right? checks whether the token was a left or right parenthesis respectively.
(define (left? t) (eq? (token-char t) 'left))
(define (right? t) (eq? (token-char t) 'right))
; lex : string -> list-of-tokens
; lex the whole string
(define (lex s)
(lex-loop s 0))
; lex-loop : string natural -> list-of-tokens
; lex-loop the part of the string that begins with position p
(define (lex-loop s p)
(cond
[(= p (string-length s)) '()]
[(char=? (string-ref s p) #\() (cons (make-token 'left p) (lex-loop s (+ p 1)))]
[(char=? (string-ref s p) #\)) (cons (make-token 'right p) (lex-loop s (+ p 1)))]
[else (lex-loop s (+ p 1))]))
; pair-parens : list-of-tokens -> list-of-list-of-tokens
; return a list of mathcing left/right tokens
(define (pair-parens ts)
(pair-parens-loop ts '() '()))
(define (pair-parens-loop ts pending found)
(cond
[(empty? ts) found]
[(left? (first ts))
(pair-parens-loop (rest ts) (cons (first ts) pending) found)]
[(right? (first ts))
(pair-parens-loop (rest ts) (rest pending) (cons (list (first pending) (first ts)) found))]
[else (error)]))
;;;
;;; EXAMPLE
;;;
> (lex "(if (zero? x) (* 2 x) x)")
(list
(make-token 'left 0)
(make-token 'left 4)
(make-token 'right 12)
(make-token 'left 14)
(make-token 'right 20)
(make-token 'right 23))
> (pair-parens (lex "(if (zero? x) (* 2 x) x)"))
(list
(list (make-token 'left 0) (make-token 'right 23))
(list (make-token 'left 14) (make-token 'right 20))
(list (make-token 'left 4) (make-token 'right 12)))
I'm trying to create a function to count all the elements in a list, including the elements of its sublists. initially, to get started, i came up with a basic function myList:
(define myLength
(lambda (L)
(cond
((null? L) 0)
(else (+ 1 (myLength (cdr L)))))))
However, it doesn't help me account for function calls like:
(numAtoms '()) "...should be 0"
(numAtoms '(())) "...should be 0"
(numAtoms '(1 1)) "...should be 2"
(numAtoms '(1 (1 1) 1)) "...should be 4"
(numAtoms '(1 (1 (1 1)) 1)) "...should be 5"
I'm trying to use basic functions like length, null?, and list?.
I think the trick here is to imagine how you can transform your input into the code that you'd want to use to compute the sum. Let's write each of your inputs in the fully expanded form, in terms of cons and '() and whatever other atoms appear in your data:
'() == '()
'(()) == (cons '() '())
'(1 1) == (cons 1 (cons 1 '()))
'(1 (1 1) 1) == (cons 1 (cons 1 (cons 1 '())) (cons 1 '()))
'(1 (1 (1 1)) 1) == ...
Now, look what would happen if you replaced each occurrence of cons with +, and each occurrence of '() with 0, and each occurrence of something that's not '() with 1. You'd have:
'() => 0 == 0
(cons '() '()) => (+ 0 0) == 0
(cons 1 (cons 1 '())) => (+ 1 (+ 1 0)) == 2
(cons 1 (cons 1 (cons 1 '())) (cons 1 '())) => (+ 1 (+ 1 (+ 1 0)) (+ 1 0)) == 4
... => ... == ...
Notice that those sums are exactly the values that you want! Based on this, it seems like you might not want to treat your input as a list so much as a tree built from cons cells. In general, you can map over a tree by specifying a function to apply to the recursive results of processing a pair, and a function to process the atoms of the tree:
(define (treeduce pair-fn atom-fn tree)
(if (pair? tree)
(pair-fn (treeduce pair-fn atom-fn (car tree))
(treeduce pair-fn atom-fn (cdr tree)))
(atom-fn tree)))
You could then implement that mapping of cons to + and everything else to 1 if it's a list and 0 if it's not by:
(define (non-null-atoms tree)
(treeduce +
(lambda (atom)
(if (not (null? atom))
1
0))
tree))
This yields the kinds of results you'd expect:
(non-null-atoms '()) ;=> 0
(non-null-atoms '(())) ;=> 0
(non-null-atoms '(1 1)) ;=> 2
(non-null-atoms '(1 (1 1) 1)) ;=> 4
(non-null-atoms '(1 (1 (1 1)) 1)) ;=> 5
Here is a recursive template you can use:
(define (num-atoms lst)
(cond ((pair? lst) (+ (num-atoms <??>)
(num-atoms <??>)))
((null? lst) <??>) ; not an atom
(else <??>))) ; an atom
This next example uses a helper that has the accumulated value (num) as an argument.
(define (num-atoms lst)
;; locally defined helper
(define (helper num lst)
(cond ((pair? lst) (helper (helper <??> <??>) <??>)) ; recurse with the sum of elements from car
((null? lst) <??>) ; return accumulated value
(else (helper <??> <??>)))) ; recurse with add1 to num
;; procedure starts here
(helper 0 lst))
Hope it helps
Make my-length work for any argument type, list or 'atom'; then the recursive algorithm becomes almost trivial:
(define (my-length l)
(cond ((null? l) 0)
((list? l) (+ (my-length (car l)) (my-length (cdr l))))
(else 1))) ; atom
> (my-length '(1 (1 (1 1)) 1)))
5
in "The Scheme Programming Language 4th Edition", there is a example as below:
(define product
(lambda (ls)
(call/cc
(lambda (break)
(let f ([ls ls])
(cond
[(null? ls) 1]
[(= (car ls) 0) (break 0)]
[else (* (car ls) (f (cdr ls)))]))))))
(product '(1 2 3 4 5)) => 120
(product '(7 3 8 0 1 9 5)) => 0
later it is converted into CPS in 3.3 as below
(define product
(lambda (ls k)
(let ([break k])
(let f ([ls ls] [k k])
(cond
[(null? ls) (k 1)]
[(= (car ls) 0) (break 0)]
[else (f (cdr ls)
(lambda (x)
(k (* (car ls) x))))])))))
(product '(1 2 3 4 5) (lambda (x) x)) => 120
(product '(7 3 8 0 1 9 5) (lambda (x) x)) => 0
I want to do it myself, The corresponding CPS is below
(define (product ls prod break)
(cond
((null? ls)
(break prod))
((= (car ls) 0)
(break 0))
(else
(product (cdr ls) (* prod (car ls)) break))))
(product '(1 2 3 4 5) 1 (lambda (x) x)) => 120
(product '(1 2 0 4 5) 1 (lambda (x) x)) => 0
I want to ask my CPS is right? T
Thanks in advance!
BEST REGARDS
I think this is the correct implementation :
(define inside-product #f) ;; to demonstrate the continuation
(define (product ls prod break)
(cond
((null? ls)
(begin
(set! inside-product prod)
(prod 1)))
((= (car ls) 0)
(break 0))
(else
(product (cdr ls) (lambda (x) (prod (* (car ls) x))) break))))
(define identity (lambda (x) x))
The idea of CPS is to keep a track of the recursion.
> (product (list 1 2 3) identity identity)
6
> (inside-product 4)
24
I got this program:
(define a 2)
(define (goo x)
(display x) (newline)
(lambda (y) (/ x y)))
(define (foo x)
(let ((f (goo a)))
(if (= x 0)
x
(f x))))
and I asked to compare the evaluation results between the applicative and normal order on the expression (foo (foo 0)).
As I know, in applicative order, (display x) in function goo will print x and after it the program will collapse because y isn't defined. But when I run it in Scheme nothing happens. What is the reason?
(foo 0) evaluates to this code:
(define (goo 2)
(display 2) (newline)
(lambda (y) (/ 2 y)))
(define (foo x)
(let ((f (goo 2)))
(if (= 0 0)
0
((lambda (y) (/ 2 y)) 0))))
and prints 2, returning 0. While (foo 4) evaluates to:
(define (goo 2)
(display 2) (newline)
(lambda (y) (/ 2 y)))
(define (foo 4)
(let ((f (goo 2)))
(if (= 4 0)
4
((lambda (y) (/ 2 y)) 4))))
and prints 2, returning 0.5.