generating image and web page in Racket/scheme with infix notation and scheme+ library

interpole_fields+.rkt

#! /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} ; 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)

	; 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

	(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)	
  
  ;; some code cut here
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	;; 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 "\\&rho;")}
	{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)