Hi,
recently i generated image from science data to be integrated in a web page. The special thing being those image and html code was generated with Racket with and extension reader allowing some infix syntax and other features.
i had recently to show the result to a few students of 2nd of Lycée (high school) in my work and i share the result with adding the code and a few more explanations to the Racket discourse list:
first the resulting web page with data and images (sorry for the splitting and croping , the web page was to big to fit in one single screenshot):
the code looks like this, starting with: ( as it runs in a racket script started by the Unix web server )
#! /usr/bin/env racket
#lang reader SRFI-105
(require Scheme+)
(require setup/dirs)
(require racket/date)
(require srfi/13) ; for at least string-contains
(require upi/basename)
(require xml
(except-in 2htdp/batch-io xexpr?))
; for: read-lines and others
(require plot/no-gui)
(require html-printer)
{debug <- #f}
{π <- pi} ; just for physic formula
; first stage overloading
(define-overload-existing-operator =) ; prepare overloading default = operator in racket/base
; second stage overloading
(overload-existing-operator = string=? (string? string?)) ; overload = for string arguments
(overload-existing-operator = char=? (char? char?)) ; overload = for char arguments
then some other not graphical code is run (interpolation,science calculus,etc) that i skip here, after the image and web page is generated, just note the overloading features of scheme+ that allow overloading of = scheme predicate that in scheme only works with numbers which then ,now , will works too for string and char .
It will be used in the code later like this with string:
(if {math = "SCALARS"}
{get-vct <- (λ (ln) ; line of data
((index X_MSO Y_MSO Z_MSO VALx) <- (apply values
(map string->number
(string-split ln))))
(vector index (distance X_MSO Y_MSO Z_MSO)))}
;; VECTORS
{get-vct <- (λ (ln) ; line of data
((index X_MSO Y_MSO Z_MSO VALx VALy VALz) <- (apply values
(map string->number
(string-split ln))))
(vector index (distance X_MSO Y_MSO Z_MSO)))})
and with char here for example:
;; remove the Z at the end of time-stamps if any
(when {date-time-start[-1] = #\Z}
{date-time-start[-1] <- #\space})
the equality = is here between 2 char ,one being the classic #\Z scheme notation for the Z character. Note that date-time-start is here a string of charas usual in scheme and that the negative indexing is like in Python where -1 means starting from the end of the indexed object , also the [ ] are used for indexing the string.
Then the code now:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; generate image(s)
;; output-file-with-path is the name of the numerical interpolation result, vl is the vector containing the lines, data-interpol are a vector of the real data lines
(display "interpole_fields : math=") (display math) (newline)
;; > (between '(1 2 3) 'A)
;; '(1 A 2 A 3)
;; > (between '(1 2) 'A)
;; '(1 A 2)
;; > (between '(1) 'A)
;; '(1)
;; (define (between L elem)
;; (if (null? (cdr L))
;; L
;; (cons (car L)
;; (cons elem
;; (between (cdr L) elem)))))
;; convert physical size in latin string to greek characters
(define latin-rho "rho")
(define sp (string-split physic latin-rho #:trim? #f)) ;; example: (string-split "rhoe" "rho" #:trim? #f) ---> '("" "e")
;; (define xexpr-size (between sp 'rho))
;; (define xexpr-size-clean (remove "" xexpr-size))
;; (display "interpole_fields : xexpr-size-clean=") (display xexpr-size-clean) (newline)
{physic-greek <- (regexp-replace #rx"rho" physic "ρ")}
{physic-greek-sup <- (regexp-replace #rx"e" physic-greek "e⁻")}
{physic-greek4html <- (regexp-replace #rx"rho" physic "\\ρ")}
{physic-greek4html-sup <- (regexp-replace #rx"e" physic-greek4html "e<sup>-</sup>")}
(display "interpole_fields : physic-greek4html=") (display physic-greek4html) (newline)
;; check there was really greek symbol in physic size and fix the html string
(declare physic-html physic-text)
(if {math = "SCALARS"}
(if {physic = physic-greek4html-sup} then
{physic-html <- physic}
{physic-text <- physic}
else
{physic-html <- (string-append physic " (" physic-greek4html-sup ")")}
{physic-text <- (string-append physic " (" physic-greek-sup ")")})
(if {physic = physic-greek4html-sup} then
{physic-html <- physic}
{physic-text <- (string-append physic "x")}
else
{physic-html <- (string-append physic " (" physic-greek4html-sup ")")}
{physic-text <- (string-append physic "x (" physic-greek-sup "x)")}))
;; strings different predicate
(define (string<>? str1 str2) (not (string=? str1 str2)))
;; first stage overloading
(define-overload-existing-operator <> Scheme+/not-equal) ; as <> is not in racket/base we should specify the exact module name
;; second stage overloading
(overload-existing-operator <> string<>? (string? string?))
(declare filtr) ; will filter the Not a Number (nan)
(if {math = "VECTORS"}
{filtr <- (λ (ln) ; line of data, below is an infix expression with { } but ( ) should have be enough to work (see else body)
{(index X_MSO Y_MSO Z_MSO VALx VALy VALz) <- (apply values
(string-split ln))}
{VALx <> "nan" and VALy <> "nan" and VALz <> "nan"})}
;; SCALARS
{filtr <- (λ (ln) ; line of data, below is an infix expression with ( ) , no need of { } because we are already between { }
((index X_MSO Y_MSO Z_MSO VALx) <- (apply values
(string-split ln)))
(VALx <> "nan"))})
(display "interpole_fields : filtr=") (display filtr) (newline) ; for debug
;; filter data, excluding nan (not a number)
(declare data-interpol-filtrd)
{data-interpol-filtrd <- (vector-filter filtr data-interpol)}
(display "interpole_fields : data-interpol-filtrd[0]=") (display {data-interpol-filtrd[0]}) (newline) ; for debug
;; prepare meta-data for plot to a file
{basename-trajectory-tmp <- (basename trajectory-txt)} ; temporary filename, example: V8o3vpE
{image-type <- 'jpeg}
{image-extension <- (symbol->string image-type)}
{image-name-x <- (string-append basename-trajectory-tmp
"-x"
"."
image-extension)}
{image-x-path <- (build-path web-server-home-dir
image-name-x)}
(display "interpole_fields : image-x-path=") (display image-x-path) (newline)
;; create name of file of HTML page
{html-page-extension <- "html"}
{html-page-path <- (build-path web-server-home-dir
(string-append basename-trajectory-tmp
"."
html-page-extension))}
(display "interpole_fields : html-page-path=") (display html-page-path) (newline)
(declare get-vct
x-label ;; used both at toplevel and nested (so confusing DrRacket)
y-label
y-label-far
image-name-y image-y-path
image-name-z image-z-path
image-name-norm image-norm-path)
(if {math = "SCALARS"} then
{get-vct <- (λ (ln) ; line of data
((index X_MSO Y_MSO Z_MSO VALx) <- (apply values
(map string->number
(string-split ln))))
(vector index (cal VALx)))}
else ; VECTORS
{get-vct <- (λ (ln) ; line of data
((index X_MSO Y_MSO Z_MSO VALx VALy VALz) <- (apply values
(map string->number
(string-split ln))))
(vector index (cal VALx)))}
{image-name-y <- (string-append basename-trajectory-tmp
"-y"
"."
image-extension)}
{image-y-path <- (build-path web-server-home-dir
image-name-y)}
{image-name-z <- (string-append basename-trajectory-tmp
"-z"
"."
image-extension)}
{image-z-path <- (build-path web-server-home-dir
image-name-z)}
{image-name-norm <- (string-append basename-trajectory-tmp
"-norm"
"."
image-extension)}
{image-norm-path <- (build-path web-server-home-dir
image-name-norm)})
;; create the list of points for plot
{Lplot-x <- (vector->list (vector-map get-vct data-interpol-filtrd))}
(display "interpole_fields : (car Lplot-x)=") (display (car Lplot-x)) (newline)
;;{title-x <- (string-append "BepiColombo " output-file)}
{x-label <- "time t (minutes)"}
(if {math = "SCALARS"} then
{y-label <- (string-append physic-greek-sup " (" valor-unit ")")}
{y-label-far <- (string-append physic " (" valor-unit ")")}
else
{y-label <- (string-append physic-greek-sup "x (" valor-unit ")")}
{y-label-far <- (string-append physic "x (" valor-unit ")")})
(parameterize
([plot-x-label x-label]
[plot-x-far-label x-label]
[plot-y-label y-label]
[plot-y-far-label y-label-far])
(plot-file (list
(points Lplot-x
#:line-width 2
;;#:sym 'dot
#:color "blue"
#:label physic-text)
(lines Lplot-x #:color 2 #:width 2))
image-x-path
image-type))
;; plot of distance
(define (distance x y z)
(sqrt {x ** 2 + y ** 2 + z ** 2}))
(define norm distance)
{image-name-distance <- (string-append basename-trajectory-tmp
"-distance."
image-extension)}
{image-distance-path <- (build-path web-server-home-dir
image-name-distance)}
{meta-data-trajectory <- vl-trajectory[4]}
{unit-distance <- (list->vector (string-split meta-data-trajectory))[3][1 : 3]}
(display "interpole_fields : unit-distance=") (display unit-distance) (newline)
(if {math = "SCALARS"}
{get-vct <- (λ (ln) ; line of data
((index X_MSO Y_MSO Z_MSO VALx) <- (apply values
(map string->number
(string-split ln))))
(vector index (distance X_MSO Y_MSO Z_MSO)))}
;; VECTORS
{get-vct <- (λ (ln) ; line of data
((index X_MSO Y_MSO Z_MSO VALx VALy VALz) <- (apply values
(map string->number
(string-split ln))))
(vector index (distance X_MSO Y_MSO Z_MSO)))})
;; create the list of points for plot
{Lplot-distance <- (vector->list (vector-map get-vct data-interpol-filtrd))}
(display "interpole_fields : (car Lplot-distance)=") (display (car Lplot-distance)) (newline)
{title-x <- (string-append "BepiColombo - FlyBy Mercury Planet" output-file)}
{x-label <- "time t (minutes)"}
{y-label <- (string-append "distance (" unit-distance ")")}
(parameterize
([plot-x-label x-label]
[plot-x-far-label x-label]
[plot-y-label y-label]
[plot-y-far-label y-label])
(plot-file
(lines Lplot-distance
#:color "darkgoldenrod"
#:y-min 0
#:width 2
#:label "distance")
image-distance-path
image-type))
;; generate HTML page and extra images for VECTORS
(declare html-sexpr)
(if {math = "SCALARS"} then
{html-sexpr <- `(html
(style ((type "text/css")) "table, th, td { border:1px solid black; }")
(head (title "Plot"))
(body (h1 "BepiColombo - FlyBy "
(font ((color "#808080")) "Mercury")
" Planet")
(p
(center
(br)
(table
(tr
(th ;; ,(string-append physic " (" physic-greek4html ")" )
;; ,(string-append physic " (" )
;; ,@xexpr-size-clean
;; ")"
,(make-cdata #f
#f
physic-html)
) ; end table header
) ; end table row
(tr
(th ,math))
(tr
(td ,data-cube-filename))
(tr
(td ,basename-trajectory-xml))
(tr
(td ,output-file)))
(br)
(br)
(img ((src ,image-name-x)))
(br)
(br)
(img ((src ,image-name-distance)))))))}
else
;; plot y
{get-vct <- (λ (ln) ; line of data
((index X_MSO Y_MSO Z_MSO VALx VALy VALz) <- (apply values
(map string->number
(string-split ln))))
(vector index (cal VALy)))}
;; create the list of points for plot
{Lplot-y <- (vector->list (vector-map get-vct data-interpol-filtrd))}
{y-label <- (string-append physic-greek-sup "y (" valor-unit ")")}
{y-label-far <- (string-append physic "y (" valor-unit ")")}
(if {physic = physic-greek4html-sup}
{physic-text <- (string-append physic "y")}
{physic-text <- (string-append physic "y (" physic-greek-sup "x)")})
(parameterize
([plot-x-label x-label]
[plot-x-far-label x-label]
[plot-y-label y-label]
[plot-y-far-label y-label-far])
(plot-file (list
(points Lplot-y
#:line-width 2
#:color "blue"
#:label physic-text)
(lines Lplot-y #:color 2 #:width 2))
image-y-path
image-type))
;; z
{get-vct <- (λ (ln) ; line of data
((index X_MSO Y_MSO Z_MSO VALx VALy VALz) <- (apply values
(map string->number
(string-split ln))))
(vector index (cal VALz)))}
;; create the list of points for plot
{Lplot-z <- (vector->list (vector-map get-vct data-interpol-filtrd))}
{y-label <- (string-append physic-greek-sup "z (" valor-unit ")")}
{y-label-far <- (string-append physic "z (" valor-unit ")")}
(if {physic = physic-greek4html-sup}
{physic-text <- (string-append physic "z")}
{physic-text <- (string-append physic "z (" physic-greek-sup "x)")})
(parameterize
([plot-x-label x-label]
[plot-x-far-label x-label]
[plot-y-label y-label]
[plot-y-far-label y-label-far])
(plot-file (list
(points Lplot-z
#:line-width 2
#:color "blue"
#:label physic-text)
(lines Lplot-z #:color 2 #:width 2))
image-z-path
image-type))
;; plot norm
{get-vct <- (λ (ln) ; line of data
((index X_MSO Y_MSO Z_MSO VALx VALy VALz) <- (apply values
(map string->number
(string-split ln))))
(vector index (norm (cal VALx) (cal VALy) (cal VALz))))}
;; create the list of points for plot
{Lplot-norm <- (vector->list (vector-map get-vct data-interpol-filtrd))}
{y-label <- (string-append "|" physic-greek-sup "| (" valor-unit ")")}
{y-label-far <- (string-append "|" physic "| (" valor-unit ")")}
(if {physic = physic-greek4html-sup}
{physic-text <- (string-append "|" physic "|")}
{physic-text <- (string-append "|" physic "| (|" physic-greek-sup "|)")})
(parameterize
([plot-x-label x-label]
[plot-x-far-label x-label]
[plot-y-label y-label]
[plot-y-far-label y-label-far])
(plot-file (list
(points Lplot-norm
#:y-min 0
#:line-width 2
#:color "blue"
#:label physic-text)
(lines Lplot-norm
#:y-min 0
#:color "gold"
#:width 2))
image-norm-path
image-type))
{html-sexpr <- `(html
(style ((type "text/css")) "table, th, td { border:1px solid black; }")
(head (title "Plot"))
(body (h1 "BepiColombo - FlyBy "
(font ((color "#808080")) "Mercury")
" Planet")
(p
(center
(br)
(table
(tr
(th ;; ,(string-append physic " (" physic-greek4html ")" )
;; ,(string-append physic " (" )
;; ,@xexpr-size-clean
;; ")"
,(make-cdata #f
#f
physic-html)
) ; end table header
) ; end table row
(tr
(th ,math))
(tr
(td ,data-cube-filename))
(tr
(td ,basename-trajectory-xml))
(tr
(td ,output-file)))
(br)
(br)
(br)
(img ((src ,image-name-norm)))
(br)
(br)
(br)
(br)
(img ((src ,image-name-distance)))
(br)
(br)
(br)
(br)
(img ((src ,image-name-x)))
(br)
(br)
(br)
(br)
(img ((src ,image-name-y)))
(br)
(br)
(br)
(br)
(img ((src ,image-name-z)))))))})
;; create output HTML file
(define html-out (open-output-file #:exists 'truncate html-page-path))
(display "interpole_fields : html-sexpr=") (display html-sexpr) (newline)
;; (write-xexpr html-sexpr
;; html-out)
;;(parameterize ([current-unescaped-tags (cons 'th html-unescaped-tags)]) ; escape table header from the rewrite of ampersand for example
;; (display-xml/content (xexpr->xml html-sexpr)
;; html-out
;; #:indentation 'scan
;; ;;'classic
;; )
;;)
;; html-printer lib
(display (xexpr->html5 html-sexpr)
html-out)
(close-output-port html-out)
Other than operator/procedure overloading there is 2 things to look at:
-
the imperative style and infix syntax used for assignment with the
<-(or:=) operator like=in Python,Pascal (:=) , C/C++,Fortran, Java languages... -
the enhanced
ifform that allow also to delimit blocks of statements withthenandelsewithout the need of abeginor other block delimiter with a total back-ward compatibility with normal Scheme syntax as shown in the example below.
;; check there was really greek symbol in physic size and fix the html string
(declare physic-html physic-text)
(if {math = "SCALARS"}
(if {physic = physic-greek4html-sup} then
{physic-html <- physic}
{physic-text <- physic}
else
{physic-html <- (string-append physic " (" physic-greek4html-sup ")")}
{physic-text <- (string-append physic " (" physic-greek-sup ")")})
(if {physic = physic-greek4html-sup} then
{physic-html <- physic}
{physic-text <- (string-append physic "x")}
else
{physic-html <- (string-append physic " (" physic-greek4html-sup ")")}
{physic-text <- (string-append physic "x (" physic-greek-sup "x)")}))
the firstif is used the old scheme way, the others if use a new syntax, both are the same new if macro defined in 2 files (if-then-else.rkt and if-parser.rkt) which does not use any special Racket features but are simply written in scheme.
And there exist too some R6RS versions ( if-then-else.sls and if-parser.sls) and so this exists too for other Scheme+ implementations.
Best Regards,
Damien