Hello and Happy new year,
i think interesting to post an example of code with Scheme+ for Racket used in real in a web application. (that also use PHP,Python...)
Here the Racket Scheme+ code is only used as a glue between other portion of code but perheaps in the future more it will replace more (some Python code).
It is interesting as it shows how the Scheme+ for Racket was able to concurrence Python or PHP and adapts pretty well in any context, here being code on a back-end web server for calling numerical code (in Python) and helping to generate XML data file.
So, here is the code, not interesting as the code itself but to show the syntax possibilities:
#! /usr/bin/env racket
#lang reader SRFI-105
;; interpolate field caller
;; Damien MATTEI
;; export PATH=/Applications/Racket/bin:$PATH
;; install curly-infix and Scheme+ by removing old packages and install in installation mode (for all users) with the GUI package installer of DrRacket
;; mattei@mbp-touch-bar-1 ~ % cp -R Library/CloudStorage/Dropbox/git/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket .
;; mattei@mbp-touch-bar-1 ~ % cp -R Library/CloudStorage/Dropbox/git/SRFI-105-for-Racket .
(module interpolate-field-caller racket
(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
{debug <- #f} ; debug mode: Warning: display python output code to server but will return a fake general error
{π <- pi} ; just for physic formula
(display "Scheme+ : interpole_fields") (newline)
(display "interpole-fields : Racket/Scheme+ library search directory: ") (display (get-lib-search-dirs)) (newline)
(display "interpole-fields : Racket/Scheme+ library collection links:" ) (display (current-library-collection-links)) (newline)
(define cmd-ln-vect (current-command-line-arguments)) ; get the command line
{trajectory-txt <- cmd-ln-vect[0]} ; trajectory
(display "interpole-fields : trajectory-txt=") (display trajectory-txt) (newline)
;; note: another parameter is the data cube
{data-cube-filename <- cmd-ln-vect[1]}
(display "interpole-fields : data-cube-filename=") (display data-cube-filename) (newline)
;; creating a temporary directory for output of computation (physical data value at trajectory points)
{output-dir <- (string-append trajectory-txt "_directory")}
(display "interpole-fields : output-dir=") (display output-dir) (newline)
;;(make-directory* trajectory-txt)
(make-directory* output-dir)
(define trajectory-file (string-append trajectory-txt ".txt"))
(display "interpole-fields : trajectory-file=") (display trajectory-file) (newline)
{trajectory-xml <- (string-append trajectory-txt ".xml")}
;; open output XML file (because PHP had already created a partial header)
(define xml-file (open-output-file #:exists 'append trajectory-xml))
;; launcher directory (web server, command line shell ...)
(define cur-dir (current-directory))
(display "interpole-fields : launcher current directory=") (display cur-dir) (newline)
(current-directory (build-path (current-directory) "drive")) ; setting the current directory for interpolation
(define interpol-dir (current-directory))
(display "interpole-fields : directory for interpolation=") (display interpol-dir) (newline)
;; setting Python paths
(define python-path (getenv "PYTHONPATH"))
(display "interpole-fields : PYTHONPATH=") (display python-path) (newline)
(when (not python-path)
(display "interpole-fields : setting PYTHONPATH") (newline)
(putenv "PYTHONPATH" ".:fibo") ;:drive/.:drive/fibo")
{python-path <- (getenv "PYTHONPATH")} ;(set! python-path (getenv "PYTHONPATH"))
(display "interpole-fields : PYTHONPATH=") (display python-path) (newline))
;; effaceur
;; {B-file := (string-append output-dir "/trajectory-near_Mio_B_6000.txt")}
;; {rhoe-file := (string-append output-dir "/trajectory-near_Mio_rhoe0_6000.txt")}
;; (define prcss-lst (process* "/bin/rm"
;; ;;"-f"
;; B-file ;"output/trajectory-near_Mio_B_6000.txt"
;; rhoe-file ;"output/trajectory-near_Mio_rhoe0_6000.txt"
;; #:set-pwd? interpol-dir))
;; (display "interpole_fields : prcss-lst =") (display prcss-lst) (newline)
;; (define prcss-vct (list->vector prcss-lst))
;; {eff-stdout <- prcss-vct[0]}
;; {eff-stdin <- prcss-vct[1]}
;; {eff-id <- prcss-vct[2]}
;; {eff-stderr <- prcss-vct[3]}
;; {eff-proc-ctrl <- prcss-vct[4]}
;; ;;(display "interpole_fields : passed") (newline)
;; (define eff-err-lns (port->lines eff-stderr))
;; (define eff-len-err-lns (length eff-err-lns))
;; (display "number of lines in eff-stderr=") (display eff-len-err-lns) (newline)
;; (when {eff-len-err-lns > 0}
;; (display "Effaceur Error lines:") (display eff-err-lns) (newline))
;; (define eff-out-lns (port->lines eff-stdout))
;; (display "Output of effaceur:") (display eff-out-lns) (newline)
(display "interpole_fields : start of Interpolation code in Python: ") (display (current-date)) (newline)
;; this launch the Interpolation code in Python
(define prcss-python-lst (process* "/Library/Frameworks/Python.framework/Versions/3.11/bin/python3.11"
"cut_1D.py" ; the interpolation code
"../Data"
;; note: the trajectory files can contain index or time in the first column
trajectory-file ; "BepiColombo-Mio_MSO-orbit_1min_short.txt"
output-dir ;"output"
(string-append "../" data-cube-filename)
#:set-pwd? interpol-dir))
;;(display "End of execution Python code.") (newline)
;;(display "interpole_fields : prcss-python-lst =") (display prcss-python-lst) (newline)
(define prcss-python-vct (list->vector prcss-python-lst))
{stdout <- prcss-python-vct[0]}
{stdin <- prcss-python-vct[1]}
{python-id <- prcss-python-vct[2]}
{stderr <- prcss-python-vct[3]}
{python-proc-ctrl <- prcss-python-vct[4]}
(define err-lns (port->lines stderr))
(define len-err-lns (length err-lns))
(display "number of lines in stderr=") (display len-err-lns) (newline)
(when {len-err-lns > 0}
(display "Error lines:") (display err-lns) (newline))
;;(declare out-lns) ; reserved keyword !!
(when debug
{zout-lns <- (port->lines stdout)}
(display "Python output lines:") (display zout-lns) (newline))
(define out-lns (port->lines stdout))
;;(display "Output of python interpolation code:") (newline) (display out-lns) (newline)
(define out-lns-vct (list->vector out-lns))
{last-text <- out-lns-vct[-1]} ; the last text should contains the status ,CPU if not fail
(display "interpole_fields : end of Interpolation code in Python: ") (display (current-date)) (newline)
;; get the resulting path file list
(define output-path-file-lst (directory-list output-dir))
{output-file-lst <- (map path->string output-path-file-lst)} ; convert path in string
{possible-output-file-lst <- (filter (λ (str) (string-contains str "trajectory-near_"))
output-file-lst)}
(declare output-file)
(if (null? possible-output-file-lst)
(error "interpole_fields : can not find an output file")
{output-file <- (first possible-output-file-lst)}) ; take the first one (normally should be only one)
(display "interpole_fields : output-file: ") (display output-file) (newline)
{output-file-with-path <- (string-append output-dir "/" output-file)}
(display "interpole_fields : output-file-with-path: ") (display output-file-with-path) (newline)
;; reading output file of interpolated data
;; read all lines
{output-file-lines <- (read-lines output-file-with-path)}
{vl <- (list->vector output-file-lines)}
;; we will soon need the math type of the data and the safer way is to get it from the original VTK file itself, not from other stuff
{data-cube-port <- (open-input-file (string-append "../" data-cube-filename))}
(declare math-physic-computer-line)
(for ({i <- 0} {i < 9} {i <- i + 1}) ; go to the line 9 that contains sort of : VECTORS B float
{math-physic-computer-line <- (read-line data-cube-port)})
(close-input-port data-cube-port)
(display "interpole_fields : math-physic-computer-line: ") (display math-physic-computer-line) (newline)
{math-physic-computer-vect <- (list->vector (string-split math-physic-computer-line))}
{math <- math-physic-computer-vect[0]} ; examples: VECTORS, SCALARS
{physic <- math-physic-computer-vect[1]} ; example: B
{computer <- math-physic-computer-vect[2]} ; example: float
;; the first header line that contains comments
{head <- vl[0]} ; example: #index X_MSO Y_MSO Z_MSO Bx By Bz
{sph <- (string-split head)}
(display "interpole_fields : sph: ") (display sph) (newline)
(declare xs ys zs vx vy vz)
(if (string=? math "VECTORS")
{(sharp-index xs ys zs vx vy vz) <- (apply values sph)}
{(sharp-index xs ys zs vx) <- (apply values sph)})
;; procedure to search and return one value from the lines of constant.txt file, giving a key
(define (find-value-in-lines key lines)
{key-filter <- (filter (λ [line] ; try with [ ]
((length(line) = 3) and (string=? (first line) key))) ; try length in neoteric infix expr
lines)}
(display "interpole_fields : key-filter= ") (print key-filter) (newline)
(when (not key-filter)
(error (string-append "can not find " key)))
(third (first key-filter)))
;; constant.txt data file procedures
{constant-data-file-name <- "../Data/constant.txt"} ; constant data file
{lines-constant-data <- (read-lines constant-data-file-name)} ; read all the lines
{splitted-lines-constant <- (map string-split lines-constant-data)} ; split by spaces
(display "interpole_fields : splitted-lines-constant= ") (display splitted-lines-constant) (newline)
;; find the unit of valor
{key-unit <- (string-append physic "sw_unit")} ; example: Bsw_unit
(display "interpole_fields : key-unit= ") (display key-unit) (newline)
{valor-unit <- (find-value-in-lines key-unit splitted-lines-constant)}
(display "interpole_fields : valor-unit= ") (display valor-unit) (newline)
;; append the fields for data value of the cube at interpolation point in the XML file (PHP already created a partial header)
;; first works for VECTORS and SCALARS
(define xexpr
`(FIELD ((name ,vx)
(ID "col5")
(ucd "")
(utype "")
(datatype ,computer)
(width "")
(unit ,valor-unit)))) ; unit set dynamically (read from constant.txt)
(display-xml/content (xexpr->xml xexpr)
#:indentation 'classic
xml-file)
;; only for VECTORS
(when (string=? math "VECTORS") ; not SCALARS
{xexpr <- `(FIELD ((name ,vy)
(ID "col6")
(ucd "")
(utype "")
(datatype ,computer)
(width "")
(unit ,valor-unit)))}
(display-xml/content (xexpr->xml xexpr)
#:indentation 'classic
xml-file)
{xexpr <- `(FIELD ((name ,vz)
(ID "col7")
(ucd "")
(utype "")
(datatype ,computer)
(width "")
(unit ,valor-unit)))}
(display-xml/content (xexpr->xml xexpr)
#:indentation 'classic
xml-file))
;; read all lines of trajectory file text to get the timestamps (because we have only index in Python output interpolated file)
{input-lines <- (read-lines trajectory-file)}
{vl-trajectory <- (list->vector input-lines)}
{data-trajectory <- vl-trajectory[5 :]} ; skip the header to go to the data lines of the trajectory input file, the trajectory file contains timestamp usefull for generating the XML output file
{data-interpol <- vl[1 :]} ; the numerical data lines without the header commented line of the output file of simulation that contains data physical values for the output XML file
;; read SimulationData.txt
{simulation-data-file <- "../Data/SimulationData.txt"} ; the simulation data input file used by cut1D.py ,contains data from iPIC3D perheaps
{lines-simulation-data <- (read-lines simulation-data-file)} ; read all the lines
{splitted-lines-simulation <- (map string-split lines-simulation-data)} ; split by spaces
;; compute norm
;; take in SimulationData.txt Bo or Vo x,y,z, compute norm
;; or for scalars usr hard coded values , such as for rhoe
(declare size0) ; next, we compute size0
(if (string=? math "SCALARS") then
{size0 <- (case physic
[("rhoe") {1 / (4 * π)}] ; hard coded as it is not in SimulationData.txt
;; possibly others hard coded values
[else (error "interpole_fiels+.rkt : unknow physic size :" physic)])}
else ; VECTORS, etc
;; find B0x (example) in file
{key-x <- (string-append physic "0x")}
{size0x-filter <- (filter (λ (line) (string=? (first line) key-x)) ; generic, example: B0x
splitted-lines-simulation)}
(when (not size0x-filter)
(error "interpole_fiels+.rkt : can not find value for:" key-x))
{size0x-str <- (third (first size0x-filter))}
;; procedure to search and return one coord from the lines of file
(define (find-coord-in-lines coord lines)
{coord-filter <- (filter (λ (line) (string=? (first line) coord))
lines)}
(when (not coord-filter)
(error (string-append "interpole_fiels+.rkt : can not find " coord)))
(third (first coord-filter)))
;; find B0y ,B0z (examples) in file
{key-y <- (string-append physic "0y")}
{key-z <- (string-append physic "0z")}
{size0y-str <- (find-coord-in-lines key-y splitted-lines-simulation)}
{size0z-str <- (find-coord-in-lines key-z splitted-lines-simulation)}
{size0x <- (string->number size0x-str)}
{size0y <- (string->number size0y-str)}
{size0z <- (string->number size0z-str)}
{size0 <- (sqrt (size0x ** 2 + size0y ** 2 + size0z ** 2))} ; compute norm
(display "interpole_fields : size0= ") (display size0) (newline))
;; use constant.txt
;; return the numerical value from the key
;; take Vsw,Bsw,rhoesw from a separate file
(define (find-number-in-lines key lines)
(string->number (find-value-in-lines key lines)))
{keysw <- (string-append physic "sw")} ; example: Bsw
(display "interpole_fields : keysw= ") (display keysw) (newline)
{sizesw <- (find-number-in-lines keysw splitted-lines-constant)}
(display "interpole_fields : sizesw= ") (display sizesw) (newline)
;; prepare XML data
{data-xml <- (for/list ([one-data-row data-interpol]
[one-trajectory-row data-trajectory])
(if (string=? math "VECTORS") then
{(index X_MSO Y_MSO Z_MSO VALx VALy VALz) <- (apply values
(string-split one-data-row))}
{(time-stamp x_traj_mso y_traj_mso z_traj_mso) <- (apply values
(string-split one-trajectory-row))}
;; compute B or V in output file like this:
;; B_x|y|z_XML=Bintermediate_unit_code_x|y|z * Bsw / |Bo input| with Bsw=10nT
(define (cal val) {val * sizesw / size0})
`(TR (TD ,time-stamp)
(TD ,X_MSO)
(TD ,Y_MSO)
(TD ,Z_MSO)
(TD ,(number->string
(cal
(string->number VALx))))
(TD ,(number->string
(cal
(string->number VALy))))
(TD ,(number->string
(cal
(string->number VALz)))))
else ; SCALARS
{(index X_MSO Y_MSO Z_MSO VALx) <- (apply values
(string-split one-data-row))}
{(time-stamp x_traj_mso y_traj_mso z_traj_mso) <- (apply values
(string-split one-trajectory-row))}
;; compute B or V in output file like this:
;; B_x|y|z_XML=Bintermediate_unit_code_x|y|z * Bsw / |Bo input| with Bsw=10nT
(define (cal val) {val * sizesw / size0})
`(TR (TD ,time-stamp)
(TD ,X_MSO)
(TD ,Y_MSO)
(TD ,Z_MSO)
(TD ,(number->string
(cal
(string->number VALx)))))))}
;;(display "interpole_fields : data-xml=") (display data-xml) (newline)
;; create the DATA, TABLEDATA
{xexpr <- `(DATA
(TABLEDATA ,@data-xml))}
;; write to the real XML file
(display-xml/content (xexpr->xml xexpr)
#:indentation 'classic
xml-file)
(newline xml-file)
;; close the TAGs that were opened by the... PHP code !
(display " </TABLE>\n </RESOURCE>\n</VOTABLE>\n" xml-file)
(flush-output xml-file)
;;(close-output-port xml-file)
(display "interpole_fields : end of post-processing XML file: ") (display (current-date)) (newline)
;; display the file name
(display "interpole_fields : trajectory-xml=") (display trajectory-xml) (newline)
;; copy file to make it public to the remote web browser
{basename-trajectory-xml <- (basename trajectory-xml)}
(copy-file trajectory-xml (string-append "../" basename-trajectory-xml))
(display " interpole_fields : last-text=") (display last-text) ; this last line should be in $message variable of PHP caller to inform it all is ok by writing the CPU string in the message
;; for my program the outport port of the subprocess are my input ports and vice versa
(close-input-port stdout)
(close-output-port stdin)
(close-input-port stderr)
) ; end module
note ,only for debugging but it skips the reader parsing (which is indeed fast enough) on the web server i use a traditional Makefile that parse code from Scheme+ to Scheme,here it is for information,enought generic to be reused in others projects:
# example of Makefile for Scheme+ for Racket
# generic Makefile for all Scheme and Racket files
# author: Damien Mattei
# make interpole_fields
# export PATH=/Applications/Racket/bin:$PATH
SHELL := /bin/bash
# path to SRFI-105 directory
SRFI-105=../../../../../Users/mattei/SRFI-105-for-Racket
# for MacOS:
#SCHEME_EXEC=/Applications/Racket\ v8.12/bin/racket
SCHEME_EXEC=racket
# Scheme+ for parser
#PARSER:=$(SCHEME_EXEC) $(SCHEME_PLUS)/src/curly-infix2prefix4racket.rkt
PARSER:=$(SRFI-105)/src/curly-infix2prefix4racket.rkt
# sub directory where parsed module files will be generated
MODULE_DIRECTORY=parsed_files_directory
# Scheme+ program to be parsed
MODULES_NAME=$(wildcard *+.rkt *+.scm)
# Scheme programs to create by parsing the Scheme+ files
OBJECT=$(addprefix $(MODULE_DIRECTORY)/,$(MODULES_NAME))
# create directory, build objects
# note: parsed files have the same name than source files but are in different directories
all: $(MODULE_DIRECTORY) $(OBJECT)
# create the sub directory where parsed module files will be
$(MODULE_DIRECTORY) :
mkdir $@
# create Scheme files (*.scm , *+.scm , *-.scm) by parsing Scheme+ files (*+.scm)
# if an error occur and the file is empty it will stop further Makefile call so i remove it:
.DELETE_ON_ERROR:
# create Scheme files (*.scm) by parsing Scheme+ files (*+.scm)
$(MODULE_DIRECTORY)/%+.scm: %+.scm $(MODULE_DIRECTORY)
@echo PARSING $< :
$(PARSER) $< > $@
# create Scheme files (*.rkt) by parsing Scheme+ files (*+.rkt)
$(MODULE_DIRECTORY)/%+.rkt: %+.rkt $(MODULE_DIRECTORY)
@echo PARSING $< :
$(PARSER) $< > $@
clean:
rm -rf $(OBJECT)
rm -rf $(MODULE_DIRECTORY)
interpole_fields:$(MODULE_DIRECTORY)/interpole_fields+.rkt
cp $(MODULE_DIRECTORY)/interpole_fields+.rkt interpole_fields
chmod a+x interpole_fields
in the future i'm improving again the infix/prefix auto detection algorithm by using a finite state machine to reach almost 100% of detection.(100% could be done in Racket but not portable to other scheme implementation so i will restrict this to 95% for compatibility reason) This is very amazing but not yet completely implemented and i 'am making diagram of automaton.
Meilleurs Voeux
Best Wishes