mkfunction/mkpolynomial.spl

"#stream.spl" import

"mkpolynomial" =program-name
1 =do-not-dump

func main { status | with args ;
	0 { | "-c" eq if { pop 1 } } args:foreach 
	0 { | "-d" eq if { pop 1 } } args:foreach 
	0 { | with a ; a "-h" eq a "--help" eq or if { pop 1 } } args:foreach 
	with clear dont-ask-degree help ; 
	clear if {
		"." [ 27 _int ] _str ".[H.[2J.[3J" :replace print
	}
	"[-] mkpolynomial v0.3 by TudbuT" println
	"[-] commands: degree, match, delete <n>, precision <digits>, list, ., clear, exit" println
	"[-] args: -d, -c, -h" println
	help if {
		0 exit
	}
	"[-] " println

	def precision 12 =precision

	def f
	def vardecl
	def degree "0" =degree
	dont-ask-degree not if {
		"[0] degree " print
		readln =degree
	}

	catch {
		degree _mega =degree
	} {
		"Invalid degree" panic
	}
	degree 0 derivation =f
	degree mkvardecl =vardecl
	dont-ask-degree not if {
		"==> f(x) = " print
		f println
		"  \\ with " print
		vardecl println
	}

	def i 1 =i

	def exprs 0 anew =exprs
	def expr 

	while { expr "exit" eq not } {
		"[" print i _str print "] " print
		readln =expr
		expr null eq if {
			1 exit
		}
		expr "" eq if {
			2 stop
		}
		"delete " expr:starts-with if {
			def idx ("delete " _array:len) (expr _array:len) (expr _array:sub) _str _mega =idx
			idx 0 gt idx exprs:len ++ lt and if {
					0   idx --    exprs:sub
					idx exprs:len exprs:sub
				aadd =exprs
				i -- =i
			}
			2 stop
		}
		expr "match" eq if {
			"degree " exprs:len -- _str concat =expr
		}
		"degree " expr:starts-with if {
			("degree " _array:len) (expr _array:len) (expr _array:sub) _str _mega =degree
			degree 0 lt if { 0 =degree }
			degree 0 derivation =f
			degree mkvardecl =vardecl
			"==> f(x) = " print
			f println
			"  \\ with " print
			vardecl println
			2 stop
		}
		"precision " expr:starts-with if {
			("precision " _array:len) (expr _array:len) (expr _array:sub) _str _mega =precision
			"==> epsilon = 1e-" print
			precision println
			2 stop
		}
		expr "list" eq expr "." eq or if {
			clear if {
				"." [ 27 _int ] _str ".[H.[2J.[3J" :replace print
			}
			{ | :to-stack with i expr ;
				" <- [" print i ++ print "] " print expr println
			} exprs:iter:enumerate:foreach
			"==> " print
			degree exprs mkmatrix println

			expr "." eq if {
				"==> f(x) = " print
				def giac-out
				[ 
					"giac" 
					"epsilon(1e-" precision _str concat ")" concat
					"Digits:=" precision _str concat
					"f(x):=" f concat 
					vardecl ":=" concat 
						"linsolve(" concat 
						degree exprs mkmatrix concat 
						", " concat
						vardecl concat
						")" concat
					"simplify(f(x))"
				] StreamTypes:cmd:create:read-to-end<128> _str =giac-out
				("," giac-out:split:last) dup _array:sub< _array:len 2 - 0 swap > _str println
			} 
			2 stop
		}
		expr "clear" eq if {
			clear if {
				"." [ 27 _int ] _str ".[H.[2J.[3J" :replace print
			}
			1 =i
			0 anew =exprs
			2 stop
		}
		exprs [ expr ] aadd =exprs
		i ++ =i
	}

	0
}

func mkmatrix { str | with degree exprs ;
	def s "[" =s
	{ | :to-stack with i expr ; 
		s degree expr parse-expr concat =s
		i (exprs:len 1 -) eq not if {
			s "\n    ," concat =s
		}
	} exprs:iter:enumerate:foreach
	s "]" concat
}

func parse-expr { str | with degree expr ;
	def f degree 0 derivation =f
	def s "" =s
	def about-to-call 0 =about-to-call
	def calling 0 =calling
	def calling-derivation
	def calling-args
	{ | with chr ; 
		chr "f" eq if {
			1 =about-to-call
			0 =calling
			0 =calling-derivation
			2 stop
		}
		about-to-call if {
			chr "'" eq if {
				calling-derivation ++ =calling-derivation
			}
			chr "(" eq if {
				1 =calling
				0 =about-to-call
				"" =calling-args
			}
			2 stop
		}
		calling if {
			chr ")" eq dup if {
				0 =calling
				def expr degree calling-derivation derivation =expr
				("x" ("(" calling-args ")" concat concat) expr:replace) =expr
				s "(" concat expr concat ")" concat =s
			} not if {
				calling-args chr concat =calling-args
			}
			2 stop
		}

		s chr concat =s
	} expr _array 
		:iter
		:map<{ str | [ swap ] _str }>
		:foreach
	s
}

func derived-coeff { mega | with derivation input ; 
	(1 { | with n ;
		input n - *)
	} derivation:foreach
}

func derivation { str=function | with degree derivation ; 
	def f "" =f
	{ | with c ;
		def der-coeff derivation c derived-coeff =der-coeff
		c derivation - =c
		c 0 lt if {
			2 stop
		}
		def coeff-var ("c" c derivation + _str concat) =coeff-var
		def expr coeff-var =expr
		c 0 gt if {
				coeff-var "*x^" concat 
				c _str 
			concat =expr
		}
		der-coeff 1 eq not if {
			der-coeff _str expr concat =expr
		}
		expr " + " f concat concat =f
	} (degree 1 +):foreach
	f 0 _str concat
}

func mkvardecl { str | with degree ;
	"["
	0 degree ++ Range:new:iter
		:map<{ | "c" swap _str concat }>
		:join<",">
	"]" concat concat
}