Racket. Fill the table with data from database - sql

I'm trying to fill the table in my GUI with data from database.
Here's the database example:
Team
---------------------------------------------------------
| id | name | city | coach |
---------------------------------------------------------
| 1 | Atlanta Hawks | Atlanta | Lloyd Pierce |
| 2 | Boston Celtics| Boston | Brad Stevens |
| 3 | Chicago Bulls | Chicago | Jim Boylen |
| 4 | Brooklyn Nets | New-York | Jacque Vaughn|
Tournament
-----------------------------------------------------------------------
| id | name | city | prise | year |
-----------------------------------------------------------------------
| 1 | FirstCup | Atlanta | 100000 | 2018 |
| 2 | SecondCup | Boston | 200000 | 2019 |
| 3 | ThirdCup | Chicago | 300000 | 2017 |
| 4 | AnotherCup | New-York | 400000 | 2020 |
And here's my GUI with some dummy data in tab-panels:
#lang racket
(require
racket/gui/base
racket/class
racket/list)
(require db)
(define pgc
(postgresql-connect #:user "postgres"
#:database "bascketball"
#:password "root"))
(define Team-Table #f)
(define Tournament-Table #f)
(define Team-Data #f)
(define Tournament-Data #f)
(define Basketball-App #f)
(define Main-Frame #f)
(define Group-Box #f)
(define Horizontal-Pane-Menu #f)
(define Tab-Panel #f)
(define Team-Tab #f)
(define Tournament-Tab #f)
(define (Basketball-App-init
(Main-Frame-width 800)
(Main-Frame-height 600))
(set! Main-Frame
(new
frame%
(parent Basketball-App)
(label "Basketball App")
(width Main-Frame-width)
(height Main-Frame-height)))
(set! Group-Box
(new
group-box-panel%
(parent Main-Frame)
(label "")
(alignment (list 'right 'bottom))))
(set! Horizontal-Pane-Menu
(new
horizontal-pane%
(parent Group-Box)
(stretchable-width #f)
(stretchable-height #f)))
(set! Tab-Panel
(new
(class tab-panel%
(super-new)
(define child-panels '())
(define/public
(add-child-panel p label)
(set! child-panels (append child-panels (list p)))
(send this append label)
(when (> (length child-panels) 1) (send this delete-child p)))
(define/public
(active-child n)
(send this change-children
(lambda (children) (list (list-ref child-panels n))))))
(parent Group-Box)
(choices (list))
(callback (λ (tp e) (send tp active-child (send tp get-selection))))
(stretchable-width #t)
(stretchable-height #t)))
(set! Team-Tab
(new
(class vertical-panel%
(init parent)
(init-field label)
(super-new (parent parent))
(send parent add-child-panel this label))
(parent Tab-Panel)
(label "Team")
(alignment (list 'left 'center))))
(set! Team-Table (new list-box%
[parent Team-Tab]
[choices (list )]
[label ""]
[style (list 'single 'column-headers 'variable-columns)]
[columns (list "Id" "Name" "City" "Coach")]))
#: Dummy data
(set! Team-Data (list (list "TeamTest" "TeamTest" "TeamTest")
(list "TeamTest" "TeamTest" "TeamTest")
(list "TeamTest" "TeamTest" "TeamTest")
(list "TeamTest" "TeamTest" "TeamTest")))
(send Team-Table set (list-ref Team-Data 0) (list-ref Team-Data 1) (list-ref Team-Data 2) (list-ref Team-Data 3))
(set! Tournament-Tab
(new
(class vertical-panel%
(init parent)
(init-field label)
(super-new (parent parent))
(send parent add-child-panel this label))
(parent Tab-Panel)
(label "Tournament")
(alignment (list 'left 'center))))
(set! Tournament-Table (new list-box%
[parent Tournament-Tab]
[choices (list )]
[label ""]
[style (list 'single 'column-headers 'variable-columns)]
[columns (list "Id" "Name" "City" "Prise" "Year")]))
#: Dummy data
(set! Tournament-Data (list (list "TournamentTest" "TournamentTest" "TournamentTest")
(list "TournamentTest" "TournamentTest" "TournamentTest")
(list "TournamentTest" "TournamentTest" "TournamentTest")
(list "TournamentTest" "TournamentTest" "TournamentTest")
(list "TournamentTest" "TournamentTest" "TournamentTest")))
(send Tournament-Table set (list-ref Tournament-Data 0) (list-ref Tournament-Data 1) (list-ref Tournament-Data 2) (list-ref Tournament-Data 3) (list-ref Tournament-Data 4))
(send Main-Frame show #t))
(module+ main (Basketball-App-init))
So I want to load data from database when I'm switch to tab and fill the table with loaded data.
I have two problems with this:
First - How should I know when user switch the tab and what tab is it (in other words, where should I put my SQL query to use it only when the tab switches).
Second - When I'm using some kind of this queries:
(query-rows pgc "select * from team")
I get just a string and I have no idea how to put this string to my table. I have to split this string and put every element as a cell of a table.
So, what's your advice in this project?

Related

Iterating through a nested list using filter or fold Racket

I need to iterate through a list with sublists in Racket using list iteration and filtering, one of the lists is a nested list, I tried using "list?" and "car" to iterate inside but of course that would only apply to the first value of the sublist.
Is there a way to iterate through the whole nested list using list iteration and filtering?
(define (count-evens lst)
(length
(filter
(lambda (x)
(cond
[(and (list? x)
(and (number? (car x))
(eq? (modulo (car x) 2) 0)))
#t]
[(and (number? x)
(eq? (modulo x 2) 0))
#t]
[else
#f]))
lst)))
(count-evens '(1 2 5 4 (8 4 (b (10 3 3))) 3))
=> 3
Should return => 5
I would use a recursive function to do this but the assignment doesn't allow it.
"...assignment doesn't allow [recursive functions]"
Not sure what is allowed for this assignment, but
in ye olden days we processed recursive data structures with stacks...
(define (count-evens lst)
(define (lst-at stack) ;; (car stack) = index in deepest sub-list
;; produce list cursor within lst indexed by stack
(do ([stack (reverse stack) (cdr stack)]
[cursor (list lst) (list-tail (car cursor) (car stack))])
((null? stack) cursor)))
(do ([stack (list 0)
(cond
[(null? (lst-at stack))
(cdr stack)] ;; pop stack
[(pair? (car (lst-at stack)))
(cons 0 stack)] ;; push stack
[else ;; step through current (sub)list
(cons (+ 1 (car stack)) (cdr stack))])]
[count 0
(let ([item (car (lst-at stack))])
(if (and (number? item) (even? item)) (+ 1 count) count))])
((null? (lst-at stack)) count)))
> (count-evens '(1 2 5 4 (8 4 (b (10 3 3))) 3)) ;=>
5

Can I define static fields in racket classes?

I couldn't find a way to define a static field in racket. By static, I mean a field that belongs to the entire class and not to an instance.
(define counter% (class object%
(field (current-count 0))
(super-new)
(define/public (get-count)
current-count)
(define/public (next)
(set! current-count (+ current-count 1))
(set! total (+ total 1))
(list current-count total))))
(define c1 (new counter%))
(define c2 (new counter%))
(send c1 next)
(send c1 next)
(send c1 next)
(send c2 next)
So total in this example should be a static field and the output should be:
'(1 1)
'(2 2)
'(3 3)
'(1 4)
How about this solution?
#lang racket
(define counter%
(let ([total 0])
(class object%
(field (current-count 0))
(super-new)
(define/public (get-count)
current-count)
(define/public (next)
(set! current-count (+ current-count 1))
(set! total (+ total 1))
(list current-count total)))))
(define c1 (new counter%))
(define c2 (new counter%))
(send c1 next)
(send c1 next)
(send c1 next)
(send c2 next)

Racket: Map with keys/iterating?

I've got some function func and want to apply it on a list lst, so I used map but I need to have the first and last element of the list evaluated with some other function func2.
So basically I want this:
(map (lambda (x)
(cond [(isBeginningOfList? lst) (func2 x)]
[(isEndOfList? lst) (func2 x)]
[else (func x)]))
lst)
Obviously this doesn't work.
How can I achieve this functionality?
Can I somehow get a key of each list entry? Like lambda(key,val) and then compare (equal? key 0) / (equal? key (length lst))?
There's for/list with in-indexed and that does what you describe:
(define (f lst f1 f2)
(define last (sub1 (length lst)))
(for/list (((e i) (in-indexed lst)))
(if (< 0 i last)
(f1 e)
(f2 e))))
then
> (f '(1 2 3 4 5) sub1 add1)
'(2 1 2 3 6)
You can use a map on all the elements except the first and the last one and treat those two separately. In this way you avoid those comparisons which you would do for every element.
(define special-map
(λ (lst f1 f2)
(append (list (f1 (car lst)))
(map f2 (drop-right (cdr lst) 1))
(list (f1 (last lst))))))
Example
Let's try to increment the first and the last elements and decrement all the others.
> (special-map '(1 2 3 4 5) add1 sub1)
'(2 1 2 3 6)
Later edit
I changed (take (cdr lst) (- (length lst) 2)) with (drop-right (cdr lst) 1).

CLIPS: slots within multislots

I am currently working in CLIPS and I am new to it. I am trying to replicate the following information in a CLIPS deftemplate:
[Person, [Class,Class],[[M 9,11],[F,9,11]]]
It has a person, multiple classes that they can take and the times that they can take the class. I try to replicate this information in the following deftemplate:
(deftemplate person
(slot Name)
(multislot Class)
(multislot Available))
My problem is I do not understand what I am supposed to do in the available multislot because it has three inputs. Is there a way that I can make slots within a multislot? I have looked online for ways to do this but have not been able to correctly solve this problem.
Here are four different approaches. I would suggest something similar to approach 3 or 4 since these involve simple linkages between facts/instances.
CLIPS> (clear) ; Approach 1
CLIPS>
(deftemplate person
(slot Name)
(multislot Class)
(multislot Available))
CLIPS>
(deffacts people
(person (Name Frank)
(Class Biology Calculus)
(Available M 9 11 F 9 11)))
CLIPS>
(deffunction #-of-triplets (?mf)
(div (length$ ?mf) 3))
CLIPS>
(deffunction nth-triplet (?mf ?n)
(subseq$ ?mf (+ 1 (* (- ?n 1) 3))(* ?n 3)))
CLIPS>
(defrule print-availability
(person (Name ?name)
(Available $?a))
=>
(loop-for-count (?i (#-of-triplets ?a))
(bind ?triplet (nth-triplet ?a ?i))
(bind ?d (nth$ 1 ?triplet))
(bind ?b (nth$ 2 ?triplet))
(bind ?e (nth$ 3 ?triplet))
(printout t ?name " " ?d " " ?b " " ?e crlf)))
CLIPS> (reset)
CLIPS> (run)
Frank M 9 11
Frank F 9 11
CLIPS> (clear) ; Approach 2
CLIPS>
(deftemplate person
(slot Name)
(multislot Class)
(multislot Available-Weekday)
(multislot Available-Begin)
(multislot Available-End))
CLIPS>
(deffacts people
(person (Name Frank)
(Class Biology Calculus)
(Available-Weekday M F)
(Available-Begin 9 9)
(Available-End 11 11)))
CLIPS>
(defrule print-availability
(person (Name ?name)
(Available-Weekday $?f1 ?d $?)
(Available-Begin $?f2 ?b $?)
(Available-End $?f3 ?e $?))
(test (= (length$ ?f1)
(length$ ?f2)
(length$ ?f3)))
=>
(printout t ?name " " ?d " " ?b " " ?e crlf))
CLIPS> (reset)
CLIPS> (run)
Frank M 9 11
Frank F 9 11
CLIPS> (clear) ; Approach 3
CLIPS>
(deftemplate person
(slot Name)
(slot ID)
(multislot Class))
CLIPS>
(deftemplate availability
(slot owner-ID)
(slot Weekday)
(slot Begin)
(slot End))
CLIPS>
(deffacts information
(person (Name Frank) (ID 1)
(Class Biology Calculus))
(availability (owner-ID 1) (Weekday M) (Begin 9) (End 11))
(availability (owner-ID 1) (Weekday F) (Begin 9) (End 11)))
CLIPS>
(defrule print-availability
(person (Name ?name) (ID ?id))
(availability (owner-ID ?id) (Weekday ?d) (Begin ?b) (End ?e))
=>
(printout t ?name " " ?d " " ?b " " ?e crlf))
CLIPS> (reset)
CLIPS> (run)
Frank F 9 11
Frank M 9 11
CLIPS> (clear) ; Approach 4
CLIPS>
(defclass PERSON
(is-a USER)
(slot Name)
(multislot Class)
(multislot Available))
CLIPS>
(defclass AVAILABILITY
(is-a USER)
(slot Weekday)
(slot Begin)
(slot End))
CLIPS>
(definstances information
(of PERSON (Name Frank)
(Class Biology Calculus)
(Available (make-instance of AVAILABILITY (Weekday M) (Begin 9) (End 11))
(make-instance of AVAILABILITY (Weekday F) (Begin 9) (End 11)))))
CLIPS>
(defrule print-availability
(object (is-a PERSON) (Name ?name) (Available $? ?a $?))
(object (is-a AVAILABILITY) (name ?a))
=>
(printout t ?name " " (send ?a get-Weekday)
" " (send ?a get-Begin)
" " (send ?a get-End) crlf)))
CLIPS> (reset)
CLIPS> (run)
Frank F 9 11
Frank M 9 11
CLIPS>

Lilypond: how to add the number of repetitions above a bar

I am working with a score in Lilypond that has a lot of repetitions, where basically every bar has to be repeated a certain number of times. I would like to be able to write above every bar the number of times it should be repeat, similar to the score below (which was not created in Lilypond):
It would be great to be able to have some brackets above the bar and also to have the "3x" centralized, just like in the example above. So far, the only (temporary) solution I was able to come up with in Lilypond was to add repeat bars and then simply write "3x" above the first note of every bar (since I could not have it centralized on the bar either). It does not look very good, but gets the job done. This temporary solution looks like this:
Any suggestions of how to make this example look more similar to the first inn Lilypond would be extremely welcome!
This is a workaround for this problem:
\version "2.19.15"
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% COPY ALL THIS BELOW %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% repeatBracket snippet
% will add .----Nx----. above a bar, where N is the number of repetitions
% based on the wonderful spanner by David Nalesnik (see: http://lists.gnu.org/archive/html/lilypond-user/2014-10/msg00446.html )
#(define (test-stencil grob text)
(let* ((orig (ly:grob-original grob))
(siblings (ly:spanner-broken-into orig)) ; have we been split?
(refp (ly:grob-system grob))
(left-bound (ly:spanner-bound grob LEFT))
(right-bound (ly:spanner-bound grob RIGHT))
(elts-L (ly:grob-array->list (ly:grob-object left-bound 'elements)))
(elts-R (ly:grob-array->list (ly:grob-object right-bound 'elements)))
(break-alignment-L
(filter
(lambda (elt) (grob::has-interface elt 'break-alignment-interface))
elts-L))
(break-alignment-R
(filter
(lambda (elt) (grob::has-interface elt 'break-alignment-interface))
elts-R))
(break-alignment-L-ext (ly:grob-extent (car break-alignment-L) refp X))
(break-alignment-R-ext (ly:grob-extent (car break-alignment-R) refp X))
(num
(markup text))
(num
(if (or (null? siblings)
(eq? grob (car siblings)))
num
(make-parenthesize-markup num)))
(num (grob-interpret-markup grob num))
(num-stil-ext-X (ly:stencil-extent num X))
(num-stil-ext-Y (ly:stencil-extent num Y))
(num (ly:stencil-aligned-to num X CENTER))
(num
(ly:stencil-translate-axis
num
(+ (interval-length break-alignment-L-ext)
(* 0.5
(- (car break-alignment-R-ext)
(cdr break-alignment-L-ext))))
X))
(bracket-L
(markup
#:path
0.1 ; line-thickness
`((moveto 0.5 ,(* 0.5 (interval-length num-stil-ext-Y)))
(lineto ,(* 0.5
(- (car break-alignment-R-ext)
(cdr break-alignment-L-ext)
(interval-length num-stil-ext-X)))
,(* 0.5 (interval-length num-stil-ext-Y)))
(closepath)
(rlineto 0.0
,(if (or (null? siblings) (eq? grob (car siblings)))
-1.0 0.0)))))
(bracket-R
(markup
#:path
0.1
`((moveto ,(* 0.5
(- (car break-alignment-R-ext)
(cdr break-alignment-L-ext)
(interval-length num-stil-ext-X)))
,(* 0.5 (interval-length num-stil-ext-Y)))
(lineto 0.5
,(* 0.5 (interval-length num-stil-ext-Y)))
(closepath)
(rlineto 0.0
,(if (or (null? siblings) (eq? grob (last siblings)))
-1.0 0.0)))))
(bracket-L (grob-interpret-markup grob bracket-L))
(bracket-R (grob-interpret-markup grob bracket-R))
(num (ly:stencil-combine-at-edge num X LEFT bracket-L 0.4))
(num (ly:stencil-combine-at-edge num X RIGHT bracket-R 0.4)))
num))
#(define-public (Measure_attached_spanner_engraver context)
(let ((span '())
(finished '())
(event-start '())
(event-stop '()))
(make-engraver
(listeners ((measure-counter-event engraver event)
(if (= START (ly:event-property event 'span-direction))
(set! event-start event)
(set! event-stop event))))
((process-music trans)
(if (ly:stream-event? event-stop)
(if (null? span)
(ly:warning "You're trying to end a measure-attached spanner but you haven't started one.")
(begin (set! finished span)
(ly:engraver-announce-end-grob trans finished event-start)
(set! span '())
(set! event-stop '()))))
(if (ly:stream-event? event-start)
(begin (set! span (ly:engraver-make-grob trans 'MeasureCounter event-start))
(set! event-start '()))))
((stop-translation-timestep trans)
(if (and (ly:spanner? span)
(null? (ly:spanner-bound span LEFT))
(moment<=? (ly:context-property context 'measurePosition) ZERO-MOMENT))
(ly:spanner-set-bound! span LEFT
(ly:context-property context 'currentCommandColumn)))
(if (and (ly:spanner? finished)
(moment<=? (ly:context-property context 'measurePosition) ZERO-MOMENT))
(begin
(if (null? (ly:spanner-bound finished RIGHT))
(ly:spanner-set-bound! finished RIGHT
(ly:context-property context 'currentCommandColumn)))
(set! finished '())
(set! event-start '())
(set! event-stop '()))))
((finalize trans)
(if (ly:spanner? finished)
(begin
(if (null? (ly:spanner-bound finished RIGHT))
(set! (ly:spanner-bound finished RIGHT)
(ly:context-property context 'currentCommandColumn)))
(set! finished '())))
(if (ly:spanner? span)
(begin
(ly:warning "I think there's a dangling measure-attached spanner :-(")
(ly:grob-suicide! span)
(set! span '())))))))
\layout {
\context {
\Staff
\consists #Measure_attached_spanner_engraver
\override MeasureCounter.font-encoding = #'latin1
\override MeasureCounter.font-size = 0
\override MeasureCounter.outside-staff-padding = 2
\override MeasureCounter.outside-staff-horizontal-padding = #0
}
}
repeatBracket = #(define-music-function
(parser location N note)
(number? ly:music?)
#{
\override Staff.MeasureCounter.stencil =
#(lambda (grob) (test-stencil grob #{ #(string-append(number->string N) "×") #} ))
\startMeasureCount
\repeat volta #N { $note }
\stopMeasureCount
#}
)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ...UNTIL HERE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
{
\repeatBracket 7 {c'1}
\repeatBracket 32 {d' g}
\repeatBracket 14 {e' f g}
\repeatBracket 29 {f' a bes \break cis' e''}
\repeatBracket 1048 {g'1}
}
This code above gives the following result:
]
This solution was not created by myself, but sent to me by David Nalesnik, from lilypond-user mailing list. I just would like to share it here in case someone would need it as well. I've made just some very minor adjustments to what David sent me.
I just had a similar problem but preferred the style on your second example, with the 3x above the bar. The solution I found was:
f e d c |
\mark \markup {"3x"}\repeat volta 3 {c d e f}
f e d c |
generating
Maybe someone else has a use for it.