Why are these string different in Racket - scheme
I am running following code:
(define myframe (new frame% [label "myframe"]))
(define tf1 (new text-field% [parent myframe] [label "tf1"]))
(define tf2 (new text-field% [parent myframe][label "tf2"]))
(define tf3 (new text-field% [parent myframe][label "tf3"]))
(send myframe show #t)
(define combined_str (string-append (send tf1 get-value) "-" (send tf2 get-value) "-" (send tf3 get-value) ))
(println combined_str)
(if (eq? "--" combined_str) "same" "different")
Output is:
"--"
"different"
The combined_str is "--" because the text-fields are blank. But it is not coming as same as "--".
This is almost certainly caused by using eq? instead of equal?. See Object Identity and Comarpison for more, and also What is the difference between eq?, eqv?, equal?, and = in Scheme?. In short, eq? does a pointer comparison, which isn't what you want.
Examples:
> (eq? "--" (string-append "-" "-"))
#f
> (equal? "--" (string-append "-" "-"))
#t
> (string=? "--" (string-append "-" "-"))
#t
Related
Why do I get "application: not a procedure" with this for loop in Racket?
The following code reads a csv file and based on its content generates a Prolog program:
#!/usr/bin/env racket
#lang racket/base
(define (overwrite-s-to-f fname s); Will create fname and write overwriting the previous content.
(with-output-to-file #:exists 'truncate fname (lambda () (displayln s))))
(define (c-o-a-line-to-f fname s); Will append a string to fname or create it if does not exist. Appends a new line.
(with-output-to-file #:exists 'append fname (lambda () (displayln s))));
(define fname "women.csv")
(define pl-fname "females-by-Racket.pl")
(require racket/file)
(define content (file->lines fname))
(define disc-line (string-append ":-discontiguous(" (string-replace (car content) "Name," "") ").\n"))
(overwrite-s-to-f pl-fname disc-line)
(define list-of-verbs (string-split (string-replace (car content) "Name," "") ","))
(require racket/string racket/system)
(for ((row content));content is a list of strings
(let ((list-of-cs (string-split row ",")))
(when (equal? (car (cdr list-of-cs)) "+")
(displayln row)(let ((cmd (string-append "awesome("(car list-of-cs)").")))(c-o-a-line-to-f pl-fname cmd)(displayln cmd)))
(when (equal? (car (cdr (cdr list-of-cs))) "+")(displayln row)(let ((cmd (string-append "and_intelligent("(car list-of-cs)").")))
(c-o-a-line-to-f pl-fname cmd)(displayln cmd))))); TODO: when for each columns 2-last of women.csv
The content of women.csv:
Name,awesome,and_intelligent,performed_once,extreme1,extreme2,extreme3,extreme4,donkey_thing,dark_eyes,pigmented_face,pigmented_genitals,bleached,had_no_surgeries,has_augmented_breasts
adriana_chechik,+,,,+,?,+,+,,-,,,,,
alysa_gap,+,,,,?,+,+,,-,,,,,
anna_de_ville,+,,,,,+,+,,+,-,+,-,-,
aurora_jolie,+,+,,,,,,,+,+,+,,+,
autumn_falls,,,,,,,,,+,+,-,+,+,
casey_calvert,+,,,,,,,,+,+,+,,,
dahlia_sky,+,,,,,,+,,,,,,,
dominica_lito,+,,,,,,+,,,,,,,
ella_knox,,,,,,,,,+,+,+,,+,
isabella_clark,+,,,,,,+,,,,,,,
jade_kush,,,,,,,,,+,+,,,+,
juelz_ventura,+,,,,,+,,,-,-,,,-,+
kapri_styles,,,,,,,,,+,,+,,,
kristina_milan,,,,,,,,,+,+,,,+,
kylie_sinner,+,+,,,,,,,+,,,,-,
leigh_raven,+,,,,,+,,,+,+,,,,
maserati,,,,,,,,,+,+,,,+,
miosotis,,,,,,,,,+,+,,,+,
scarlett_bloom,,,,,,,,,+,+,+,,-,
sheena_shaw,,,,,,,,,-,,+,,-,
sofia_rose,,,,,,,,,+,,,,+,
teanna_trump,+,,,,,,,,+,,+,,,
veronica_avluv,+,,,,,,+,,,,,,,
yudi_pineda,+,,,,,,,,+,+,,,,
females-by-Racket.pl is to look like so:
:-discontiguous(awesome,and_intelligent,performed_once,extreme1,extreme2,extreme3,extreme4,donkey_thing,dark_eyes,pigmented_face,pigmented_genitals,bleached,had_no_surgeries,has_augmented_breasts).
awesome(adriana_chechik).
awesome(alysa_gap).
awesome(anna_de_ville).
awesome(aurora_jolie).
and_intelligent(aurora_jolie).
awesome(casey_calvert).
awesome(dahlia_sky).
awesome(dominica_lito).
awesome(isabella_clark).
awesome(juelz_ventura).
awesome(kylie_sinner).
and_intelligent(kylie_sinner).
awesome(leigh_raven).
awesome(teanna_trump).
awesome(veronica_avluv).
awesome(yudi_pineda).
but with more predicates (up to n-1 for each woman where n is the number of columns in women.csv)
The names of the columns or the numbers thereof in women.csv are likely to be frequently changed.
That is partly why I wish to avoid manually coding for every when. The other concerns are the sheer amount of the lines to code (15 whens for each column) and the risk of error/typo.
Is it doable to loop through every cell in list-of-cs in such way that it is taken from list-of-verbs?
I've tried this but to no avail (the comment show the error message that I got):
(for ((row content))
(let ((list-of-cs (cdr (string-split row ","))))
(for ((cell list-of-cs))
; application: not a procedure; expected a procedure
; that can be applied to arguments
(set! list-of-verbs (cdr (list-of-verbs)))
(let ((verb (car list-of-verbs)))
(when (equal? cell "+")
(displayln row)
(let ((cmd (string-append verb "(" (car row) ").")))
(c-o-a-line-to-f pl-fname cmd)))
))))
named let is a useful form to be familiar with:
#lang scheme
(define (csv->attributes rows) ;; ListOfString -> ListOfString
;; produce "column-header(row-name)" for "+" entries in csv (see example)
(let ([fields (string-split (car rows) ",")])
(let next-row ([rows (cdr rows)] [result (list)])
(cond
[(null? rows) (reverse result) ]
[else
(let* ([cells (string-split (car rows) ",")]
[name (car cells)])
(let next-cell ([cells (cdr cells)] [fields (cdr fields)] [result result])
(cond
[(null? cells) (next-row (cdr rows) result) ]
[else (next-cell
(cdr cells) (cdr fields)
(if (string=? (car cells) "+")
(cons (string-append (car fields) "(" name ")") result)
result)) ]))) ]))))
(define trio '("Name,fast,slow,sidles"
"Achilles,+,,"
"Tortoise,,+,"
"Crab,,+,+"))
Welcome to DrRacket, version 8.5 [cs].
Language: scheme, with debugging.
> (csv->attributes trio)
("fast(Achilles)" "slow(Tortoise)" "slow(Crab)" "sidles(Crab)")
>
how to align racket GUI text fields and buttons
I am creating a GUI for a racket program where a user inputs a title and a blog and then submits it. This is my code for those fields so far: (define blogPost% (class horizontal-panel% (super-new) (define titleoutput (new text-field% (label " title") (min-height 20) (min-width 200) (vert-margin 20) (horiz-margin 10) (parent this))) (define output (new text-field% (label "blog") (style '(multiple)) (min-height 20) (vert-margin 20) (min-width 400) (parent this))) (define (callback button event) (define title-new-value (send titleoutput get-value)) (define new-value (send output get-value)) (save title-new-value new-value) (send output set-value "") (send titleoutput set-value "") (send howisit show #t)) (define button (new button% (label "Submit") (vert-margin 0) (horiz-margin 10) (parent this) (callback callback))) )) It is currently aligned like this: But I would like the title text box to be above the blog field and the submit button to be centered at the bottom.
I'm assuming that you're running this code in the same way as for your previous question. In that, you used your class like this: (define f (new frame% [label "blog post GUI"] [min-width 400] [min-height 500])) (define tib (new blogPost% [parent f])) (send f show #t) Now since you defined blogPost% as a subclass of horizontal-panel%, it also inherits all of the initialization arguments of horizontal-panel%, including the alignment argument. So you can pass the [alignment '(left top)] initialization argument to your blogPost% class: (define f (new frame% [label "blog post GUI"] [min-width 400] [min-height 500])) (define tib (new blogPost% [parent f] [alignment '(left top)])) (send f show #t) If you want to build this default into your blogPost% class, you could add it to the (super-new) form instead: (define blogPost% (class horizontal-panel% (super-new [alignment '(left top)]) ...)) However, if you happen to have a (new blogPost% ... [alignment '(left top)] ...) around somewhere else, I believe this will break that code. So to avoid that, it would probably be best to make the blogPost% class it's own class, so that instead of being a horizontal-panel%, it would have a horizontal-panel%, in the same way that it already has two text-fields and a button. This is better for the long term because after this change, code that uses blogPost% won't break if you change which initialization arguments you passed to horizontal-panel% (which was implicit in the super-new previously). (define blogPost% (class object% ; object% instead of horizontal-panel% ; This argument is explicit now. ; If other code relies on other arguments, specify them here. (init parent) (super-new) (define panel (new horizontal-panel% ; this new call is explicit now [parent parent] ; you can later add more arguments [alignment '(left top)])) ; and it won't break things (define titleoutput (new text-field% [label " title"] [min-height 20] [min-width 200] [vert-margin 20] [horiz-margin 10] [parent panel])) ; panel instead of this (define output (new text-field% [label "blog"] [style '(multiple)] [min-height 20] [vert-margin 20] [min-width 400] [parent panel])) ; panel instead of this (define (callback button event) (define title-new-value (send titleoutput get-value)) (define new-value (send output get-value)) (save title-new-value new-value) (send output set-value "") (send titleoutput set-value "") (send howisit show #t)) (define button (new button% [label "Submit"] [vert-margin 0] [horiz-margin 10] [parent panel] ; panel instead of this [callback callback])) )) (define f (new frame% [label "blog post GUI"] [min-width 400] [min-height 500])) (define tib (new blogPost% [parent f])) (send f show #t) Of course, with this method, you won't be able to use the methods defined for horizontal-panel% on instances of your blogPost% class, but in the long run that's a good thing as well. If you ever, in the future, wanted to change the implementation to use something other than a horizontal-panel%, you could.
Scheme: how to clear all the messages in a dialog
i have a method that prints messages in a list on a dialog object. The code below is printing "a b c a b c d e" and i want it to be "a b c d e". How do i solve this problem? Is there a method that i can clear all the messages in a dialog object? #lang racket/gui (define frame (new frame% [width 300] [height 300] [label "Frame"])) (new button% [parent frame] [label "Messages"] (callback (lambda (button event) (send msg-dialog show #t)))) (define msg-dialog (new dialog% (label "Name") (parent frame) (width 300) (height 300))) (define (make-msg%) (new message% [parent msg-dialog] [label "Message: "] [min-width 80] [min-height 30])) (define (print-msg lst) (if (null? lst) (void) (begin (send (make-msg%) set-label (symbol->string (car lst))) (print-msg (cdr lst))))) (define list '(a b c)) (print-msg list) (set! list (append list '(d e))) (print-msg list) (send frame show #t)
The GUIML library has a function that can do it easily: (require (planet jphelps/guiml)) (delete-children msg-dialog) delete-children is implemented like this if you'd rather fork it: (define (delete-children object (id #f)) (send object change-children (λ (x) (if id (filter (λ (widget) (not (eq? (send widget ___get-guiml-name) id))) x) '()))))
Consider using a text-field% instead. http://docs.racket-lang.org/gui/text-field_.html?q=message%25 For a text field, the most useful methods of a text% object are the following: (send a-text get-text) returns the current text of the editor. (send a-text erase) deletes all text from the editor. (send a-text insert str) inserts str into the editor at the current caret position.
Run Code after Button Click using the racket/gui library
I am trying to get the value of a label after a button is clicked. I know that I can use (send x get-label) to get the value of the label, but it only gets the initial value of the label in my case "No Zip Code Entered". Also, after that button is pressed I would like to run code that queries an API and parses xml information using the zip code from the label. Below is my code: Thanks in Advanced, Puzzledplane GUI: #lang racket (require racket/gui/base) ;; Creates a Frame called mainframe (define mainframe (new frame% [label "Forecaster - Powered by Wunderground API"] [width 500] [height 500] [stretchable-width 500] [stretchable-height 500])) ;; Creates a Current Conditions group-box-panel (define maingroup (new group-box-panel% [label "Current Conditions:"] [parent mainframe] [min-height 450] [stretchable-height 450])) (define cclabel (new message% [parent maingroup] [label "Insert Conditions Here from API"] )) ;; Creates a Zip Code group-box-panel (define zipcodegroup (new group-box-panel% [label "Zip Code:"] [parent mainframe] [min-height 100] [stretchable-height 100])) ;; Zip Code Message Label -- Defaults to No Zip Code Entered (define zipcodelabel (new message% [parent zipcodegroup] [label "No Zip Code Entered"] )) ;; Zip Code Text-Field (define zipInput (new text-field% [parent zipcodegroup] [label ""] [init-value ""] [min-width 5] [stretchable-width 5] [callback (lambda(f ev) (define v (send f get-value)) (unless (string->number v) (send f set-value (regexp-replace* #rx"[^0-9]+" v ""))))])) ;; Submit Button (define submit-button (new button% [parent zipcodegroup] [label "Submit"] [callback (lambda (button event) (let ([v (send zipInput get-value)]) (send zipcodelabel set-label v) ))])) ;; Show Frame (send mainframe show #t) XML Parsing: #lang racket (require net/url xml xml/path) (define curent-cond-url (string->url "http://api.wunderground.com/api/*snip*/conditions/q/autoip.xml")) (define current-cond-port (get-pure-port curent-cond-url)) (define response (port->string current-cond-port)) (close-input-port current-cond-port) (define data (xml->xexpr ((eliminate-whitespace '(response)) (read-xml/element (open-input-string response))))) (define curr-location (se-path*/list '(display_location full) data)) (define curr-weather (se-path*/list '(current_observation weather) data)) (define curr-temp (se-path*/list '(current_observation temp_f) data)) (define curr-humidity (se-path*/list '(current_observation relative_humidity) data)) (define curr-wind (se-path*/list '(current_observation wind_string) data)) (define curr-feels-like (se-path*/list '(current_observation feelslike_f) data)) (define current-conditions (list (list 'Location: curr-location) (list 'Conditions: curr-weather) (list 'Temperature: curr-temp) (list 'Feels-Like: curr-feels-like) (list 'Humidity: curr-humidity) (list 'Wind: curr-wind)))
Scheme Formatting Help
I've been working on a project for school that takes functions from a class file and turns them into object/classes. The assignment is all about object oriented programming in scheme. My problem however is that my code doesn't format right. The output it gives me whenever I give it a file to pass in wraps the methods of the class in a list, making it so that the class never really gets declared. I can't for the life of me figure out how to get the parenthesis wrapping the method list to remove. I would really appreciate any help. Below is the output, the class file and the code,. (define pointInstance (let ((myx 1) (myy 2)) (lambda msg (cond (((eq? (car msg) getx) myx) ((eq? (car msg) gety) myy) ((eq? (car msg) setx) (set! myx x)) ((eq? (car msg) show) (begin (display "[") (display myx) (display ",") (display myy) (display "]")))))))) If you look at just after the cond you'll see how all those eq statements are contained in a list. I can't get this to work right unless they're not wrapped by that top level list. ;;;; PART1 --- A super-easy set of classes. Just models points and lines. Tests all of >the ;; basics of class behavior without touching on anything particularly complex. (class pointInstance (parent:) (constructor_args:) (ivars: (myx 1) (myy 2)) (methods: (getx () myx) (gety () myy) (setx (x) (set! myx x)) (show () (begin (display "[") (display myx) (display ",") (display myy) (display "]"))) )) (require (lib "trace.ss")) ;; Continue reading until you hit the end of the file, all the while ;; building a list with the contents (define load-file (lambda (port) (let ((rec (read port))) (if (eof-object? rec) '() (cons rec (load-file port)))))) ;; Open a port based on a file name using open-input-file (define (load fname) (let ((fport (open-input-file fname))) (load-file fport))) ;(define lis (load "C:\\Users\\Logan\\Desktop\\simpletest.txt")) ;(define lis (load "C:\\Users\\Logan\\Desktop\\complextest.txt")) (define lis (load "C:\\Users\\Logan\\Desktop\\pointinstance.txt")) ;(display (cdaddr (cdddar lis))) (define makeMethodList (lambda (listToMake retList) ;(display listToMake) (cond [(null? listToMake) retList ;(display "The list passed in to parse was null") ] [else (makeMethodList (cdr listToMake) (append retList (list (getMethodLine listToMake)))) ] ) )) ;(trace makeMethodList) ;this works provided you just pass in the function line (define getMethodLine (lambda (functionList) `((eq? (car msg) ,(caar functionList)) ,(caddar functionList)))) (define load-classes (lambda paramList (cond [(null? paramList) (display "Your parameters are null, man.")] [(null? (car paramList))(display "Done creating class definitions.")] [(not (null? (car paramList))) (begin (let* ((className (cadaar paramList)) (classInstanceVars (cdaddr (cddaar paramList))) (classMethodList (cdr (cadddr (cddaar paramList)))) (desiredMethodList (makeMethodList classMethodList '())) ) ;(display "Classname: ") ;(display className) ;(newline)(newline) ;(display "Class Instance Vars: ") ;(display classInstanceVars) ;(newline)(newline) ;(display "Class Method List: ") ;(display classMethodList) ;(newline) ;(display "Desired Method List: ") ;(display desiredMethodList)) ;(newline)(newline) ;---------------------------------------------------- ;do not delete the below code!` `(define ,className (let ,classInstanceVars (lambda msg ;return the function list here (cond ,(makeMethodList classMethodList '()))) )) ;--------------------------------------------------- ))] ) )) (load-classes lis) ;(load-classes lis) ;(load-classes-helper lis) ;(load-classes "simpletest.txt") ;(load-classes "complextest.txt") ;method list ;(display (cdr (cadddr (cddaar <class>))))
You have too many opening parenthesis in the 1st clause of the cond. IE: (((eq? (car msg) getx) myx) ^ Updated: Are you looking for this? (cond ,#(makeMethodList classMethodList '()) ^^ Or you can do: (cond . ,(makeMethodList classMethodList '())