test 実行結果
実行結果
~/bin/go ~/Maxlib-20/chkshow.mx
##
## batch("/home/inoue/Maxlib-20/chkshow.mx")
##
## read and interpret /home/inoue/Maxlib-20/chkshow.mx
## batchload("/home/inoue/Maxlib-20/on3lib21.mx")
## on3env()
## -- <on3env> logbegin --
## maxima_tempdir = TMP/tmp_maxima figs_dir = figs
## chkerrsum:0
## logshow([args]):=block([progn:"<chkshow>",debug,cmds,cmdsL,out],debug:ifargd(),
## if length(args) = 0 or args[1] = 'help then go(block_help),
## if args[1] = 'ex then go(block_ex),go(block_main),block_help,
## printf(true,
## "
## --begin of logshow('help)--
## 機能: 入力履歴(文字列)の一括評価
## 文法: logshow(cmds,...)
## 例示: logshow(cmds)
## --end of logshow('help')--
## "),
## return('normal_return),block_ex,print("--begin of logshow('ex)--"),
## block([cmds,f,df,out],
## cmds:sconcat("( /* Ex. of on3diff(f,x) */ ",
## "f : x^3*on3(x,1,3,co), df : on3diff(f,x) ) "),
## out:logshow(cmds),c0show(out)),print("--end of logshow('ex)--"),
## return("--end of logshow('ex)--"),block_main,cmds:args[1],cmdsL:split(cmds,"@"),
## cmds:sremove("@",cmds),
## for i thru length(cmdsL) do
## if i = 1 then print("★ ",cmdsL[1]) else print(" ",cmdsL[i]),
## out:eval_string(cmds),return(out))
## chk1show([args]):=block([progn:"<chkshow>",debug,cmds,ans,hlp,hlpL,cmdsL,w_out,chk,chkm],
## debug:ifargd(),if length(args) = 0 or args[1] = 'help then go(block_help),
## if args[1] = 'ex then go(block_ex),go(block_main),block_help,
## printf(true,
## "
## --begin of chk1show('help)--
## 機能: 入力履歴と結果の検証
## 文法: chk1show(cmds,ans,...)
## 例示:
## chk1show(\"/* Ex.0 of chk1show */ @ diff(sin(x),x)\" , cos(x))
## cmds : sconcat(\"(\",
## \"/* chk1showの使用例 */ @\",
## \"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @\",
## \"F : on3integ19(f,x), \",
## \"F : on3decomp(F) \",
## \")\"
## ),
## Fans : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)
## +2*f1*on3(x,3,4,co)+f1*(x-1)*on3(x,1,3,co),
## chk1show(cmds,Fans),
## chk1show(cmds,\"\"), /* (検証なしの場合) */
## --end of chk1show('help')--
## "),
## return('normal_return),block_ex,print("--begin of chk1show('ex)--"),
## block([progn:"<chk1show_ex>",debug,cmds,Fans,f,f1,f2,F,out,a,b,assL],
## chk1show("/* 例0. ダイレクト使用 */ @ diff(sin(x),x)",cos(x)),
## cmds:sconcat("(","/* 例1 chk1showの使用例 */ @",
## "f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @",
## "F : on3integ19(f,x), ","F : on3decomp21(F) ",")"),
## Fans:2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)
## +2*f1*on3(x,3,4,co)+f1*(x-1)*on3(x,1,3,co),
## chk1show(cmds,Fans),
## cmds:sconcat("(","/* 例2 chk1showの使用例(検証なしの例) */ @",
## "f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @",
## "F : on3integ19(f,x), ","F : on3decomp21(F) ",")"),
## chk1show(cmds,""),
## cmds:sconcat("(",
## "/* 例3 後処理が必要な場合:仮定の設定,ソート,仮定の解除 */ @",
## "assL : [1<a, a<3, 3<b], apply('assume, assL), @",
## "out : ecsort([1,3,a,b]), forget(assL), out @",")"),
## chk1show(cmds,[1,a,3,b])),print("--end of chk1show('ex)--"),
## return("--end of chk1show('ex)--"),block_main,cmds:args[1],ans:args[2],
## cmdsL:split(cmds,"@"),cmds:sremove("@",cmds),
## for i thru length(cmdsL) do
## if i = 1 then print("★ ",cmdsL[1]) else print(" ",cmdsL[i]),
## w_out:eval_string(cmds),
## if ans = "" then (print(" out = ",w_out),return(w_out)),
## if listp(w_out) and is(equal(w_out,ans)) = true then (chk:true,chkm:"◎ ")
## else (chk:false,chkm:"❌ ",chkerrsum:chkerrsum+1),
## if listp(w_out) = false
## then (if numberp(w_out) and abs(w_out-ans) < 1.0E-8
## then (chk:true,chkm:"◎ ")
## else (if is(equal(expand(w_out),expand(ans))) = true
## then (chk:true,chkm:"◎ ")
## else (chk:false,chkm:"❌ ",chkerrsum:chkerrsum+1))),
## if slength(sconcat(w_out)) < 500 then print(chkm,"out =",w_out)
## else print(chkm,"reveal(w_out,6) =",reveal(w_out,6)),
## if chk = false then print(" <- ans =",ans),return(w_out))
## chk2show([args]):=block(
## [progn:"<chk2show>",debug,cmds,ans,hlp,hlpL,cmdsansL,cmdsL,w_out,outL,chk,chkm],
## debug:ifargd(),if length(args) = 0 or args[1] = 'help then go(block_help),
## if args[1] = 'ex then go(block_ex),go(block_main),block_help,
## block([cmds,Fans],
## printf(true,
## "
## --begin of chk2show('help)--
## 機能: 入力履歴と結果の検証
## 文法: chk2show(cmds,ans,...), chk2show([[cmds1,ans1]])
## chk2show([[cmds1,ans1],[cmds2.ans2],...])
## 例示:
## cmds : sconcat(\"(\",
## \"/* chk2showの使用例 */ @\",
## \"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @\",
## \"F : on3integ19(f,x), \",
## \"F : on3decomp(F) \",
## \")\"
## ),
## Fans : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)
## +2*f1*on3(x,3,4,co)+f1*(x-1)*on3(x,1,3,co),
## chk2show(cmds,Fans),
## chk2show(cmds,\"\"), /* (検証なしの場合) */
## --end of chk2show('help')--
## ")),
## return('normal_return),block_ex,print("--begin of chk2show('ex)--"),
## block([progn:"<chk2show_ex>",debug,f,f1,f2,F,cmds1,Fans1,cmds2,Fans2,outL],
## cmds1:sconcat("(","/* chk2showの使用例1 */ @",
## "f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @",
## "F : on3integ19(f,x), ","F : on3decomp(F) ",")"),
## Fans1:2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)
## +2*f1*on3(x,3,4,co)+f1*(x-1)*on3(x,1,3,co),
## cmds2:sconcat("(","/* chk2showの使用例2 */ @",
## "f : f1*on3(x,1,3,co) + f2*on3(x,2,6,co), /* fの定義 */ @",
## "F : on3integ19(f,x), ","F : on3decomp(F) ",")"),
## Fans2:2*(2*f2+f1)*on3(x,6,inf,co)+(f2*x-2*f2+2*f1)*on3(x,3,6,co)
## +(f2*x+f1*x+(-2)*f2-f1)*on3(x,2,3,co)
## +f1*(x-1)*on3(x,1,2,co),
## chk2show(cmds1,Fans1),c0show("===複数個の例の場合===="),
## outL:chk2show([[cmds1,Fans1],[cmds2,Fans2]]),cshow(outL),
## for i thru length(outL) do
## (display2d:true,on3show(outL[i]),display2d:false),
## return("--end of chk2show_ex--")),print("--end of chk2show('ex)--"),
## return("--end of chk2show('ex)--"),block_main,
## if listp(args[1]) = false then cmdsansL:[[args[1],args[2]]]
## else (if listp(args[1][1]) = false then cmdsansL:[args[1]]
## else cmdsansL:args[1]),c1show(progn,cmdsansL),outL:[],
## for k thru length(cmdsansL) do
## (cmds:cmdsansL[k][1],ans:cmdsansL[k][2],cmdsL:split(cmds,"@"),
## cmds:sremove("@",cmds),
## for i thru length(cmdsL) do
## if i = 1 then print("★ ",cmdsL[1]) else print(" ",cmdsL[i]),
## w_out:eval_string(cmds),
## if ans = "" then (print(" out = ",w_out),return(w_out)),
## if listp(w_out) and is(equal(w_out,ans)) = true then (chk:true,chkm:"◎ ")
## else (chk:false,chkm:"❌ ",chkerrsum:chkerrsum+1),
## if listp(w_out) = false
## then (if numberp(w_out) and abs(w_out-ans) < 1.0E-8
## then (chk:true,chkm:"◎ ")
## else (if is(equal(expand(w_out),expand(ans))) = true
## then (chk:true,chkm:"◎ ")
## else (chk:false,chkm:"❌ ",
## chkerrsum:chkerrsum+1))),
## if slength(sconcat(w_out)) < 500 then print(chkm,"out =",w_out)
## else print(chkm,"reveal(w_out,6) =",reveal(w_out,6)),
## if chk = false then print(" <- ans =",ans),outL:endcons(w_out,outL)),
## return(outL))
## if true
## then (logshow(),logshow('ex),chk0show(),chk0show('ex),chk1show(),chk1show('ex),
## chk2show(),chk2show('ex))
##
## --begin of logshow('help)--
## 機能: 入力履歴(文字列)の一括評価
## 文法: logshow(cmds,...)
## 例示: logshow(cmds)
## --end of logshow('help')--
##
## --begin of logshow('ex)--
## ★ ( /* Ex. of on3diff(f,x) */ f : x^3*on3(x,1,3,co), df : on3diff(f,x) )
## out = 3*x^2*on3(x,1,3,oo)
## --end of logshow('ex)--
##
## --begin of chk1show('help)--
## 機能: 入力履歴と結果の検証
## 文法: chk1show(cmds,ans,...)
## 例示:
## chk1show("/* Ex.0 of chk1show */ @ diff(sin(x),x)" , cos(x))
## cmds : sconcat("(",
## "/* chk1showの使用例 */ @",
## "f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @",
## "F : on3integ19(f,x), ",
## "F : on3decomp(F) ",
## ")"
## ),
## Fans : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)
## +2*f1*on3(x,3,4,co)+f1*(x-1)*on3(x,1,3,co),
## chk1show(cmds,Fans),
## chk1show(cmds,""), /* (検証なしの場合) */
## --end of chk1show('help')--
##
## --begin of chk1show('ex)--
## ★ /* 例0. ダイレクト使用 */
## diff(sin(x),x)
## ◎ out = cos(x)
## ★ (/* 例1 chk1showの使用例 */
## f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */
## F : on3integ19(f,x), F : on3decomp21(F) )
## ◎ out =
## (2*f2+2*f1)*on3(x,6,inf,co)+(f2*(x-4)+2*f1)*on3(x,4,6,co)+2*f1*on3(x,3,4,co)
## +f1*(x-1)*on3(x,1,3,co)
## ★ (/* 例2 chk1showの使用例(検証なしの例) */
## f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */
## F : on3integ19(f,x), F : on3decomp21(F) )
## out =
## (2*f2+2*f1)*on3(x,6,inf,co)+(f2*(x-4)+2*f1)*on3(x,4,6,co)+2*f1*on3(x,3,4,co)
## +f1*(x-1)*on3(x,1,3,co)
## ★ (/* 例3 後処理が必要な場合:仮定の設定,ソート,仮定の解除 */
## assL : [1<a, a<3, 3<b], apply('assume, assL),
## out : ecsort([1,3,a,b]), forget(assL), out
## )
## ◎ out = [1,a,3,b]
## --end of chk1show('ex)--
##
## --begin of chk2show('help)--
## 機能: 入力履歴と結果の検証
## 文法: chk2show(cmds,ans,...), chk2show([[cmds1,ans1]])
## chk2show([[cmds1,ans1],[cmds2.ans2],...])
## 例示:
## cmds : sconcat("(",
## "/* chk2showの使用例 */ @",
## "f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @",
## "F : on3integ19(f,x), ",
## "F : on3decomp(F) ",
## ")"
## ),
## Fans : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)
## +2*f1*on3(x,3,4,co)+f1*(x-1)*on3(x,1,3,co),
## chk2show(cmds,Fans),
## chk2show(cmds,""), /* (検証なしの場合) */
## --end of chk2show('help')--
##
## --begin of chk2show('ex)--
## ★ (/* chk2showの使用例1 */
## f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */
## F : on3integ19(f,x), F : on3decomp(F) )
## ◎ out =
## 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)+2*f1*on3(x,3,4,co)
## +f1*(x-1)*on3(x,1,3,co)
## ===複数個の例の場合====
## ★ (/* chk2showの使用例1 */
## f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */
## F : on3integ19(f,x), F : on3decomp(F) )
## ◎ out =
## 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)+2*f1*on3(x,3,4,co)
## +f1*(x-1)*on3(x,1,3,co)
## ★ (/* chk2showの使用例2 */
## f : f1*on3(x,1,3,co) + f2*on3(x,2,6,co), /* fの定義 */
## F : on3integ19(f,x), F : on3decomp(F) )
## ◎ out =
## 2*(2*f2+f1)*on3(x,6,inf,co)+(f2*x-2*f2+2*f1)*on3(x,3,6,co)
## +(f2*x+f1*x-2*f2-f1)*on3(x,2,3,co)+f1*(x-1)*on3(x,1,2,co)
##
## CS: outL =
## [2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)+2*f1*on3(x,3,4,co)
## +f1*(x-1)*on3(x,1,3,co),
## 2*(2*f2+f1)*on3(x,6,inf,co)+(f2*x-2*f2+2*f1)*on3(x,3,6,co)
## +(f2*x+f1*x-2*f2-f1)*on3(x,2,3,co)+f1*(x-1)*on3(x,1,2,co)]
##
## [ f1 (x - 1) (1 <= x < 3) ]
## [ ]
## [ 2 f1 (3 <= x < 4) ]
## [ ]
## outL = [ f2 x - 4 f2 + 2 f1 (4 <= x < 6) ]
## i [ ]
## [ 2 (f2 + f1) (6 <= x < inf) ]
## [ ]
## [ 0 ( otherwise ) ]
## [ f1 (x - 1) (1 <= x < 2) ]
## [ ]
## [ f2 x + f1 x - 2 f2 - f1 (2 <= x < 3) ]
## [ ]
## outL = [ f2 x - 2 f2 + 2 f1 (3 <= x < 6) ]
## i [ ]
## [ 2 (2 f2 + f1) (6 <= x < inf) ]
## [ ]
## [ 0 ( otherwise ) ]
## --end of chk2show('ex)--
## values
## [ass_hist,chkerrsum,icerror,USER,HOME,ENV,cmd,tmpdirsL,tmp_dir,tmp_maxima_dir,
## tmp_user_dir,tmp_lang_dir,figs_dir,expr]
## quit()
~/Maxlib-20/on3lib21.mx のソース
cat ~/Maxlib-20/on3lib21.mx
/* on3lib21.mx 2021.03.16 (by INOUE Takakatsu) */
/*### --- fsplit: on3env.mx --- ###########################################*/
/*### on3env : on3ライブラリーの環境設定 2020.05.21 ###*/
/*#########################################################################*/
on3env([args]) ::= block([progn:"<on3env>",outmsg],
/* Maxima 作業用ディレクトリの設定 */
USER : "inoue", HOME : "/home/inoue", ENV : sconcat(HOME,"/.env/tmp_dirsL"),
cmd : sconcat("/home/",USER,"/","bin/tmpdirs2env resetmaxima"),
system(cmd),
tmpdirsL : read_list(ENV),
tmp_dir : tmpdirsL[1], tmp_maxima_dir : tmpdirsL[2], tmp_user_dir : tmpdirsL[3],
tmp_lang_dir : tmpdirsL[4], figs_dir : tmpdirsL[5],
maxima_tempdir : tmp_maxima_dir,
/* on3lib20 関連の規則の追加 */
if true then ( on3rules() ),
if false then batchload("/home/inoue/Maxlib-20/on3ineq20lib.mx"),
/* 環境 */
if true then (
display2d:false,
linel:90,
radexpand:true,
/* domain:complex$ m1pbranch:true$ */
fpprintprec:8,
alias(ineqex, on3ineq_ex),
kill(labels),
print("-- ", progn," logbegin --")
),
c0show(maxima_tempdir,figs_dir),
outmsg : sconcat("-- on3 library Env Set : tmp_dir, on3rules, global vars --"),
return(outmsg)
)$
ass_hist : []$
chkerrsum : 0$ /* グローバル(Global)変数 */
icerror:0$
/*#########################################################################*/
/*### on3lib : on3ライブラリーのロードと環境設定 2020.05.21 ###*/
/*#########################################################################*/
on3lib([args]) ::= block([outmsg],
if false then print(args),
clear_rules(),
if false then (
init_str : "/home/inoue/.maxima/max-init.mac",
kill(allbut(init_str,args)),
batchload(init_str)
),
if length(args)=0 then (
batchload("/home/inoue/Maxlib-20/on3lib21.mx"),
on3env(), /* Maxiima 作業用ディレクトリの設定と規則の設定 */
outmsg : sconcat("-- batchload: ",
"--- ~/Maxlib-20/on3lib21.mx and on3env() ---")
),
if length(args)>0 and member(args[1],[21]) then (
batchload("/home/inoue/Maxlib-20/on3lib21.mx"),
on3env(), /* Maxiima 作業用ディレクトリの設定と規則の設定 */
outmsg : sconcat("-- batchload: ",
"--- ~/Maxlib-20/on3lib21.mx and on3env() ---")
),
if length(args)>0 and member(args[1],[20]) then (
batchload("/home/inoue/Maxlib-20/on3lib20all.mx"),
on3env(), /* Maxiima 作業用ディレクトリの設定と規則の設定 */
outmsg : sconcat("-- batchload: ",
"--- ~/Maxlib-20/on3lib20all.mx and on3env() ---")
),
if (length(args)>0) and member(args[1],[19]) then (
batchload("/home/inoue/Maxlib-20/on3lib19.mx"),
batchload("/home/inoue/Maxlib-20/on3ineq19lib.mx"),
outmsg : sconcat("-- batchload: ",
"~/Maxlib-20/on3lib19.mx,~/Maxlib-20/on3ineq19lib.mx ---")
),
if (length(args)>0) and member(args[1],[17]) then (
batchload("/home/inoue/Maxlib-11/on3lib.mx"),
batchload("/home/inoue/Maxlib-11/on3ineq17lib.mx"),
outmsg : sconcat("-- batchload: ",
"~/Maxlib-11/on3lib.mx,~/Maxlib-11/on3ineq17lib.mx ---")
),
print(outmsg),
return(outmsg)
)$
/*#########################################################################*/
/*### max_save : Maxima 状態の保存と復元 2020.05.21 ###*/
/*#########################################################################*/
max_save([args]) ::= block([max_save_file:"/tmp/max_save.lisp",cmd],
cmd : sconcat("save(\"",max_save_file,"\", all)"),
print(cmd),
eval_string(cmd)
)$
/*#########################################################################*/
/*### max_restore : Maxima の復元 2020.05.21 ###*/
/*#########################################################################*/
max_restore([args]) ::= block([max_save_file:"/tmp/max_save.lisp"],
load(max_save_file),
on3env(), /* 作業用ディレクトリの設定, on3環境設定 */
return("-- restored and on3env() ---")
)$
/*### --- fsplit: on3-head.mx --- #######################################*/
/* [ on3lib.mx ] Ver. 1.9 (by Takakatsu INOUE) */
/* (2007-06-27, 2007-09-14, 2007-12-11, 2008-02-29, 2009-03-29(改訂) */
/*######################################################################*/
/*--- 関数の参照関係
on3 --- f2l
on3simp --- (on3rule2, on3rule5), on3rngm
on3decomp --- on3decomp_inv, on3decomp_decomp, on3decomp_reduce,
on3decomp_decomp --- on3lrl, on3rule5, on3simp
on3std --- on3std_sub, on3typep, on3lrl
on3ev --- on3typep, on3std
on3diff --- on3typep, on3lrl, on3decomp, on3show
on3integ --- on3typep, on3lrl, on3std, on3decomp, on3show
on3chgvar2 --- on3std, f2l, l2f
on3show --- on3show_sub, on3typep
on3pw
* f2l, l2f, ifargd, cshow, d1show, d2show, d3show --- 全般的に使用
注： on2で始まるシンボル名，シンボル cc,co,oc,oo,eval は予約語とする．
----------------------------------------------------------------------*/
/*#########################################################################*/
/* ### funcs : ユーザ定義の関数名,マクロ名のリストの文字列化とソート,検索,等の処理 ###*/
/*#########################################################################*/
funcs([args]) := block([progn:"<funcs>",debug, sortmode:true, str,strL,out],
debug : ifargd(),
if length(args) = 0 then go(block_main),
if length(args) > 0 and args[1]='help then go(block_help),
if length(args) > 0 and args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of funcs('help)--
機能: ユーザ定義の関数名,マクロ名のリストの文字列化とソート,検索,等の処理
文法: funcs({'help,'ex,'sort,'str},...)
例示: funcs() : functions, macros のソート済リストを返す
funcs('nosort) : functions, macros のリスト(未ソート)を返す
funcs('show) : functions, macros から文字列 show を含む要素を返す
funcs('help) : 本関数のヘルプを標示
funcs('ex) : 例を実行
--end of funcs('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of funcs('ex)--"),
/* funcs_ex(), */
block([str],
str : "funcs('show)",
c0show(ev(str)),
return('normal_return)
), /* end of block */
print("--end of funcs('ex)--"),
return("--end of funcs('ex)--"),
block_main, /* main ブロック ====================================*/
/* 注: functions, macros : Maxima 予約リスト */
/* 標準:ソート */
c1show(args),
if (length(args) = 0) or (args[1]='nosort) then (
if length(args)>0 and args[1] = 'nosort then sortmode : false,
for listname in ['functions, 'macros] do (
strL : ev(listname),
c1show(listname,strL),
if sortmode and length(strL) > 0 then
for i:1 thru length(strL) do strL[i] : string(strL[i]),
if sortmode then out : sort(strL) else out : strL,
print(" ==ユーザ定義の関数名,マクロ名一覧: ",listname,", sortmode=",sortmode,"=="),
print(out)
),
return("--end of funcs--")
),
if length(args) = 1 and args[1] # 'nosort then str : args[1],
/* 検索文字列を含む関数名,マクロ名の表示 */
str : args[1],
print(" ==文字列",str,"を含むユーザ定義の関数名,マクロ名の検索結果=="),
declare(str,noun), str : string(str),
print(progn,"search string =",str),
chk(a) := if ssearch(str, string(a)) > 0 then true, /* sublist の判定関数 */
for listname in ['functions, 'macros] do (
out : sublist(ev(listname), chk), /* 判定関数chk()がTRUEのサブリストを返す */
out : sort(out),
print(progn,listname,"-->",out)
),
return("--end of funcs--")
)$ /* end of funcs */
/*========== on3ライブラリの関数一覧 2009.03.20 (T.INOUE) ====================
on3help: on3ヘルプ関数
on3simp: (主に内部使用): on3(z,a,b,cc) 関数の積に関する簡約化
on3rngm: 2つの区間の共通区間を与える (簡約化2 で使用する)
on3: on3 関数の定義 (区間で異なる関数)
f2l_one: 式から得られる第１層のリスト表現を返す
f2l: 式から得られる完全リスト表現を返す --- f2l_ex
l2f_one: 完全リスト表現から式表現処理を1回だけ行う
l2f: 完全リスト表現から式表現処理を行った結果を返す --- l2f_ex
on3vars: 完全リストからon3関数変数を取り出す --- on3vars_ex
ex:[+,[*,f1,[on3,x,1,2,co]],[on3,y,3,4,co]], on3vars(ex) ---> [x,y]
ex:f1*on3(x,1,2,co)+on(y,3,4,co), on3vars(ex) ---> [x,y]
on3lrl: 完全リストからon3関数端点リストを取り出す --- on3lrl_ex
f0+f1*on3(x,1,2,co) ---> [[x],[[minf,1,2,inf]],[true]]
f0+f1*on3(x,1,2,co)*on3(y,3,4,co)
---> [[x,y],[[minf,1,2,inf],[minf,3,4,inf]],[true,true]]
on3typep: 式からon3式タイプを調べ結果を返す
on3std: 式からon3標準型(排他的分解の出来ない状況での可)表現を返す --- on3std_ex
on3std_sub: (内部使用) 標準化リスト表現を返す
on3ev: on3多項式の各項の関数部を{factor,expand,ratsimp}した表現を返す
on3termsep: 項 f*on3(x..)*on3(y,.) から on3(x,.) を分離した表現を返す
--- on3termsep_ex
on3decomp_reduce: (内部使用) : 同一関数部をもつ領域の簡素化(合併)
on3decomp_decomp: (内部使用) : on3多項式の排他分解処理
on3decomp_inv: (内部使用) : on3多項式の逆数の処理
on3decomp: on3一般式の排他的分解処理全般 --- on3decomp_ex
on3show_sub on3show内部使用副関数
on3show: on3関数式の表示 --- on3show_ex
on3diff : on3 関数の微分(多変数関数の1変数に関するp階偏微分) --- on3diff_ex
on3integ : on3 関数の積分(多変数関数の1重不定積分関数/定積分を返す)
--- on3integ_ex
on3solve: on3 関数方程式の求解 (多変数対応版)
on3chgvar2: on3関数式f(x,y)を変換(t=x+y,u=y)した関数g(t,u)を返す
on3dim2_uni2: 一様分布の和の分布
on3dim2_exp2: 指数分布の和の分布
cshow: チェック用表示関数
d1show: デバック用表示関数(debug >= 1 のときに表示する)
d2show: デバック用表示関数(debug >= 2 のときに表示する)
d3show: デバック用表示関数(debug >= 3 のときに表示する)
ifargd: 親関数引数にdebug1,debug2,debug3があれば debug:1,2,3 を返す --- debug_ex
on3pw: on3関数式のカプセル化
on3ftrue: 式にon3関数が含まれていればTRUEを返す --- on3frue_ex
lpup: リストの指定要素を取り出す --- lpup_ex
L:[+,[*,f1,[on3,x,3,4,co]],[on3,x,1,2,co]], lpup(L,[2,2]) ---> f1
loffuncs: 式に含まれる演算子(関数を含む)からなるリストを返す --- loffuncs_ex
=============================================================================*/
/*----------------------------------------------------------------------*/
load("eval_string")$ /*** on3lrj (lrリストの結合) で使用 for 5.11 ***/
load("stringproc")$ /*** on3help で使用 ***/
gradef(on3(x,a,b,rc),0,0,0,0)$
/* on3ftrue(funcs)
::= buildq([u:funcs], integerp(ssearch("on3",string(u))) )$ */
/*### --- fsplit: on3help.mx --- ########################################*/
/* <on3help> : ヘルプ */
/*######################################################################*/
on3help() := block([],
printf(true,"~%
=== on3lib.mx (定義域を伴った関数の数式操作) 一覧 ===~%
0. on3help() : on3関数の機能一覧 ~%
1. on3(z,z0,z1,arg) : on3関数(関数定義域)の定義[変数，下限，上限，開閉]~%
2. f2l(on3funcs) : on3関数式をon3リスト形式に変換する[多変数対応版]~%
3. l2f(on3list) : on3リスト形式をon3関数形式に変換する[多変数対応版]~%
4. on3simp(on3funcs) : on3関数式の積に関する簡約化(on3decompに組み込み) ~%
5. on3decomp(funcs,[args]) : [多変数対応版]
on3関数式の和(差)において素な区間(領域)への分解表現を与える~%
6. on3std(on3func) : on3一般式の標準化 ~%
7. on3ev(on3func,arg) : 関数部に{factor,ratsimp,expand}を作用する~%
8. on3solve(funcs,vars) : on3関数式の求解[多変数対応版]~%
9. on3diff(func,var,p) : on3関数式の微分[多変数対応版]~%
10. on3integ(func,var,[args]) : on3関数式の積分[多変数対応版]
on3integ(func,var) : 不定積分関数(分布関数に対応)
on3integ(func,var,x0,x1) : 定積分値 ~%
11. on3chgvar2(funcs) : on3関数式f(x,y)を変換(t=x+y,u=y)した関数g(t,u)を返す~%
12. on3show(funcs) : on3関数式の表示[多変数対応版] ~%
13. on3pw(funcs) : on3関数式のカプセル化 ~%
ex. on3_ex(), on3simp_ex(), on3std_ex(),
on3decomp_ex(), on3show_ex(), on3ev_ex(),
on3diff_ex(), on3integ_ex(), on3solve_ex(),
on3chgvar2_ex() on3pw_ex(),
ex. on3dim2_uni2() : 一様分布に従う独立確率変数の和の分布
on3dim2_exp2() : 指数分布に従う独立確率変数の和の分布
ex. on3test() : on3_ex, on3list_ex, on3simp_ex, on3decomp_ex の連続実行~%
---> 関数表示 dispfun(on3,on3simp,...) または grind(on3)
"),
return("--- end of on3help ---")
)$
/*#########################################################################*/
/*### on3rules : 規則 2020.05.21 ###*/
/*#########################################################################*/
on3rules([args]) ::= block([progn:"<on3rules>"],
clear_rules(),
/*** on3 ライブラリーの冒頭で定義し，常駐させれば機能する ***/
declare([oo,oc,co,cc],constant),
declare([plot,noplot,view,noview],constant),
declare([debug1,debug2,debug3],constant),
/*** 自動簡約化 (Maxima内部簡約化の前に評価される) ***/
matchdeclare([on3z,on3a,on3b,on3cc],true,on3k,integerp),
tellsimp((on3(on3z,on3a,on3b,on3cc))^on3k, on3(on3z,on3a,on3b,on3cc)),
/*** add 2019.04.13 ****/
tellsimp('diff(on3(on3z,on3a,on3b,on3cc),on3z), 0),
tellsimp('integrate(on3(on3z,on3a,on3b,on3cc),on3z),
on3(on3z,on3a,on3b,on3cc)),
/* memo 2020.07.18 ----------------------------------------------------
diff(on3(x,1,3,co),x) -> 0
diff(x^2*on3(x,1,3,co),x) -> 2*x*on3(x,1,3,co) ok
integrate(on3(x,1,3,co),x) -> on3(x,1,3,co)
integrate(2*x*on3(x,1,3,co),x)
-> 'integrate(2*x*on3(x,1,3,co),x) x
telsimp に *(積)は使えない
--------------------------------------------------------------------- */
/*** add end ***/
/*** 簡約化1：on3(z,minf,inf,oo) ---> 1 2021.02.14 ***/
matchdeclare(on3,true, on3z,atom),
let([on3(on3z,minf,inf,oo), 1], on3rule1),
/*** 簡約化2：on3(z,a,b,cc) * on3(z,c,d,cc) ---> on3(z,E,F,cc) ***/
matchdeclare(on3,true, on32z,true,
[on32a,on32b,on32lr1,on32c,on32d,on32lr2],true),
let([on3(on32z,on32a,on32b,on32lr1) * on3(on32z,on32c,on32d,on32lr2),
on3rngm([on3, on32z,on32a,on32b,on32lr1],
[on3, on32z,on32c,on32d,on32lr2])],on3rule2),
/** on3rngm(rng1,rng2) : 2つの区間の共通区間を与える(簡約化2で使用) **/
/*** 簡約化5：on3(z,a,b,cc) * on3(z,minf,inf,oo) ---> on3(z,a,b,cc) ***/
matchdeclare([on35a,on35b],true,[on35c,on35d],constantp,
on35z,true,on35lr1,true, on35lr2,true),
let([on3(on35z,on35a,on35b,on35lr1) * on3(on35z,on35c,on35d,on35lr2),
on3rngone([on35z,on35a,on35b,on35lr1],
[on35z,on35c,on35d,on35lr2])],on3rule5),
/* --- 参照 on3rngm(on3(x,a,b,co),on3(x,c,d,co)) --- */
/*** ev評価関数として組み込む ***/
declare(on3decomp,evfun),
declare(on3std,evfun)
)$ /* end of on3rules */
/*#########################################################################*/
/** on3rngone(rng1,rng2):on3(x,a,b,co)*on3(x,minf,inf,oo)の処理(簡約化5で使用) **/
/*#########################################################################*/
on3rngone(rng1,rng2) := block([out],
if rng1[2]=minf and rng1[3]=inf and rng1[1]=rng2[1]
then out:funmake(on3,rng2)
else if rng2[2]=minf and rng2[3]=inf and rng1[1]=rng2[1]
then out:funmake(on3,rng1)
else out:funmake(on3,rng1) * funmake(on3,rng2),
return(out)
)$
/*#########################################################################*/
/* on3rngm : 同一変数に関するon3()関数の積の簡約化を試み,簡約化ができない場合は無処理とする */
/*#########################################################################*/
/*** memo ************************************************************
[a] on3 関数の加(減)法演算のメモ
cases of f*on3(a,b) + g*on3(c,d) where (a < b, and c < d)
v1 : max(a,c), v2 : (b,d)
1: ---a-[f]-b--[0]--c-[g]-d--- : [0,0] v1=c & v2=b & v1 > v2
2: ---a-[f]-c-[f+g]-b-[g]-d--- : [c,b] v1=c & v2=b & v1 <= v2
3: ---a-[f]-c-[f+g]-d-[f]-b--- : [c,d] v1=c & v2=d
4: ---c-[g]-a-[f+g]-b-[g]-d--- : [a,b] v1=a & v2=b
5: ---c-[g]-a-[f+g]-d-[f]-b--- : [a,d] v1=a & v2=d & v1 <= v2
6: ---c-[g]-d--[0]--a-[f]-b--- : [0,0] v1=a & v2=d & v1 > v2
***************************************************************************/
/*### on3rngm ##########################################################*/
/* 同一変数に関するon3()関数の積の簡約化を試み,簡約化ができない場合は無処理とする
on3(x,a,b,lr1)*on3(x,c,d,lr2) (a<=b,c<=d) -> on3(x,vl,vr,vlr)
--a--c--b--d-- (a<=c, c<=b, b<=d)のとき on3(x,c,b,vlr), vlr=[lr2l,lr1r]
--a--c--d--b-- (a<=c, c<=d, d<b)のとき on3(x,c,d,vlr), vlr=[lr2l,lr2r]
--c--a--b--d-- (c<a, a<=b, b<=d)のとき on3(x,a,b,vlr), vlr=[lr1l,lr1r]
--c--a--d--b-- (c<a, a<=d, d<b)のとき on3(x,a,d,vlr), vlr=[lr1l,lr2r]
otherwise のときは無処理で on3(x,a,b,lr1)*on3(x,c,d,lr2) を返す
用途:
matchdeclare([on3v,on3a,on3b,on3lr1,on3c,on3d,on3lr2],true),
tellsimp(on3(on3v,on3a,on3b,on3lr1)*on3(on3v,on3c,on3d,on3lr2),
on3byon3(on3(on3v,on3a,on3b,on3lr1),on3(on3v,on3c,on3d,on3lr2)) )
-> tellsimp から letsimp に変更 on3on3 -> on3byon3
*/
on3rngm([args]) := block([progn:"<on3rngm>",debug,
on3L1,on3L2,v,lr, assw,
L1,L2,L12, v1,a,b,lr1, v2,c,d,lr2, l1,r1, l2,r2, chg, out0, out1, out],
/* 永久ループの問題<<注意>> : ------------------------------------------
on3rngm() はtellsimpの記述に基づいて呼び出される.
on3rngm 内に on3()*on3() と行った文があると,またtellsimpの対象として
on3rngmが呼び出され永久ループとなる.
tellsimp から letsimp に変更
--------------------------------------------------------------------- */
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3rngm('help)--
機能: 同一変数に関するon3()関数の積の簡約化を試み,
簡約化ができない場合は無処理とする
文法: on3rngm(on3L1,on3L2) or on3rngm(on3func1,on3func2)
例示: on3rngm([on3,x,a,a+2,cc],[on3,x,a+1,a+5,oc]) -> on3(x,a+1,a+2,oc)
--end of on3rngm('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3rngm('ex)--"),
on3rngm_ex1(),
on3rngm_ex2(),
print("--end of on3rngm('ex)--"),
return("--end of on3rngm('ex)--"),
block_main, /* main ブロック ====================================*/
if length(args) >= 2 then (
if listp(args[1]) then on3L1:copylist(args[1]) else on3L1:f2l(args[1]),
if listp(args[2]) then on3L2:copylist(args[2]) else on3L2:f2l(args[2])
) else return("引数の個数が2未満"),
c1show(on3L1,on3L2),
/* local(v1,a,b,lr1, v2,c,d,lr2, l1,r1,l2,r2,out), */
L1 : on3L1, v1:L1[2], a:L1[3], b:L1[4], lr1:L1[5],
L2 : on3L2, v2:L2[2], c:L2[3], d:L2[4], lr2:L2[5],
c1show(L1,L2),
c1show(v1,a,b,lr1,v2,c,d,lr2),
/* ベキ等性 */
if L1 = L2 then return(l2f(L1)),
/* on3(v,minf,inf,oo) がある場合 */
if a=minf and b=inf and lr1=oo then return(l2f(L2)),
if c=minf and d=inf and lr2=oo then return(l2f(L1)),
/* lr1 lr2 から端点a,b,c,dの開閉を取り出す */
l1:"o", r1:"o", l2:"o", r2:"o",
if lr1=cc or lr1=co then l1:"c", if lr1=oc or lr1=cc then r1:"c",
if lr2=cc or lr2=co then l2:"c", if lr2=oc or lr2=cc then r2:"c",
c2show(lr1,"->",l1,r1,lr2,"->",l2,r2),
/* 第1引数が区間端点に一致する場合 on3(a,a,b,c?)=1 else 0 */
chg:false,
if v1=a then (chg:true, if l1="c" then L1:1 else L1:0),
if v1=b then (chg:true, if r1="c" then L1:1 else L1:0),
if v2=c then (chg:true, if l2="c" then L2:1 else L2:0),
if v2=d then (chg:true, if r2="c" then L2:1 else L2:0),
if chg then return(l2f(L1)*l2f(L2)),
c1show(progn,"--enter---"),
out0 : l2f(L1)*l2f(L2), /* 以下の処理前のon3()*on3()の内容 */
c1show(out0),
L12 : ["*",1,L1,L2], /* 無処理のとき返す内容(on3の積にしないこと) */
out : l2f(ratsubst(ON3,on3,L12)), /* on3rule2 の永久ループ回避処理 */
c1show(L12,out),
/* v1=v2 の確認 */
if v1 # v2 then return(out0) else v:v1,
if is(a>b)=true then (
cshow(progn,"区間指定 a <= b の例外を検出した!"),
cshow(" -> ",a,b), return("Error")),
if is(c>d)=true then (
cshow(progn,"区間指定 c <= d の例外を検出した!"),
cshow(" -> ",c,d), return("Error")),
if is(a<=b) = unknown then (
assw : assume(a <= b), c1show(assw),
print(" ++ 仮定: assume : ",a," <= ",b, " を追加し,処理を続行する ++") ),
if is(c<=d) = unknown then (
assw : assume(c <= d), c1show(assw),
print(" ++ 仮定: assume : ",c, " <= ",d," を追加し,処理を続行する ++") ),
if a<=c and c<=b and b<=d then
( lr:eval_string(sconcat(l2,r1)), out : l2f([on3,v,c,b,lr]) )
else if a<=c and c<=d and d<b then
( lr:eval_string(sconcat(l2,r2)), out : l2f([on3,v,c,d,lr]) )
else if c<a and a<=b and b<=d then
( lr:eval_string(sconcat(l1,r1)), out : l2f([on3,v,a,b,lr]) )
else if c<a and a<=d and d<b then
( lr:eval_string(sconcat(l1,r2)), out : l2f([on3,v,a,d,lr]) ),
if b<c or d<a then out : 0,
c1show(out0), out1:l2f(out), c1show("-->",out1),
/* assume() で設定した仮定,変数の表示と解除 */
c1show("設定された仮定:",properties(a)),c1show(assw),
fact_forget([a,b,c,d]), /* 仮定,変数の解除 */
c1show("設定された仮定及び変数の削除(forget)確認: ", var_fact([a,b,c,d]) ),
return(out)
)$ /* end of on3rngm() */
/*## on3rngm_ex1 ####################################################*/
on3rngm_ex1([args]) := block([progn:"<on3rngm_ex1>",debug],
debug:ifargd(),
c0show(on3rngm([on3,x,a,a+2,cc],[on3,x,a+1,a+5,oc])),
c0show(on3rngm(on3(x,a,a+2,cc),on3(x,a+1,a+5,oc)))
)$ /* end of on3rngm_ex */
/*### on3rngm_ex2 #####################################################*/
on3rngm_ex2([args]) := block([progn:"<on3rngm_ex2>",debug,a,b,c,d],
debug:ifargd(),
/* local(a,b,c,d), */
cshow(progn,"--enter--"),
/* 永久ループの問題<<注意>> : ------------------------------------------
on3rngm() はtellsimpの記述に基づいて呼び出される.
on3rngm 内に on3()*on3() と行った文があると,またtellsimpの対象として
on3rngmが呼び出され永久ループとなる.
tellsimp から letsimp に変更
--------------------------------------------------------------------- */
c1show(values),
c0show("--- begin of ex1 ---"),
ex1 : "on3(x,a,a+2,cc)*on3(x,a+1,a+5,oc)",
ans1 : "on3(x,a+1,a+2,oc)",
out : eval_string(ex1),
out : letsimp(out,on3rule2), /* on3rule2 の適用*/
out : ON3on3(out), /* ratsubst(on3,ON3,out), */ /* on3rule2 の後始末*/
c0show(ex1,"-->",out, ans1),
c0show("--- begin of ex2 ---"),
ex2 : "on3(x,a,b,cc)*on3(x,a-1,b+1,cc)",
ans2 : "on3(x,a,b,cc)",
out : eval_string(ex2),
out : letsimp(out,on3rule2), /* on3rule2 の適用*/
out : ON3on3(out), /* on3rule2 の後始末*/
c0show(ex2,"-->",out, ans2),
c0show("--- begin of ex3 ---"),
ex3 : "on3(x,a,b,cc)*on3(x,b+1,d,cc)",
ans3 : "0",
out : eval_string(ex3),
out : letsimp(out,on3rule2), /* on3rule2 の適用*/
out : ON3on3(out), /* on3rule2 の後始末*/
c0show(ex3,"-->",out, ans3),
if true then (
c0show("--- begin of ex4 ---"),
ex4 : "on3(x,a,b,cc)*on3(x,a+3,a-2,cc)",
ans4 : "実行停止",
out : eval_string(ex4),
c0show(ex4,"-->",out, ans4)
)
)$ /* end of on3on3_ex2 */
/*### --- fsplit: on3simp.mx --- #######################################*/
/* <on3simp> : on3(z,a,b,cc) 関数の積に関する簡約化 */
/*######################################################################*/
on3simp([args]) := block([progn:"<on3simp>",debug,on3funcm,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
/* block_main */
block_main, /* main ブロック ========================================*/
on3funcm : ratexpand(args[1]),
out : ev(on3funcm),
d1show(out),
/*** 簡約化2：on3(z,a,b,cc) * on3(z,c,d,cc) ---> on3(z,E,F,cc) ***/
out : letsimp(out,on3rule2),
out : ON3on3(out), /* on3rule2 の後始末*/
d1show(out),
out : expand(out),
return(out),
block_help, /* help ブロック =======================================*/
printf(true,"
--begin of on3simp('help)--
機能: on3(z,zl,zr,lr) 関数の積に関する簡約化(簡約化規則 on3rule2 を使用する)
文法: on3simp(on3()の積)
例示: on3simp(x * on3(x,0,3,co) * on3(x,0,3,co)) -> x*on3(x,0,3,co)
on3simp(x* on3(x,minf,3,co) * x^2 * on3(x,2,4,co)) -> x^3*on3(x,2,3,co)
on3simp(x^3 * on3(x,0,3,co) / (x*on3(x,1,5,co))) -> x^2*on3(x,1,3,co)
on3simp(1/(f1*on3(x,1,5,co) + f2*on3(x,2,8,co)) * on3(x,3,10,co))
-> on3(x,3,10,co)/(f2*on3(x,2,8,co)+f1*on3(x,1,5,co))
--end of on3simp('help')--
"
),
return('normal_return),
block_ex, /* example ブロック =======================================*/
print("--begin of on3simp('ex)--"),
block([progn:"<on3simp('ex)>",debug,
x,ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8,ex0,ex0f,Lex,ex,out,a,out2],
debug:ifargd(),
ex1 : ["x * on3(x,0,3,co) * on3(x,0,3,co)", "x*on3(x,0,3,co)"],
ex2 : ["x^3 * on3(x,0,3,co) / (x * on3(x,0,3,co))", "x^2*on3(x,0,3,co)"],
ex3 : ["x* on3(x,minf,3,co) * x^2 * on3(x,2,4,co)", "x^3*on3(x,2,3,co)"],
ex4 : ["x^3 * on3(x,0,3,co) / (x*on3(x,1,5,co))", "x^2*on3(x,1,3,co)"],
ex5 : ["x* on3(x,1,3,co) * x^3 * on3(x,2,4,co) * x * on3(x,2,5,co)",
"x^5*on3(x,2,3,co)"],
ex6 : ["(f1*on3(x,1,5,co) + f2*on3(x,2,8,co)) * on3(x,3,10,co)",
"f1*on3(x,3,5,co) + f2*on3(x,3,8,co)"],
ex7 : ["1/(f1*on3(x,1,5,co) + f2*on3(x,2,8,co)) * on3(x,3,10,co)",
"on3(x,3,10,co)/(f2*on3(x,2,8,co)+f1*on3(x,1,5,co))", "on3show"],
/* f1*on3(x,1,5,co) + f2*on3(x,2,8,co)
= f1*on3(x,1,2,co) + (f1+f2)*on3(x,2,5,co) + f2*on3(x,5,8,co)
与式 = 1/(f1+f2)*on3(x,3,5,co) + 1/f2*on3(x,5,8,co)
参考: on3decomp(1/(f1*on3(x,1,5,co) + f2*on3(x,2,8,co)) * on3(x,3,10,co));
*/
ex8 : ["(f1*on3(x,1,5,co) + f2*on3(x,2,8,co))*on3(x,minf,inf,oo)",
"f1*on3(x,1,5,co) + f2*on3(x,2,8,co)"],
ex0 : ["x^3 * on3(x,0,3,co) / (x*on3(x,a,3,co))",
"x^2*on3(x,0,3,co)*on3(x,a,3,co)"],
Lex : [ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8],
print(" 例．on3関数の積/商の簡約化"),
for ex in Lex do (
exchk("on3simp",[ex])
),
print(" 例0．on3関数の積(評価不能の場合と置数後の評価)"),
ex0 : "x^3 * on3(x,0,3,co) / (x*on3(x,a,3,co))",
ex0f : sconcat("on3simp(",ex0,")"),
cshow(a, ex0, ex0f),
out : eval_string(ex0f),
ldisplay(out),
a : 2,
cshow(a),
out2 : eval_string(ex0f),
ldisplay(a,out2),
return("---end of block---")
), /* end of block */
/* on3simp_ex(), */
print("--end of on3simp('ex)--"),
return("--end of on3simp('ex)--")
)$ /* end of on3simp */
/*### --- fsplit: on3.mx --- #########################################*/
/* <on3> : on3 関数の定義 (区間で異なる関数) */
/*######################################################################*/
on3([args]) := block([progn:"<on3>",debug,z,zl,zr,lr, l, r, chkl,chkr,
as0, out, evalmode:false, listmode:false, debugmode:false, solvetype:solve,
L2, t,wt,atom,ans1,ans2,LV,v,now,vl,vmid,vr,wl,wmid,wr,chkcomplex,on3sum],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
if length(args) >= 4 then go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--on3('help)--
機能: 変数zが不等式 zl <= z < zr (lc=co) のとき1を返しそのたのとき0を返す
文法: on3(z,zl,zr,lr,...) lrは開(o)閉(c)を表す. 追加引数としてlist,evalが可能
例示:
on3(z,zl,zr,co); 変数zが不等式 zl <= z < zr のとき1を返しそのたのとき0を返す
on3(0,1,3,co); -> 0 on3(1,1,3co) -> 1 on3(3,1,3,co) -> 0
on3(2,1,3,co); -> 1
on3(x,1,3,co); -> on3(x,1,3,co) 判定不能の場合は定義式を返す
on3(a,a-1,a+3,co); -> 1
on3(x^2,1,4,co,list); -> [on3,x^2,1,4,co] (リスト形式に変換)
on3(log(x),1,2,cc,eval); -> on3(x,%e,%e^2,cc) (evalによる評価変換)
メモ: findstr('on3) -> on3 を含む関数名一覧を標示する
--end of on3('help)--
"
),
return("end of on3('help)"),
block_ex, /* example ブロック ===================================*/
block([progn:"<on3_ex>",debug,exansL],
exansL : [["基本動作"],
["on3(0,1,3,co)","0"],
["on3(1,1,3,co)","1"],
["on3(3,1,3,co)","0"],
["on3(x,1,3,co)","on3(x,1,3,co)"],
["on3(3,1,b,co)","on3(3,1,b,co)"],
["on3(x,minf,inf,oo)","on3(x,minf,inf,oo)",
" <- ( = 1 であるが,on3decomp()の仕様のため無処理とする)"],
["inf/minf の取扱"],
["on3(inf,1,inf,co)","1"],
["on3(inf+1,1,inf,co)","0"],
["変数式の取扱"],
["on3(a,a-1,a+3,co)","1"],
["on3(a+3,a-1,a+3,co)","0"],
["on3(t-u,t-u,(-u)+t+3,co)","1"],
["on3((-u)+t+3,t-u,(-u)+t+3,co)","0"],
["on3()関数のリスト変換,eval評価"],
["on3(x^2,1,4,co,list)","[on3,x^2,1,4,co]"],
["on3(x^2,1,4,co,eval)","on3(x,1,2,co)+on3(x,-2,-1,oc)"],
["on3(log(x),1,2,cc,eval)","on3(x,%e,%e^2,cc)"],
["on3(sin(x),1/2,1,cc,eval)","on3(x,%pi/6,%pi/2,cc)"],
["on3(sin(2*x+%pi/4),1/2,1,oo,eval)","on3(x,-%pi/24,%pi/8,oo)"]
],
print(" === on3('ex) : on3 関数の使用例 ==="),
exchk("",exansL),
return("---end of on3('ex) ---")
), /* end of block */
return('normal_end),
block_main, /* main ブロック ====================================*/
z : args[1], zl : args[2], zr : args[3], lr : args[4],
if (is(zl=minf) and is(zr=inf) and atom(z))=false then (
/* 暗黙仮定を考慮したon3()の評価 */
out : funmake(on3, [z,zl,zr,lr]),
if lr=cc then (
as0 : assume(zl<=zr), c1show(progn,"暗黙仮定:",as0,facts(zl)),
if is(z >= zl) and is(z <= zr) then out:1
else if is(z < zl) or is(z > zr) then out:0,
forget(as0)
),
if lr=co then (
as0 : assume(zl < zr), c1show(progn,"暗黙仮定:",as0,facts(zl)),
if is(z >= zl) and is(z < zr) then out:1
else if is(z < zl) or is(z >= zr) then out:0,
forget(as0)
),
if lr=oc then (
as0 : assume(zl < zr), c1show(progn,"暗黙仮定:",as0,facts(zl)),
if is(z > zl) and is(z <= zr) then out:1
else if is(z <= zl) or is(z > zr) then out:0,
forget(as0)
),
if lr=oo then (
as0 : assume(zl < zr), c1show(progn,"暗黙仮定:",as0,facts(zl)),
if is(z > zl) and is(z < zr) then out:1
else if is(z <= zl) or is(z >= zr) then out:0,
forget(as0)
),
c1show(progn,out),
if (out=0) or (out=1) then return(out)
), /* end of implicit asumption */
/*** モード検査 ***/
if member(list,args) then listmode:true,
if member(eval,args) then evalmode:true,
if member(realroots,args) then solvetype:realroots,
if member(debug,args) then debugmode:true ,
/* add beig 2019.05.24
on3(z,f1(z),f2(z),co) 等では f1(z) > f2(z) となる場合がある
*/
if true then ( /* zl>zr のとき zl < z < zr となる z は存在しないので 0 を返す */
if is(zl>zr)=true then return(0)
),
if false then (
if is(zl>zr)=true then
(icerror:icerror+1,
if icerror < 6 then (
print("◆◆ on3(z,zl,zr,lr):区間指定例外zl>zrを検出した. ◆◆"),
cshow(progn,z,zl,zr),
return(0))
)),
if zl=inf and zr=inf then return(0),
/*
if freeof(inf, zl)=false then return(0), /* 2020.05.28 add */
if (freeof(inf,z)=false) and (freeof(inf,zr)=false) then return(0),
if freeof(minf,zr)=false then return(0), /* 2020.05.28 add */
if (freeof(minf,z)=false) and (freeof(minf,zl)=false) then return(0),
*/
if zl=minf and zr=minf then return(0),
if zl=zr and member(lr,[co,oc,oo]) then return(0), /* 追加 2019.09.17 */
/* if realp(z) and zl=minf and zr=inf then return(1), 再考*/
/* if z=minf and zl=minf then return(1), */
/* if zl=zr and z=zl then (if lr=cc then return(1) else return(0)), */
c2show(progn,"point-1"),
/* lr から端点a,b,c,dの開閉を取り出す */
l:"o", r:"o",
if lr=cc or lr=co then l:"c", if lr=oc or lr=cc then r:"c",
c2show(lr,"->",l,r),
/* 第1引数が区間端点に一致する場合 on3(a,a,b,c?)=1 else 0 */
if z=zl then (if l="c" then return(1) else return(0)),
if z=zr then (if r="c" then return(1) else return(0)),
c2show(progn,"point-2"),
/* 非数値評価が可能な場合 on3(a, a-1, a+2, co)*/
if l="c" then chkl:is(zl<=z) else chkl:is(zl<z),
if r="c" then chkr:is(z<=zr) else chkr:is(z<zr),
if (zl # minf) and (zr # inf) then
if chkl=true and chkr=true then return(1), /* 再考 */
/* add beig 2019.04.29 */
c2show(progn,"point-3"),
/*** 基本処理 ***/
/* cc : close-close, co : close-open, oc : open-close, oo : open-open */
if constantp(z) and constantp(zl) and constantp(zr) then
( if lr = cc then out : charfun(zl <= z and z <= zr)
else if lr = co then out : charfun(zl <= z and z < zr)
else if lr = oc then out : charfun(zl < z and z <= zr)
else if lr = oo then out : charfun(zl < z and z < zr)
)
else out : funmake(on3, [z,zl,zr,lr]), /*定義式を返す*/
if evalmode=false and listmode=false then return(out), /* 基本戻り口 */
/*** 追加処理 1 : list ####################################***/
if constantp(out)=false and listmode=true and evalmode=false then
return([on3, z, zl, zr, lr]),
/*** 追加処理 2 : eval ####################################***/
if constantp(out)=false and evalmode=true then (
atom : listofvars(z)[1], define(t(atom), z),
if atom = z then return(out),
if solvetype=solve then
(solvetrigwarn:false,
ans1 : solve([z=zl],[atom]), ans2 : solve([z=zr],[atom]),
solvetrigwarn:true,
chkcomplex:false,
for i thru length(ans1) do
if featurep(rhs(ans1[i]),real)=false then chkcomplex:true,
for i thru length(ans2) do
if featurep(rhs(ans2[i]),real)=false then chkcomplex:true,
if chkcomplex then
(mshow(chkcomplex),
ans1 : realroots(z = zl), ans2 : realroots(z = zr))
)
else if solvetype=realroots then
(ans1 : realroots(z = zl), ans2 : realroots(z = zr)),
d1show(atom,ans1,ans2),
L2 : [z, zl, zr, lr],
LV : [],
for j thru length(ans1) do LV : endcons(rhs(ans1[j]),LV),
for j thru length(ans2) do LV : endcons(rhs(ans2[j]),LV),
LV : sort(LV,"<"),
d1show(LV),
/*** 同値リスト値を切り詰める ***/
LV : unique(LV),
if first(LV) # minf then LV : cons(minf,LV),
if last(LV) # inf then LV : endcons(inf,LV),
if freeof(log,z)=false then LV[1] : 0.1^10,
if freeof(sin,z)=false then (LV[1] : -%pi/2, LV[length(LV)]:%pi/2),
if freeof(cos,z)=false then (LV[1] : 0, LV[length(LV)]:%pi),
block([i], i : 0, loop, i : i+1,
if LV[i] = LV[i+1] then
(LV : delete(LV[i+1],LV,1), i : i-1,
d1show(LV,length(LV))),
if i < length(LV)-1 then go(loop)
),
d1show(LV),
on3sum :0,
wt(atom) := block([ans], if errcatch(t(atom), return) = []
then ans:0 else ans:t(atom), return(ans)),
for j:1 thru length(LV)-1 do (
vl : LV[j], vr : LV[j+1], vmid : (LV[j]+LV[j+1])/2,
d1show(wt(vl),wt(vmid),wt(vr)),
wl : on3(wt(vl),L2[2],L2[3],L2[4]),
wmid : on3(wt(vmid),L2[2],L2[3],L2[4]),
wr : on3(wt(vr),L2[2],L2[3],L2[4]),
d1show(vl,vmid,vr,wl,wmid,wr),
if wmid = 1 then
(if wl=0 and wr=0 then lr:oo
else if wl=0 and wr=1 then (if vr # inf then lr:oc else lr:oo)
else if wl=1 and wr=0 then (if vl # minf then lr:co else lr:oo)
else if wl=1 and wr=1 then
(if vl # minf and vr # inf then lr:cc
else if vl # minf then lr:co
else if vr # inf then lr:oc
else lr:oo),
on3sum : on3sum + funmake(on3,[atom,vl,vr,lr])
)
), /* loop-end j */
d1show(on3sum),
if listmode=true then return(f2l(on3sum)) else return(on3sum)
), kill(t,wt) /* 追加処理 2 : eval の終了***/
)$ /* end of on3() */
/* ### 2021.01.30 ####################################################### */
/* 未定定数 a, b をもつ 関数 on3(x,a,b,lr) における暗黙仮定
on3関数 : 定義不等式 : 暗黙仮定
on3(x,a,b,cc) : a <= x <= b : a <= b
on3(x,a,b,co) : a <= x < b : a < b
on3(x,a,b,oc) : a < x <= b : a < b
on3(x,a,b,oo) : a < x < b : a < b
*/
on3x([args]) := block([progn:"<on3x>",debug,z,zl,zr,lr, as0, out],
debug:ifargd(),
z : args[1], zl : args[2], zr : args[3], lr : args[4],
c1show(progn,z,zl,zr,lr),
/* 仮定を考慮したon3()の評価 */
out : funmake(on3, [z,zl,zr,lr]),
if lr=cc then (
as0 : assume(zl<=zr), cshow(progn,facts(zl)),
if is(z >= zl) and is(z <= zr) then out:1
else if is(z < zl) or is(z > zr) then out:0,
forget(as0)
),
if lr=co then (
as0 : assume(zl < zr), cshow(progn,facts(zl)),
if is(z >= zl) and is(z < zr) then out:1
else if is(z < zl) or is(z >= zr) then out:0,
forget(as0)
),
if lr=oc then (
as0 : assume(zl < zr), cshow(progn,facts(zl)),
if is(z > zl) and is(z <= zr) then out:1
else if is(z <= zl) or is(z > zr) then out:0,
forget(as0)
),
if lr=oo then (
as0 : assume(zl < zr), cshow(progn,facts(zl)),
if is(z > zl) and is(z < zr) then out:1
else if is(z <= zl) or is(z >= zr) then out:0,
forget(as0)
),
c1show(progn,out),
return(out)
)$
/* ##################################################################### */
/*### fsplit: on3ex.mx ##################################################*/
/*--- on3ex ----------------------------------------------------*/
/*#######################################################################*/
on3ex([args]) := block([progn:"<on3ex>",debug,
ex11,ex12,ex13,ex14,ex15,ex16,ex17,ex18,ex19,ex1a,ex1b,ex1c,ex1d,ex1e,ex1r1,ex1r2,
ex1f1,ex1f2,ex1d1,ex1d2,ex1m1,ex1m2,ex1m3,ex1m4,ex1m5,ex1m6,ex1m7,ex1m8,ex1m0,
ex21,ex22,ex23,ex24,ex25,ex26,ex27,ex28,ex29,ex2a,ex2b,ex2c,ex2d,ex2e,
ex31,ex32],
debug:ifargd(),
d2show("---1変数---"),
ex11 : f0,
ex12 : on3(x,1,2,co),
ex13 : -on3(x,1,2,co),
ex14 : f0+on3(x,1,2,co),
ex15 : f0-f1*on3(x,1,2,co),
ex16 : f0+f1*f2*on3(x,1,2,co),
ex17 : f0+f1*log(x)*on3(x,1,2,co),
ex18 : f1*on3(x,3,5,co) + f1*on3(x,5,7,co),
ex19 : f1*on3(x,1,3,co)+f2*on3(x,2,5,co)+f3*on3(x,0,inf,co),
ex1a : f0*on3(x,3,5,co) + 1/(f1*on3(x,1,5,co)+f2*on3(x,3,7,co)),
ex1b : f0 + 1/(f1*on3(x,1,5,co)
+ f2*on3(x,3,7,co)/(f21*on3(x,1,3,co)+f22*on3(x,3,5,co))
),
ex1c : x^2*on3(x,minf,0,oo)+(1-x^2)/2*on3(x,0,1,oo)+(1-x)*on3(x,1,inf,oo)+sin(x),
ex1d : x^2*on3(x,minf,0,oo)+(1-x^2)/2*on3(x,0,1,oo)+(1-x)*on3(x,1,inf,oo)+myfunc(x),
ex1e : x^2*on3(x,0,1,co) + %e^(1-x)*on3(x,1,inf,co),
ex1r1 : f1*on3(x,a,b,co),
ex1r2 : f1*on3(x,a,b,co) + f2*on3(x,c,d,co),
ex1f1 : f1(x)*on3(x,1,2,co),
ex1f2 : f1(x)*on3(x,1,3,co) + f2(x)*on3(x,2,4,co),
ex1d1 : f1(x)*on3(x,a,b,co),
ex1d2 : f1(x)*on3(x,a,b,co) + f2(x)*on3(x,c,d,co),
ex1m1 : x * on3(x,0,3,co) * on3(x,0,3,co),
ex1m2 : x^2 * on3(x,0,3,co) / (x * on3(x,0,3,co)),
ex1m3 : x* on3(x,minf,3,co) * x^2 * on3(x,2,4,co),
ex1m4 : x^2 * on3(x,0,3,co) / (x*on3(x,1,3,co)),
ex1m5 : x* on3(x,1,3,co) * x^2 * on3(x,2,4,co) * x * on3(x,2,3,co),
ex1m6 : (f1*on3(x,1,5,co) + f2*on3(x,2,8,co))*on3(x,3,10,co),
ex1m7 : 1/(f1*on3(x,1,5,co) + f2*on3(x,2,8,co))*on3(x,3,10,co),
ex1m8 : (f1*on3(x,1,5,co) + f2*on3(x,2,8,co))*on3(x,minf,inf,oo),
ex1m0 : x^2 * on3(x,0,3,co) / (x*on3(x,a,3,co)),
d2show("---2変数---"),
ex21 : on3(x,1,2,co)*on3(y,3,4,co),
ex21 : f0+on3(x,1,2,co)*on3(y,3,4,co),
ex22 : f0+f1*on3(x,1,2,co)*on3(y,3,4,co),
ex23 : f0+f1*f2*on3(x,1,2,co)*on3(y,3,4,co),
ex24 : f0+f1*log(x)*on3(x,1,2,co)*on3(y,3,4,co),
ex25 : f0+f1*on3(x,1,2,co)*on3(y,3,4,co)+f2,
ex26 : f1*on3(x,3,5,co)*on3(y,2,4,co) + f1*on3(x,5,7,co)*on3(y,2,4,co),
ex27 : f1*on3(x,1,2,co)*on3(y,3,4,co)+f0*on3(y,5,6,co),
ex28 : f1*on3(x,3,7,co)*on3(y,4,8,co)+f2*on3(x,1,5,co)*on3(y,2,6,co),
ex2a : (x+y+5)*(on3(x,2,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)
+ on3(x,-2,2,co)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc)
+ on3(x,-2,2,co)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc)
+ on3(x,-3,-2,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)),
ex2b : (r*cos(t)+r*sin(t)+5)*r*on3(r,2,3,cc)*on3(t,0,2*%pi,cc),
ex2c : f1*on3(x,1,2,co)*on3(y,3,4,co) + f2*on3(x,1,2,co)*on3(y,3,4,co),
ex2d : f1*on3(x,1,2,co)*on3(y,3,5,co) + f2*on3(x,1,2,co)*on3(y,4,6,co),
ex2e : 1/ex2d,
d2show("---3変数---"),
ex31 : on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co),
ex32 : f1*on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co) + f2*on3(y,3,4,co)*on3(z,5,6,co),
/* --- 以下は共通変数リスト --- */
Lex1 : [ex11,ex12,ex13,ex14,ex15,ex16,ex17,ex18,ex19,ex1a,ex1b,ex1c,ex1d,ex1e,
ex1r1,ex1r2,ex1f1,ex1f2,ex1d1,ex1d2],
Lex2 : [ex21,ex22,ex23,ex24,ex25,ex26,ex27,ex28,ex2a,ex2b,ex2c,ex2d,ex2e],
Lex3 : [ex31,ex32],
Lexm : [ex1m1,ex1m2,ex1m3,ex1m4,ex1m5,ex1m6,ex1m7,ex1m8],
Lex : flatten([Lex1,Lex2,Lex3]),
/*** 上記 ex?? は ??_ex() 内で on3ex(), を実行することで呼び出せる ***/
if length(args) > 0 and not member(args[1],[debug1,ddebug2,debug3])
then ldisplay(args[1]),
return("---on3ex: 例を設定した (Lex1,Lex2,Lex3,Lexm,Lex)---")
)$
/*--- fsplit: on3f2l.mx ------------------------------------------------*/
/*######################################################################*/
/* <f2l_one>: 式から得られる第１層のリスト表現を返す */
/*######################################################################*/
f2l_one([args]) := block([progn:"<f2l_one>",debug,expr,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of f2l_one('help)--
機能: 式から得られる第１層のリスト表現を返す
文法: f2l_one(expr,...)
例示: f2l_one(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",f1*on3(x,1,3,co),f0]
参照: f2l(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",[\"*\",f1*log(x),[on3,x,1,2,co]],f0]
--end of f2l_one('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of f2l_one('ex)--"),
block([progn:"<f2l_one_ex>", ex1, ex2, ex, L:[], out, chk],
print("---begin of f2l_one_ex---"),
on3ex(), /* call example */
L : copylist(Lex1),
/* start */
for ex in L do
( print("--例--"),
out:f2l_one(ex),
ldisplay(ex),
print(" out : f2l_one(ex) --->"),
ldisplay(out),
chk : if ex = l2f(out) then chk:true else chk:false,
if chk = false then print(" chk : l2f(out) is not equal to ex")
),
return("--- end of f2l_one_ex---")
), /* end of block */
print("--end of f2l_one('ex)--"),
return("--end of f2l_one('ex)--"),
block_main, /* main ブロック ====================================*/
if listp(args[1])=true then return(args[1]),
expr : args[1], out : expr,
if atom(expr) = false then out:cons(op(expr),args(expr)),
return(out)
)$ /* end of f2l_one() */
/*######################################################################*/
/* <f2l_full>: 式から得られる完全リスト表現を返す 2020.02.22 */
/*######################################################################*/
f2l_full([args]) := block([progn:"<f2l_full>",debug,expr,fp,on3p:[],out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of f2l_full('help)--
機能: 関数(式)表現を数学関数,on3(),ON3()を含めて完全にリスト表現に変換する
文法: f2l_full(expr,...)
例示: ex : f1*log(x)*ON3(x,1,2,co)+f0;
ratsubst(on3,ON3,ex);
-> f1*log(x)*ON3(x,1,2,co)+f0 変更できない
L : f2l_full(ex);
-> [\"+\",[\"*\",f1,[log,x],[ON3,x,1,2,co]],f0]
LW : ratsubst(on3,ON3,L);
-> [\"+\",[\"*\",f1,[log,x],[on3,x,1,2,co]],f0]
l2f(LW);
-> f1*log(x)*on3(x,1,2,co)+f0
メモ: f2l(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",[\"*\",f1*log(x),[on3,x,1,2,co]],f0]
f2l_one(expr) は式から第１層のリスト表現を返す
f2l_one(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",f1*log(x)*on3(x,1,2,co),f0]
--end of f2l_full('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of f2l_full('ex)--"),
block([progn:"<f2l_full_ex>", ex1, ex2, ex, L:[], out, chk],
print("---begin of f2l_full_ex---"),
on3ex(), /* call example */
L : copylist(Lex1),
/* start */
for ex in L do
( print("--例--"),
out:f2l_full(ex),
ldisplay(ex),
print(" out : f2l(ex) --->"),
ldisplay(out),
chk : if ex = l2f(out) then chk:true else chk:false,
if chk = false then print(" chk : l2f_full(out) is not equal to ex")
),
return("--- end of f2l_full_ex---")
), /* end of block */
print("--end of f2l_full('ex)--"),
return("--end of f2l_full('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
d1show("S0:入力関数:",expr),
/* 式表現から完全リストを作成する */
out: scanmap(lambda([u], if atom(u)=false
then u:cons(op(u),args(u)) else u), expr),
d1show("S1:完全リスト:",out),
return(out)
)$ /* end of f2l_full() */
/*############################################################################*/
/*### ON3on3 #########2020.02.20 ### ON3() -> on3() */
/*############################################################################*/
ON3on3([args]) := block([progn:"ON3on3>",debug,wL,out],
debug:ifargd(),
if listp(args[1]) then wL:args[1] else wL : f2l_full(args[1]),
c1show(progn,"pre-wl",wL),
wL : scanmap(lambda([u],
if listp(u) and u[1]=ON3 then (
u[1] : on3, u) else u), wL),
c1show(progn,"after-WL",wL),
out : l2f(wL),
c1show(progn,out),
return(out)
)$ /* end of ON3on3() */
/*######################################################################*/
/* <f2l>: 式から得られる完全リスト表現(on3,ON3関数は除く)を返す 2020.02.22 */
/*######################################################################*/
f2l([args]) := block([progn:"<f2l>",debug,expr,fp,on3p:[],out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of f2l('help)--
機能: 関数(式)表現をリスト表現に変換する
文法: f2l(expr,...)
例示: f2l(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",[\"*\",f1*log(x),[on3,x,1,2,co]],f0]
メモ: f2l_one(expr) は式から第１層のリスト表現を返す
f2l_one(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",f1*log(x)*on3(x,1,2,co),f0]
--end of f2l('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of f2l('ex)--"),
block([progn:"<f2l_ex>", ex1, ex2, ex, L:[], out, chk],
print("---begin of f2l_ex---"),
on3ex(), /* call example */
L : copylist(Lex1),
/* start */
for ex in L do
( print("--例--"),
out:f2l(ex),
ldisplay(ex),
print(" out : f2l(ex) --->"),
ldisplay(out),
chk : if ex = l2f(out) then chk:true else chk:false,
if chk = false then print(" chk : l2f(out) is not equal to ex")
),
return("--- end of f2l_ex---")
), /* end of block */
print("--end of f2l('ex)--"),
return("--end of f2l('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
d1show("S0:入力関数:",expr),
/* 式表現から完全リストを作成する */
out: scanmap(lambda([u], if atom(u)=false
then u:cons(op(u),args(u)) else u), expr),
d1show("S1:完全リスト:",out),
/* 完全リストからon3演算子を含まない項(部分リスト)を関数化する */
out : scanmap(lambda([u],if listp(u)
and not (member(on3,flatten(u)) or member(ON3,flatten(u)))
then apply(u[1], rest(u,1)) else u ),out,bottomup),
d1show("S2:非on3部分リストの関数化:",out),
/* 積分離 [*,f1,f2,on3,f3] ---> [*,f1*f2*f3,on3] */
out: scanmap(lambda([u],
if listp(u) and u[1]="*" and length(u)>2
and (member(on3,flatten(u)) or member(ON3,flatten(u)))
and not member("+",flatten(u))
and not member("-",flatten(u))
and not member("/",flatten(u)) then
(fp:1, on3p:[], d2show(u),
for i:2 thru length(u) do (
d2show("in * :",u,i,u[i],listp(u[i])),
if listp(u[i]) and member(u[i][1],[on3,ON3])
then (d2show(u[i],u[i][1]), on3p:endcons(u[i],on3p))
else fp:fp*u[i],
d2show(i,fp,on3p)
) /* end of for-i */ ,
/* u: ["*", fp,on3p], d2show(fp,on3p), u */
u:["*",fp], u:append(u,on3p), u
) /* end of then */
else u
),out),
d1show("S3:on3部を含む積の簡素化:",out),
/* 除法 [/, a, b] ---> [*, 1/b, a] */
out : scanmap(lambda([u],
if listp(u) and u[1]="/"
and (not listp(u[3]) or not member(on3,flatten(u[3])) )
then u : ["*",1/u[3], u[2]] else u
),out),
d1show("S4:除法の簡素化:",out),
/* 減法 [-,[*,f1,f2]] ---> [*,-f1,f2], [-,[on3,...]] ---> [*,-1,[on3,...]] */
out : scanmap(lambda([u], if listp(u) and u[1]="-" and listp(u[2])
then (if u[2][1]="*" then (u[2][2]:-1*u[2][2], u[2])
else if u[2][1]=on3 then u:["*",-1,u[2]] else u ) else u
),out),
d1show("S5:減法の簡素化:", out),
/* 複合 [*,f1,[*,f2,on3,...]] ---> [*,f1*f2,on3,...] */
out : scanmap(lambda([u],
if listp(u) and u[1]="*"
and listp(u[3]) and u[3][1]="*"
and (not listp(u[3][2]) or not member(on3,flatten(u[3][2])) )
then (u[3][2] : u[2]*u[3][2], u[3]) else u
),out),
/* 変更 ["+",["*",f,[on3,x,1,2,co]],[on3,x,3,4,co]]
-> ["+",["*",f,[on3,x,1,2,co]],["*",1,[on3,x,3,4,co]]] */
if listp(out) and out[1]="+" and length(out)>1 then
for i:2 thru length(out) do (
c1show("check;", i,out[i]),
if listp(out[i]) and out[i][1]='on3
then ( out[i]:["*",1,out[i]], d1show(i,out[i]) )
),
d1show("S6:複合簡素化:",out),
d1show("return f2l:",out),
return(out)
)$ /* end of f2l() */
/*######################################################################*/
/* <l2f_one>: 完全リスト表現から式表現処理を1回だけ行う */
/*######################################################################*/
l2f_one([args]) := block([progn:"<l2f_one>",debug,u,L],
debug:ifarg(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of l2f('help)--
機能: 完全リスト表現から式表現処理を1回だけ行う
文法: l2f_one(L,...)
例示: L : [\"+\",[\"*\",f1,[on3,x,3,4,co]],[on3,x,1,2,co]],
l2f(L) -> f1*on3(x,3,4,co)+on3(x,1,2,co)
メモ: l2f(L) は f2l(expr) の逆操作
--end of l2f('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of l2f_one('ex)--"),
block([progn:"<l2f_one_ex>",L0,L1,L2,L,f1,f2,x],
L0 : [on3,x,1,3,co],
L1 : ["+",["*",f1,[on3,x,3,4,co]],[on3,x,1,2,co]],
L2: ["+", ["*", f1, [on3, x, 3, 4, co]], [on3, x, 1, 2, co]],
for L in [L0] do ( c0show(L), c0show(l2f_one(L)) ),
return("--- end of l2f_one ---")
), /* end of block */
print("--end of l2f_one('ex)--"),
return("--end of l2f_one('ex)--"),
block_main, /* main ブロック ====================================*/
if listp(args[1]) then L:args[1] else return(args[1]),
u : L,
if listp(u) then apply(first(u),rest(u,1)) else u
)$ /* end of l2f_one() */
/*######################################################################*/
/* <l2f>: 完全リスト表現から式表現処理を行った結果を返す */
/*######################################################################*/
l2f([args]) := block([progn:"<l2f>",debug,Lw,out],
debug:ifarg(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of l2f('help)--
機能: リスト表現から関数(式)表現に変換する
文法: l2f(L,...)
例示: L : [\"+\",[\"*\",f1,[on3,x,3,4,co]],[on3,x,1,2,co]],
l2f(L) -> f1*on3(x,3,4,co)+on3(x,1,2,co)
メモ: l2f(L) は f2l(expr) の逆操作
--end of l2f('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of l2f('ex)--"),
block([progn:"<l2f_ex>",L1,L2,L,f1,f2,x],
L1 : ["+",["*",f1,[on3,x,3,4,co]],[on3,x,1,2,co]],
L2: ["+", ["*", f1, [on3, x, 3, 4, co]], [on3, x, 1, 2, co]],
for L in [L1,L2] do ( c0show(L), c0show(l2f(L)) ),
return("--- end of l2f ---")
), /* end of block */
print("--end of l2f('ex)--"),
return("--end of l2f('ex)--"),
block_main, /* main ブロック ====================================*/
if listp(args[1]) then Lw : args[1] else return(args[1]),
out:scanmap(lambda([u], if listp(u) then apply(first(u),rest(u,1)) else u),
Lw,bottomup),
return(out)
)$ /* end of l2f() */
/*--- fsplit: on3vars.mx -----------------------------------------------*/
/*######################################################################*/
/* <on3vars>: 完全リストからon3関数変数を取り出す
ex:[+,[*,f1,[on3,x,1,2,co]],[on3,y,3,4,co]], on3vars(ex) ---> [x,y]
ex:f1*on3(x,1,2,co)+on(y,3,4,co), on3vars(ex) ---> [x,y] */
/*######################################################################*/
on3vars([args]) := block([progn:"<on3vars>",debug,Lw:expr,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3vars('help)--
機能: 式expに含まれるon3(),またはそのリスト表現からon3関数変数を取り出す.
文法: on3vars(expr,...)
例示: ex:f1*on3(x,1,2,co)+on(y,3,4,co), on3vars(ex) ---> [x,y]
ex:[+,[*,f1,[on3,x,1,2,co]],[on3,y,3,4,co]], on3vars(ex) ---> [x,y]
--end of l2f('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3vars('ex)--"),
block([progn:"<on3vars_ex>",L1,L2,ex1,ex2,ex],
L1 : ["+",["*",f1,[on3,x,1,2,co]],[on3,x,3,4,co]],
L2 : ["+",["*",f1,[on3,x,1,2,co],[on3,y,3,4,co]],f0],
ex1 : f1*on3(x,1,2,co) + on3(x,3,4,co),
ex2 : f1*on3(x,1,2,co) + on3(y,3,4,co),
for ex in [L1,L2,ex1,ex2] do ( c0show(ex), c0show(on3vars(ex)) ),
return("--- end of on3var_ex ---")
), /* end of block */
print("--end of on3vars('ex)--"),
return("--end of on3vars('ex)--"),
block_main, /* main ブロック ====================================*/
expr:args[1],
out:[],
if listp(expr) then Lw:copylist(expr) else Lw:f2l(expr), /* call f2l */
scanmap(lambda([u],
if listp(u) and first(u)=on3
then (d2show(u), out:cons(u[2],out)) else u ), Lw),
out:unique(out),
return(out)
)$ /* end of on3vars() */
/*######################################################################*/
/* <on3lrl>: 完全リストからon3関数端点リストを取り出す
f0+f1*on3(x,1,2,co) ---> [[x],[[minf,1,2,inf]],[true]]
f0+f1*on3(x,1,2,co)*on3(y,3,4,co)
---> [[x,y],[[minf,1,2,inf],[minf,3,4,inf]],[true,true]] */
/*######################################################################*/
on3lrl([args]) := block([progn:"<on3lrl>",debug, L,
Lw,outvars,wlist,outi,outlist,outnum,number],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3lrl('help)--
機能: 式内のon3()から,またはその完全リストからon3関数端点リストを取り出す.
また,端点リストに非数値が含まれるときFALSEを含まれないときTRUEを返す.
文法: on3lrl(expr,...)
例示:
f0+f1*on3(x,1,2,co) ---> [[x],[[minf,1,2,inf]],[true]]
f0+f1*on3(x,1,2,co)*on3(y,3,4,co)
---> [[x,y],[[minf,1,2,inf],[minf,3,4,inf]],[true,true]]
--end of l2f('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3lrl('ex)--"),
block([progn:"<on3lrl_ex>",wex,Lex0,L],
on3ex(),
Lex0 : [ex1a,ex28],
L : copylist(Lex0),
/* start */
for wex in L do ( print("---<領域情報>---"),
ldisplay(wex),
c0show(on3lrl(wex)),
c0show(f2l(wex))
),
return("--- end of on3lrl_ex ---")
), /* end of block */
print("--end of on3lrl('ex)--"),
return("--end of on3lrl('ex)--"),
block_main, /* main ブロック ====================================*/
L : args[1],
outvars:[], wlist:[], outi:[], outlist:[],outnum:[],
if not listp(L) then Lw:f2l(L) else Lw:L, /* call f2l */
scanmap(lambda([u],
if listp(u) and first(u)=on3
then (d2show(u), outvars:cons(u[2],outvars),
wlist:cons([u[2],u[3],u[4]],wlist)) else u ), Lw),
outvars:unique(outvars),
c1show(wlist),
for i thru length(outvars) do (
outi : [],
for j thru length(wlist) do (
if wlist[j][1] = outvars[i]
then outi:cons([wlist[j][2],wlist[j][3]],outi)
), /* end of do-j */
outi : cons([minf,inf],outi),
c1show(outi),
if on3type='on3mono then assume(outi[2][1]<outi[2][2]),
if errcatch( outi : sort(unique(flatten(outi)),"<"), return) = []
then outi : sort(unique(flatten(outi))) else outi,
outlist : endcons(outi,outlist)
), /* end of do-i */
c1show(outlist),
/* 端点リストに非数値要素が含まれているかを検査する */
if length(outvars) > 0 then (
outnum : makelist(true,i,1,length(outvars)),
for i:1 thru length(outlist) do (
number:true,
for j:2 thru length(outlist[i])-1 do
/* if not numberp(outlist[i][j]) then number:false, */
if not constantp(outlist[i][j]) then number:false,
outnum[i] : number
) /* end of for-i */
),
return([outvars,outlist,outnum])
)$
/*--- fsplit: on3std.mx ------------------------------------------------*/
/*######################################################################*/
/* <on3typep>: 式からon3式タイプを調べ結果を返す */
/*######################################################################*/
on3typep([args]) := block([progn:"<on3typep>",debug,expr,L:[],out,
on3type,on3none,on3monoone,on3mono,on3inv,on3poly,on3polyinv,on3unknown],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3typep('help)--
機能: 式からon3式タイプを調べ結果を返す
on3noe(非on3式), on3monoone(on3単項式,関数部1), on3mono(on3単項式),
on3inv(on3分数式), on3poly(on3多項式), on3polyinv(on3有理式),
on3unknown(その他のon3式),
文法: on3typep(expr,...)
例示:
--end of on3typep('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3typep('ex)--"),
block([progn:"<on3typep_ex>",ex,Lex0,L],
on3ex(),
Lex0 : Lex1,
L : copylist(Lex0),
for ex in L do ( print("---<on3タイプ情報>---"),
c0show(ex),
c0show(out:on3typep(ex)),
c1show(f2l(ex))
),
return("--- end of on3typep_ex ---")
), /* end of block */
print("--end of on3typep('ex)--"),
return("--end of on3typep('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
if listp(expr) then L : copylist(expr)
else L : f2l(on3simp(ev(expr,expand,infeval))),
d1show(L),
if not listp(L) or not member(on3,flatten(L))
then ( on3type:on3none, d1show("---> 非on3式") )
else if listp(L) and L[1]=on3
then ( on3type:on3monoone, d1show("---> on3単項式 かつ 関数部 1 ") )
else if L[1]="*" and member(on3,flatten(L))
then ( on3type:on3mono, d1show("---> on3単項式") )
else if L[1]="/" and member(on3,flatten(L))
then ( on3type:on3inv, d1show("---> on3分数式") )
else if L[1]="+" and member(on3,flatten(L)) and not member("/",flatten(L))
then ( on3type:on3poly, d1show("---> on3多項式") )
else if L[1]="+" and member(on3,flatten(L)) and member("/",flatten(L))
then ( on3type:on3polyinv, d1show("---> on3有理式") )
else ( on3type:on3unknown, cshow("---> on3式分類不定") ),
d1show(on3type),
return(on3type)
)$ /* end of on3typep() */
/*--- on3std_ex -------------------------------------------- */
on3std_ex([args]) := block([progn:"<on3std_ex>",debug,
ex,ans,ic,exno,var,L,exansL,out],
debug:ifargd(),
on3ex(),
L : copylist(Lex),
exansL :
[["f0","f0"],
["on3(x,1,2,co)","on3(x,1,2,co)"],
["-on3(x,1,2,co)","-on3(x,1,2,co)"],
["on3(x,1,2,co)+f0","f0*on3(x,minf,inf,oo)+on3(x,1,2,co)"],
["f1*f2*on3(x,1,2,co)+f0","f0*on3(x,minf,inf,oo)+f1*f2*on3(x,1,2,co)"],
["f1*log(x)*on3(x,1,2,co)+f0","f0*on3(x,minf,inf,oo)+f1*log(x)*on3(x,1,2,co)"],
["f1*on3(x,5,7,co)+f1*on3(x,3,5,co)","f1*on3(x,5,7,co)+f1*on3(x,3,5,co)"],
["f2*on3(x,2,5,co)+f1*on3(x,1,3,co)+f3*on3(x,0,inf,co)",
"f2*on3(x,2,5,co)+f1*on3(x,1,3,co)+f3*on3(x,0,inf,co)"],
["1/(f2*on3(x,3,7,co)+f1*on3(x,1,5,co))+f0*on3(x,3,5,co)",
"on3(x,5,7,co)/f2+((f0*(f2+f1)+1)*on3(x,3,5,co))/(f2+f1)+on3(x,1,3,co)/f1"],
["1/((f2*on3(x,3,7,co))/(f22*on3(x,3,5,co)+f21*on3(x,1,3,co))+f1*on3(x,1,5,co))+f0",
sconcat("f0*on3(x,5,7,co)+(((f0*f1+1)*f22+f0*f2)*on3(x,3,5,co))/(f1*f22+f2)",
"+((f0*f1+1)*on3(x,1,3,co))/f1")],
["x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)+((1-x^2)*on3(x,0,1,oo))/2+sin(x)",
sconcat("sin(x)*on3(x,minf,inf,oo)+x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)",
"+(1/2-x^2/2)*on3(x,0,1,oo)")],
["x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)+((1-x^2)*on3(x,0,1,oo))/2+myfunc(x)",
sconcat("myfunc(x)*on3(x,minf,inf,oo)+x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)",
"+(1/2-x^2/2)*on3(x,0,1,oo)")],
["%e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co)",
"%e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co)"],
["f2*on3(x,c,d,co)+f1*on3(x,a,b,co)",
"f2*on3(x,c,d,co)+f1*on3(x,a,b,co)"],
["f2(x)*on3(x,2,4,co)+f1(x)*on3(x,1,3,co)",
"f2(x)*on3(x,2,4,co)+f1(x)*on3(x,1,3,co)"],
["f2(x)*on3(x,c,d,co)+f1(x)*on3(x,a,b,co)",
"f2(x)*on3(x,c,d,co)+f1(x)*on3(x,a,b,co)"],
["f1*log(x)*on3(x,1,2,co)*on3(y,3,4,co)+f0",
sconcat("f0*on3(x,minf,inf,oo)",
"+f1*log(x)*on3(x,1,2,co)*on3(y,3,4,co)")],
["f1*on3(x,1,2,co)*on3(y,3,4,co)+f2+f0",
"(f2+f0)*on3(x,minf,inf,oo)+f1*on3(x,1,2,co)*on3(y,3,4,co)"],
["f0*on3(y,5,6,co)+f1*on3(x,1,2,co)*on3(y,3,4,co)",
"f0*on3(x,minf,inf,oo)*on3(y,5,6,co)+f1*on3(x,1,2,co)*on3(y,3,4,co)"],
["f1*on3(x,3,7,co)*on3(y,4,8,co)+f2*on3(x,1,5,co)*on3(y,2,6,co)",
"f1*on3(x,3,7,co)*on3(y,4,8,co)+f2*on3(x,1,5,co)*on3(y,2,6,co)"],
[sconcat("(y+x+5)*(on3(x,2,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)",
"+on3(x,-3,-2,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)",
"+on3(x,-2,2,co)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc)",
"+on3(x,-2,2,co)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc))"),
sconcat("on3(x,2,3,co)*(y+x+5)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)",
"+on3(x,-3,-2,co)*(y+x+5)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)",
"+on3(x,-2,2,co)*(y+x+5)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc)",
"+on3(x,-2,2,co)*(y+x+5)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc)")],
["r*on3(r,2,3,cc)*(r*sin(t)+r*cos(t)+5)*on3(t,0,2*%pi,cc)",
"on3(r,2,3,cc)*(r^2*sin(t)+r^2*cos(t)+5*r)*on3(t,0,2*%pi,cc)"],
["f2*on3(x,1,2,co)*on3(y,3,4,co)+f1*on3(x,1,2,co)*on3(y,3,4,co)",
"(f2+f1)*on3(x,1,2,co)*on3(y,3,4,co)"],
["f2*on3(x,1,2,co)*on3(y,4,6,co)+f1*on3(x,1,2,co)*on3(y,3,5,co)",
"f2*on3(x,1,2,co)*on3(y,4,6,co)+f1*on3(x,1,2,co)*on3(y,3,5,co)"],
["1/(f2*on3(x,1,2,co)*on3(y,4,6,co)+f1*on3(x,1,2,co)*on3(y,3,5,co))",
"1/(f2*on3(x,1,2,co)*on3(y,4,6,co)+f1*on3(x,1,2,co)*on3(y,3,5,co))", "on3show"],
["on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co)",
"on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co)"],
["f1*on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co)+f2*on3(y,3,4,co)*on3(z,5,6,co)",
sconcat("f2*on3(x,minf,inf,oo)*on3(y,3,4,co)*on3(z,5,6,co)",
"+f1*on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co)")]
],
c1show(exansL),
print("== on3std_ex : 標準型(変数毎,on3有理式はon3decomp21()が必要) ==="),
c1show(L), ic : 0,
for ic:1 thru length(exansL) do (
ex : eval_string(exansL[ic][1]),
if length(on3vars(ex)) > 0 then var : listofvars(on3vars(ex))[1],
exno : sconcat("◆ 例",ic), print(exno), c0show(ex),
cashow(on3vars(ex),var,on3typep(ex)),
out : on3std(ex,ev(var)),
/* if on3typep(ex)='on3polyinv then out : on3info(ex,ev(var),'std), */
ans : eval_string(exansL[ic][2]),
chk1show(out,ans)
),
return("--- end of on3std_ex ---")
)$
/*######################################################################*/
/* <on3std>: 式から指定変数に関するon3標準型(微分･積分可能な多項式)表現を返す */
/*######################################################################*/
on3std([args]) := block([progn:"<on3std>",debug, expr,var, L:[],LR:[],
pnum:[],pdenom:[],out,
on3type,on3none,on3monoone,on3mono,on3inv,on3poly,on3polyinv,on3unknown],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3std('help)--
機能: 式から指定変数に関するon3標準型(微分･積分可能な多項式)表現を返す
R1: 非on3式(on3none) → 無処理
R2: on3単項式(on3monoone,on3mono) → 無処理
R3: on3多項式(on3poly) → 定数項 f0 があれば f0*on3(x,minf,inf,oo) とする
R4: on3有理式(on3inv,on3polyinv) → on3排他的区分分解形(on3多項式になる)を返す
文法: on3std(expr,var,...)
例示: on3std(expr) (1変数の場合) on3std(expr,var) (2変数以上の場合)
--end of on3std('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3std('ex)--"),
on3std_ex(),
print("--end of on3std('ex)--"),
return("--end of on3std('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
if length(on3vars(expr)) > 0 then var : listofvars(on3vars(expr))[1],
if length(args) > 1 and member(args[2], listofvars(on3vars(expr))) then var : args[2],
on3type : on3typep(expr),
if member(on3type,['on3none,'on3monoone,'on3mono])
then out : expr
else if member(on3type,['on3poly])
then out : on3info(expr,ev(var),'std)
else if member(on3type,['on3inv, 'on3polyinv])
then out : on3decomp21(expr,ev(var))
else out: 'unknown,
c1show(out),
return(out)
)$ /* end of on3std */
/*######################################################################*/
/* <on3termsep>: 項 f*on3(x..)*on3(y,.) から on3(x,.) を分離した表現を返す */
/*######################################################################*/
on3termsep([args]) := block([progn:"<on3termsep>",debug,term,var:none,out,
L:[],ton3],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3termsep('help)--
機能: 項 f*on3(x..)*on3(y,.) から on3(x,.) を分離した表現を返す(未完成!!)
文法: on3termsep(expr,...)
例示: ex : f1*on3(x,1,2,co)*on3(y,3,4,co)$
on3termsep(ex) = [f1,on3(x,1,2,co)*on3(y,3,4,co)]
on3termsep(ex,x) = [f1*on3(y,3,4,co),on3(x,1,2,co)]
on3termsep(ex,y) = [f1*on3(x,1,2,co),on3(y,3,4,co)]
--end of on3termsep('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3termsep('ex)--"),
block([progn:"<on3termsep('ex)>",debug,ex],
debug:ifargd(),
ex : f1*on3(x,1,2,co)*on3(y,3,4,co),
print("---ex---"),
ldisplay(ex),
c0show(on3termsep(ex)),
c0show(on3termsep(ex,x)),
c0show(on3termsep(ex,y)),
return("--- end of on3termsep('ex) ---")
), /* end of block */
print("--end of on3termsep('ex)--"),
return("--end of on3termsep'ex)--"),
block_main, /* main ブロック ====================================*/
term : args[1],
if length(args) > 1 and not member(args[2], [debug1,debug2,debug3])
then var:args[2], /* 変数の取得 */
if not listp(term) then L:f2l(term) else L:copylist(term),
if var=none then ( /* on3部全体を分離する */
ton3:1,
out : scanmap(lambda([u], if listp(u) and u[1]=on3 then
(ton3:ton3*l2f(u), u:1) else u ), L),
out:l2f(out) )
else ( /* 着目変数varを伴ったon3部のみを分離する */
ton3:1,
out : scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=var then
(ton3:ton3*l2f(u), u:1) else u ), L),
out:l2f(out) ),
d1show(term,ton3,out),
return([out,ton3])
)$
/*--- fsplit: on3ev.mx ------------------------------------------------*/
/*######################################################################*/
/* <on3ev>: on3poly の各関数部を{factor,expand,ratsimp}した表現を返す */
/*######################################################################*/
on3ev([args]) := block([progn:"<on3ev>",debug,expr,L:[],
sum,ton3,func,funcL:[],
on3type,on3none,on3monoone,on3mono,on3inv,on3poly,on3polyinv,on3unknown],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3ev('help)--
機能: on3poly の各関数部を{factor,expand,ratsimp}した表現を返す
文法: on3ev(expr,...)
例示: ex : x*on3(x,3,4,co)+(x^2-2*x+1)*on3(x,1,2,co)
on3ev(ex,factor) = x*on3(x,3,4,co)+(x-1)^2*on3(x,1,2,co)
ex1e : %e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co)
out : on3integ(ex1e,x)
= (%e^-x*(4*%e^x-3*%e)*on3(x,1,inf,co))/3+(x^3*on3(x,0,1,co))/3
on3ev(out,expand) = (4/3-%e^(1-x))*on3(x,1,inf,co)+(x^3*on3(x,0,1,co))/3
--end of on3ev('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3ev('ex)--"),
block([progn:"<on3ev('ex)>",debug, cmds,
ex1,ex2,ans1,ans2,out0,out],
debug:ifargd(),
print("--- on3ev_ex ---"),
cmds : sconcat("( ",
"/* 例1. on3 多項式の関数部の因数分解 */ @",
"ex1 : (x^2-2*x+1)*on3(x,1,2,co) + x*on3(x,3,4,co), @",
"out : on3ev(ex1,factor)",
" )"),
ans1 : x*on3(x,3,4,co)+(x-1)^2*on3(x,1,2,co),
chk1show(cmds,ans1),
cmds : sconcat("( ",
"/* 例2. on3 多項式の展開 */ @",
"ex2 : %e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co), @",
"out0 : on3integ(ex2,x), print(\" out0 = \",out0), @",
"out : on3ev(out0,expand) ",
" )"),
ans2 : (4/3-%e^(1-x))*on3(x,1,inf,co)+(x^3*on3(x,0,1,co))/3 ,
chk1show(cmds,ans2),
return("--- end of on3ev('ex) ---")
), /* end of block */
print("--end of on3ev('ex)--"),
return("--end of on3ev'ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
args[1] : 'del, args:delete('del,args),
c1show(progn,expr),
if member(debug1,args) then args:delete(debug1,args),
if member(debug2,args) then args:delete(debug2,args),
if member(debug3,args) then args:delete(debug3,args),
d1show(args),
expr : on3std(expr),
if listp(expr) then L : copylist(expr) else L : f2l(expr),
c1show(progn,L),
on3type:on3typep(L), /* call on3typep */
d1show(on3type),
/*** on3poly 出ない場合は無処理とする ***/
if on3type # on3poly then return(expr),
sum : 0,
for i:2 thru length(L) do ( /* 関数部とon3部を分離する */
ton3:1,
funcL : scanmap(lambda([u], if listp(u) and u[1]=on3 then
(ton3:ton3*l2f(u), u:1) else u ), L[i]),
func : l2f(funcL), /* 関数部の因数分解 */
for j:1 thru length(args) do func : ev(func,ev(args[j])), /* !!! */
d2show(func,ton3),
sum : sum + func*l2f(ton3)
), /* end of for-i */
d1show(sum),
return(sum)
)$
/*--- fsplit: on3decomp.mx ---------------------------------------------*/
/*######################################################################*/
/* <on3decomp_reduce>: (内部使用) : 同一関数部をもつ領域の簡素化(合併) */
/*######################################################################*/
on3decomp_reduce(LWT0,[args]) := block([progn:"<on3decomp_reduce>",debug,
LWT:LWT0,out,
ton3j:[],ton3k:[],gtj,gtk,wgtj,gtl,gtr,wgtk,wgtm,wtl:[],tl,tr,tlr],
debug:ifargd(),
d2show("on3decomp_reduce start",LWT),
if not LWT[1] = "+" then
(c1show("not on3decomp_reduced",LWT), return([LWT,false])),
for j:2 thru length(LWT)-1 do (
gtj:l2f(LWT[j]),
d2show(gtj),
scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then ton3j:u else u), LWT[j]),
wgtj:ev(gtj,tvar=(ton3j[3]+ton3j[4])/2),
d2show(ton3j,wgtj),
for k:j+1 thru length(LWT) do (
gtk:l2f(LWT[k]),
scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then ton3k:u else u),LWT[k]),
wgtk:ev(gtk,tvar=(ton3k[3]+ton3k[4])/2),
d3show(ton3k,wgtk),
wtl:sort(unique([ton3j[3],ton3j[4],ton3k[3],ton3k[4]])),
d3show(gtj,gtk,wtl,wgtj,wgtk),
if length(wtl)=3 and wgtj=wgtk
and (ev(gtj,tvar=wtl[2])=wgtj or ev(gtk,tvar=wtl[2])=wgtk)
then (
tl:wtl[1], tr:wtl[3], tm:wtl[2], wgtm:wgtj,
if ton3j[3]=tl then (gtl:gtj, gtr:gtk) else (gtl:gtk, gtr:gtj),
if ev(gtl,tvar=tl) = wgtm and ev(gtr,tvar=tr) = wgtm then tlr:cc
else if ev(gtl,tvar=tl) = wgtm and ev(gtr,tvar=tr) # wgtm then tlr:co
else if ev(gtl,tvar=tl) # wgtm and ev(gtr,tvar=tr) = wgtm then tlr:oc
else tlr:oo,
out:wgtm*on3(tvar,tl,tr,tlr),
d3show("reduced:",gtj,"+",gtk,"->",out),
LWT[j]:f2l(out),
LWT:delete(LWT[k],LWT,1),
d3show(LWT),
return([LWT,true])
) /* end of then */
) /* end of for-k */
), /* end of for-j */
return([LWT,false])
)$
/*######################################################################*/
/* <on3decomp_decomp>: (内部使用) : on3多項式の排他分解処理 */
/*######################################################################*/
on3decomp_decomp(expr,[args]) := block([progn:"<on3decomp_decomp>",debug,
lpo,uj,ujwon3,
out,fone,won3:[],ww,rout:[],won3i,sum,
L0:[],LR:[],LW:[],i,j,von3,T:[],TC:[],lcont,rcont,new,fj,
LWT:[],outi,fw,gt,tvar,fsum,
tl,tr,tm,tlr,gtl,gtr,gtm,wgtl,wgtr,wgtm,ton3:[]],
debug:ifargd(),
if listp(expr) then L0:copylist(expr) else L0 : f2l(expr),
d1show(expr,L0),
if member('on3decomp_inv,flatten(L0)) then return(L0),
d1show(L0),
LR : on3lrl(expr), /* call on3lrl : 端点リストの取得 */
LW : copylist(L0),
d1show("on3decomp_decomp start:",LW),
d1show("<0>on3変数と端点リストの取得",LR),
/*** <Part 1 begin ******************************************/
for i:length(LR[1]) step -1 thru 1 do ( /* on3変数毎の処理 */
von3 : LR[1][i],
T : copylist(LR[2][i]), TC:[],
d2show("---",i,von3), d2show(T), d2show(LW),
LWT:[],
LWT:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=von3 then
(d2show(u), ev(u, u[2]=tvar)) else u ), LW),
gt : l2f(LWT),
d2show(LWT), d2show(gt),
fsum : 0,
for j:1 thru length(T)-1 do ( /* 排他的区間処理 */
tl:T[j], tr:T[j+1], tm : (tl+tr)/2,
d2show(tl,tr,tm),
gtl : ev(gt,tvar=tl), gtr : ev(gt,tvar=tr), gtm : ev(gt,tvar=tm),
d2show(gtl,gtr,gtm),
if gtl = gtm and gtr = gtm then tlr:cc
else if gtl = gtm and gtr # gtm then tlr:co
else if gtl # gtm and gtr = gtm then tlr:oc
else tlr:oo,
/* minf と inf の処理 */
if tl=minf then (if tlr=cc then tlr:oc else if tlr=co then tlr:oo),
if tr=inf then (if tlr=cc then tlr:co else if tlr=oc then tlr:oo),
fsum : fsum + gtm*on3(von3,tl,tr,tlr),
d2show(i,fsum)
), /* end of for-j */
/*** 孤立点の検査:関数比較に基づく(関数値比較は避ける) ***/
TC:makelist("none",i,1,length(T)),
if length(T) > 2 then (
for j:2 thru length(T)-1 do ( /* 孤立点の検査 */
tl : (T[j-1]+T[j])/2, tm : T[j], tr : (T[j]+T[j+1])/2,
gtl : ev(gt,tvar=tl), gtr : ev(gt,tvar=tr), gtm : ev(gt,tvar=tm),
if gtm # 0 and gtl # gtm and gtr # gtm then (
fsum : fsum + gtm*on3(von3,tm,tm,cc),
/* 関数値比較 */
if errcatch(wgtl:ev(gtl,ev(von3)=tm),
wgtr:ev(gtr,ev(von3)=tm),
wgtm:ev(gtm,ev(von3)=tm),
return) = [] then (TC[j]:none)
else (d2show(tm,wgtl,wgtm,wgtr),
if wgtr=wgtm then TC[j]:lcont /* 優先合併 */
else if wgtl=wgtm then TC[j]:rcont else TC[j]:new)
) /* end of then */
)),
LW : f2l(ev(fsum,expand,infeval)), d2show("i-end",i,LW),
/* singular point */
if member(lcont,TC) or member(rcont,TC) or member(new,TC) then (
d2show("孤立点再検査と合併",TC),
fsum : 0, ton3:[],
for j:2 thru length(LW) do (
d2show(LW[j]),
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=von3
then (ton3:u, d2show(ton3), u) else u ), LW[j]),
fj : scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=von3
then (u:1, u) else u ), LW[j]),
fj : l2f(fj),
d2show(ton3,fj),
for k:2 thru length(T)-1 do (
d2show(k,T[k],TC[k]),
if ton3[3] = T[k] and TC[k] = lcont then (
if ton3[5]=oc then ton3[5]:cc else if ton3[5]=oo then ton3[5]:co ),
if ton3[4] = T[k] and TC[k] = rcont then (
if ton3[5]=co then ton3[5]:cc else if ton3[5]=oo then ton3[5]:oc ),
if ton3[3] = T[k] and ton3[4] = T[k] and TC[k] # new then fj:0
), /* end of for-k */
d2show("after ton3",ton3,fj),
fsum : fsum + fj * funmake(on3,delete(on3,ton3))
), /* end of for-j */
LW : f2l(fsum)
), /* end of member then */
d2show("孤立点再検査と合併処理後",LW)
), /* end of for-i */
d1show("<1> 排他的領域上の関数表現",l2f(LW)),
/***<Part 2 begin 同一領域上の関数をまとめる>******************************/
/*** 排他処理済みon3多項式の関数部の整理した結果を返す <多変数に対応>
f1*on3(x,1,2,co)+f2*on3(x,3,4,co)+f3*on3(x,1,2,co)
---> (f1+f3)*on3(x,1,2,co) + f2*on3(x,3,4,co) ***/
d1show("S2:同一領域上の関数の合併開始",LW),
/*** 多項式部に現れるon3部を(関数形式で)取り出す ***/
won3:[],
scanmap(lambda([u],
if listp(u) and u[1]="*" and not member("/",flatten(u)) and member(on3,flatten(u))
then (d2show("won3",u,l2f(u)),
lpo:partition(fone*l2f(u),on3),
d2show(lpo),
won3:cons(lpo[2], won3) ) else u /* on3部を関数として取り出す*/
),LW,bottomup), /* end of scanmap */
won3:unique(won3),
won3:ev(won3,fone=1,infeval),
d1show("S2-1:on3(領域)部の検出結果",won3,length(won3)),
/*** 同一のon3部をもつ関数を合併する ***/
LW:scanmap(lambda([u],
if listp(u) and u[1]="+" and not member("/",flatten(u))
and member(on3,flatten(u)) then (
d1show(u), out:0,
for i thru length(won3) do (
sum : 0, won3i:won3[i],
for j:2 thru length(u) do (
uj:l2f(u[j]), ujwon3:partition(fone*uj,on3)[2],
if ujwon3=won3i then sum:sum+partition(fone*uj,on3)[1],
d2show("<2-2",won3i) ), /* end of for-j */
d1show(won3i,sum),
out : out+sum*won3i,
d1show(i,out)
), /* end of for-i */
u : f2l(out) ) /* end of then */ else u ), LW), /* end of scanmap */
LW : ev(LW,fone=1,infeval),
d1show("S2-2: 同一領域上の関数の合併結果",out),
/***<Part 3 bigen> 同一関数部をもつ領域の簡素化 *******************/
/*** f1*on3(x,1,3,co)+f1*on3(x,3,5,co) -> f1*on3(x,1,5,co)
f1*on3(x,1,3,cC)+f1*on3(x,3,5,co) -> f1*on3(x,1,5,co)
f1*on3(x,1,3,co)*on3(y,2,4,co)+f1*on3(x,3,5,co)*on3(y,2,4,co)
-> f1:on3(x,1,5,co)*on3(y,2,4,co)
****/
L0 : f2l(out), d2show("<3>",L0),
LR : on3lrl(out), /* call on3lrl : 端点リストの取得 */
LW : copylist(L0),
d2show("<3a>on3変数と端点リストの取得",LR),
for i:length(LR[1]) step -1 thru 1 do ( /* on3変数毎の処理 */
von3 : LR[1][i],
LWT:[],
LWT:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=von3 then
(d2show(u), ev(u, u[2]=tvar)) else u ), LW),
d2show(LWT), d2show(l2f(LWT)),
/*** loop for on3decomp_reduce ***/
rout:[],
loop, rout:on3decomp_reduce(LWT),
if rout[2]=true then (LWT:rout[1], go(loop)) else LWT:rout[1],
d2show(LWT),
LW:[],
LW:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=tvar then
(d2show(u), ev(u, u[2]=von3)) else u ), LWT),
d2show(l2f(LW))
), /* end of for-i */
out : l2f(LW),
d1show("<3> 同一関数部をもつ領域の簡素化",out),
return(out)
)$
/*######################################################################*/
/* <on3decomp_inv>: （内部使用) : on3多項式の逆数の処理 */
/*######################################################################*/
on3decomp_inv(u,[args]) := block([progn:"<on3decomp_inv>",debug,uw:u,w:[],fone],
debug:ifargd(),
if not listp(u) then uw:f2l(u),
if member('on3decomp_decomp,flatten(uw)) then return(uw),
d2show("before on3decomp_inv:",uw),
for i:2 thru length(uw) do (
w : partition(fone*l2f(uw[i]), on3),
w : ev(w,fone=1),
uw[i] : ["*", ratsimp(1/w[1]), f2l(w[2])]
), /* end of do */
d2show(uw),
/* uw : ev(uw), */
d2show("after on3decomp_inv:",uw),
d1show("--->",l2f(uw)),
return(l2f(uw))
)$
/*############################################################################*/
/*### chk2show : 入力履歴と結果の検証 #########################################*/
/*############################################################################*/
chk2show([args]) := block([progn:"<chk2show>",debug,cmds,ans, hlp,hlpL,
cmdsansL,cmdsL,out,outL, chk,chkm],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
block([cmds,Fans],
printf(true,"
--begin of chk2show('help)--
機能: 入力履歴と結果の検証
文法: chk2show(cmds,ans,...), chk2show([[cmds1,ans1]])
chk2show([[cmds1,ans1],[cmds2.ans2],...])
例示:
cmds : sconcat(\"(\",
\"/* chk2showの使用例 */ @\",
\"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @\",
\"F : on3integ19(f,x), \",
\"F : on3decomp(F) \",
\")\"
),
Fans : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)
+2*f1*on3(x,3,4,co)+f1*(x-1)*on3(x,1,3,co),
chk2show(cmds,Fans),
--end of chk1show('help')--
"
)),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of chk2show('ex)--"),
block([progn:"<chk2show_ex>",debug,cmds1,Fans1,cmds2,Fans2,outL],
cmds1 : sconcat("(",
"/* chk2showの使用例1 */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @",
"F : on3integ19(f,x), ",
"F : on3decomp(F) ",
")"),
Fans1 : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)+2*f1*on3(x,3,4,co)
+f1*(x-1)*on3(x,1,3,co),
cmds2 : sconcat("(",
"/* chk2showの使用例2 */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,2,6,co), /* fの定義 */ @",
"F : on3integ19(f,x), ",
"F : on3decomp(F) ",
")"),
Fans2 : 2*(2*f2+f1)*on3(x,6,inf,co)+(f2*x-2*f2+2*f1)*on3(x,3,6,co)
+(f2*x+f1*x-2*f2-f1)*on3(x,2,3,co)+f1*(x-1)*on3(x,1,2,co),
chk2show(cmds1,Fans1),
c0show("===2例の場合===="),
outL : chk2show([[cmds1,Fans1],[cmds2,Fans2]]),
cshow(outL),
for i:1 thru length(outL) do (
display2d:true, on3show(outL[i]), display2d:false
),
return("--end of chk2show_ex--")
),
print("--end of chk2show('ex)--"),
return("--end of chk2show('ex)--"),
block_main, /* main ブロック ====================================*/
/* cmdsansL : [[cmds1,ans1],[cmds2,ans2],...] */
if listp(args[1])=false then cmdsansL:[[args[1],args[2]]]
else if listp(args[1][1])=false then cmdsansL:[args[1]]
else cmdsansL:args[1],
c1show(progn,cmdsansL), outL : [],
for k:1 thru length(cmdsansL) do (
cmds : cmdsansL[k][1], ans : cmdsansL[k][2],
cmdsL : split(cmds,"@"),
cmds : sremove("@",cmds),
for i thru length(cmdsL) do
if i=1 then print("★ ",cmdsL[1]) else print(" ",cmdsL[i]),
out : eval_string(cmds), /* 入力履歴(文字列)の一括評価 */
if ans="" then return("no check of ans"),
if listp(out) and is(equal(out,ans)) then (chk:true, chkm:"◎ ")
else (chk:false, chkm:"❌ ", chkerrsum : chkerrsum + 1),
if listp(out)=false then (
if numberp(out) and abs(out-ans) < 1.0E-8
then (chk:true, chkm:"◎ ")
else if is(equal(expand(out),expand(ans))) then (chk:true, chkm:"◎ ")
else (chk:false, chkm:"❌ ", chkerrsum : chkerrsum + 1)
),
if slength(sconcat(out)) < 500
then print(chkm,"out =",out)
else print(chkm,"reveal(out,6) =", reveal(out,6)),
if chk=false then print(" <- ans =",ans),
outL : endcons(out, outL)
), /* end of for-k */
return(outL)
)$ /* end of chk2show */
/*#########################################################################*/
/** on3_same_var():同一変数varに関するon3()関数の積の項の検査 2020.07.18 **/
/*#########################################################################*/
on3_same_var([args]) := block([progn:"<on3_same_var>",debug,var,wL,Lon3,ic,icmax],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3_same_var('help)--
機能: 同一変数varに関するon3()関数の積の項が存在する(返り値2以上)か否(2未満)かを検査する
文法: on3_same_var(on3func,var) or on3r(on3funcL,var)
例示: on3_same_var(on3(x,1,3,co)*on3(x,a,b,co),x) -> 2
--end of on3_same_var('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3_same_var('ex)--"),
block([ex,ex1,ex2,ex3],
ex1 : on3(x,1,3,co)+on3(x,2,5,co)*on3(x,4,6,co),
ex2 : on3(x,1,3,co)+on3(x,2,5,co)*on3(x,a,b,co),
ex3 : on3(x,1,3,co)+on3(x,2,5,co),
for ex in [ex1,ex2,ex3] do (
c0show("例 ",ex),
on3_same_var(ex,x,'debug1)
)
),
print("--end of on3_same_var('ex)--"),
return("--end of on3_same_var('ex)--"),
block_main, /* main ブロック ====================================*/
c2show(args[1]),
if listp(args[1]) then wL:args[1] else wL:f2l(args[1]),
c1show(progn,wL),
var : args[2],
/* 同一変数のon3関数の積 on3(x,..)*on3(x,..)の個数を調べる */
ic:0, icmax:0, Lon3:[],
wL:scanmap(lambda([u],
if listp(u) and u[1] = "*" then (
ic:0, Lon3 : [],
u:scanmap(lambda([v],
if listp(v) and v[1]=on3 and freeof(ev(var),v[2]) = false
then (ic:ic+1,c2show("** find ",ic,v),
Lon3 : append(Lon3,[v]),
v:sconcat("<<here-",ic,">>"),v)
else v),u), /* end of u-scanmap */
icmax : max(icmax,ic),
if ic > 1 then (
c1show(Lon3),
c1show(on3rngm(Lon3[1],Lon3[2]))
),
u
) else u), wL), /* end of wL-scanmap */
c1show(wL),
if icmax < 2 then (
c1show(icmax," <- 2未満より続行可能")
),
if icmax > 1 then (
c1show("ERROR: 同一変数varのon3関数の積 on3(var,..)*on3(var,..)を検出した -> 実行停止")
),
return(icmax)
)$ /* end of on3_same_var() */
/*#########################################################################*/
/** on3byon3():同一変数varに関するon3()関数の積の評価 2020.08.05 2021.04.08 **/
/*#########################################################################*/
on3byon3([args]) := block([progn:"<on3byon3>",debug,
func, x,xw, wL, assw, xli,xri,lri, xlj,xrj,lrj, il,ir,jl,jr, wl,wr,wlr,wout],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3byon3('help)--
機能: 同一変数varに関するon3()関数の積を評価する
文法: on3byon3(on3func) or on3r(on3funcL)
例示: on3byon3(on3(x,1,3,co)*on3(x,2,4,co)) -> on3(x,2,3,co)
on3byon3([[on3,x,1,3,co],[on3,x,2,4,co]],debug1) -> on3(x,2,3,co)
ass_set([a<c,c<b,b<d]),
on3byon3(on3(x,a,b,co)*on3(x,c,d,co)) -> on3(x,c,b,co)
fact_forget([a,b,c,d])
--end of on3byon3('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3byon3('ex)--"),
block([exL,ansL,sc,sansL,x,ex,ans,exundef,a,b,c,d,title,cmds,out,
cond,c1,c2,c3,c4,c5,c6],
exL : makelist(null,3), ansL : makelist(null,3),
exL[1] : on3(x,2,5,co)*on3(x,4,6,co), ansL[1]: on3(x,4,5,co),
exL[2] : on3(x,2,5,co)*on3(x,a,b,co), ansL[2]: unknown,
exL[3] : on3(x,minf,inf,oo)*on3(x,a,b,co), ansL[3]: on3(x,a,b,co),
exundef : on3(x,a,b,co)*on3(x,c,d,co),
/* 注意: "c1: assume(a<=b,b<=c,c<=d)" とするとエラーとなる */
sc[1] : "c1: assume(a<=b,b<c,c<=d)", sansL[1]: 0,
sc[2] : "c2: assume(a<c,c<b,b<d)", sansL[2]: on3(x,c,b,co),
sc[3] : "c3: assume(a<c,c<d,d<b)", sansL[3]: on3(x,c,d,co),
sc[4] : "c4: assume(c<a,a<=b,b<d)", sansL[4]: on3(x,a,b,co),
sc[5] : "c5: assume(c<a,a<d,d<b)", sansL[5]: on3(x,a,d,co),
sc[6] : "c6: assume(c<=d,d<a,a<=b)", sansL[6]: 0,
if true then (
fact_forget([a,b,c,d]),
chk1show("/* 例1 */ on3byon3(on3(x,2,5,co)*on3(x,4,6,co))", on3(x,4,5,co)),
chk1show("/* 例2 */ on3byon3([[on3,x,2,5,co],[on3,x,4,6,co]])", on3(x,4,5,co)),
chk1show("/* 例3 */ on3byon3(on3(x,2,5,co)*on3(x,a,b,co))", 'unknown),
cmds : sconcat("/* 例4 */ ( ass_set([2<a, a<5, 5<b]), @",
" out:on3byon3(on3(x,2,5,co)*on3(x,a,b,co)), ",
" fact_forget([a,b]), out)"),
chk1show(cmds, on3(x,a,5,co)),
chk1show("/* 例5 */ on3byon3(on3(x,minf,inf,oo)*on3(x,a,b,co))", on3(x,a,b,co)),
fact_forget([a,b,c,d])
),
if false then (
print("== 未定端点とon3積 =="),
for exans in [[exL[1],ansL[1]],[exL[2],ansL[2]],[exL[3],ansL[3]]] do (
ex : exans[1], ans : exans[2],
c0show("例 ",ex),
chkshow("on3byon3(ex)",on3byon3(ex),ans)
) /* end of for-exans */
),
if true then (
print("== 仮定とソート =="),
for cL in [[sc[1],c1,sansL[1]],[sc[2],c2,sansL[2]],
[sc[3],c3,sansL[3]],[sc[4],c4,sansL[4]],
[sc[5],c5,sansL[5]],[sc[6],c6,sansL[6]]] do (
c0show("例 : 仮定",cL[1]),
if false then kill(a,b,c,d),
c1show(stringp(cL[1])),
eval_string(cL[1]),
c1show(cL[1]), cashow(sort([a,b,c,d],"<=")),
out: on3byon3(exundef),
title : sconcat("on3byon3(on3(x,a,b,co)*on3(x,c,d,co)) with ",cL[1]),
chkshow(title,out,cL[3]),
c1show(cL[2],ev(cL[2])),
forget(ev(cL[2])),
c1show(facts())
) /* end of for-cL */
), /* end of if */
print("--end of on3byon3('ex)--")
),
return("--end of on3byon3('ex)--"),
block_main, /* main ブロック ====================================*/
/* args[1] = on3(x,xli,xri,lri) * on3(x,xlj,xrj,lrj), */
/* args[1] = [[on3,x,xli,xri,lri],[on3,x,xlj,xrj,lrj]] */
if listp(args[1]) and listp(args[1][1]) and args[1][1][1]='on3 then (
[func,x,xli,xri,lri] : args[1][1],
[func,xw,xlj,xrj,lrj] : args[1][2]
),
if listp(args[1]) = false then (
wL : f2l(args[1]),
c1show(wL),
[func,x,xli,xri,lri] : wL[3],
[func,xw,xlj,xrj,lrj] : wL[4]
),
c1show(x,xw,is(x # xw)),
if is(x # xw) then (
c0show(progn,"Error: Not same variable in two on3() functions"),
return(args[1])
),
c1show(xli,xri,lri,xlj,xrj,lrj),
assume(xli<=xri, xlj<=xrj), /* on3()の暗黙仮定の設定 */
c2show(unique(flatten(map('facts,[xli,xri,xlj,xrj])))),
c1show(progn, "暗黙仮定の設定", var_fact([xli,xri,xlj,xrj]) ),
wl : max(xli, xlj), wr : min(xri,xrj),
c1show(wl,wr,is(wl<=wr)),
if member(is(wl<=wr), [false]) then (
wout:0, c1show(progn,wout," ← 積の結果"), return(wout)),
if member(is(wl<=wr), [unknown]) then (
wout: unknown, c0show(progn,wout," ← 積の結果"), return(wout)),
/* 開閉 */
il : if member(lri, [co,cc]) then "c" else "o",
ir : if member(lri, [oc,cc]) then "c" else "o",
jl : if member(lrj, [co,cc]) then "c" else "o",
jr : if member(lrj, [oc,cc]) then "c" else "o",
if is(wl=xli) and is(wr=xri) then wlr:eval_string(sconcat(il,ir)),
if is(wl=xli) and is(wr=xrj) then wlr:eval_string(sconcat(il,jr)),
if is(wl=xlj) and is(wr=xri) then wlr:eval_string(sconcat(jl,ir)),
if is(wl=xlj) and is(wr=xrj) then wlr:eval_string(sconcat(jl,jr)),
wout : funmake(on3, [x,wl,wr,wlr]),
c1show(progn,wout," ← 積の結果"),
fact_forget([xli,xri, xlj,xrj]), fact_forget([xli,xri, xlj,xrj]), /* 暗黙仮定の解除 */
c1show(progn,"暗黙仮定の解除",var_fact([xli,xri,xlj,xrj])),
c2show(progn,facts()),
return(wout)
)$ /* end of on3byon3() */
/* ######################################################################## */
/* ### ass_set : 仮定の設定 2021.04.06 ###################################### */
/* ######################################################################## */
ass_set([args]) := block([progn:"<ass_set>",debug,ass0,ass],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of ass_set('help)--
機能: 仮定の設定
文法: ass_set([a<c,c<b,b<d])
例示: ass_set([a<c,c<b,b<d])
var_fact([a,b,c,d]) facts()出力から変数リストに関連する事実を表示する
fact_var([a<c,c<b,b<d]) 引数で指定された事実(facts)に現れる変数をリストで返す
fact_forget([a,b,c,d]) 変数リスト/事実リストで指定された事実を消去する
on3byon3([[on3,x,1,3,co],[on3,x,2,4,co]],debug1) -> on3(x,2,3,co)
--end of ass_set('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of ass_set('ex)--"),
block([a,b,c,d,cmds],
fact_forget([a,b,c,d]),
chk1show("/* 仮定の設定: */ ass_set([a<c,c<b,b<d])",[c > a,b > c,d > b] ),
chk1show("/* 事実の表示: */ var_fact([a,b,c,d])", [b > c,c > a,d > b]),
chk1show("/* 事実の変数: */ fact_var([c > a,b > c,d > b])", [a,b,c,d]),
cmds : sconcat("/* 仮定の本での on3()関数の積 */@",
"on3byon3(on3(x,a,b,co)*on3(x,c,d,co))"),
chk1show(cmds, on3(x,c,b,co)),
chk1show("/* 事実の消去: */ fact_forget([a,b,c,d])",[]),
chk1show("/*事実消去の確認: */ var_fact([a,b,c,d])", []),
cmds : sconcat("/* 無仮定の場合の on3()関数の積 */ @",
"on3byon3(on3(x,a,b,co)*on3(x,c,d,co))"),
chk1show(cmds, 'unknown),
fact_forget([a,b,c,d])
),
return("--end of ass_set('ex)--"),
block_main, /* main ブロック ===================================*/
/* リストで与えた仮定を設定する */
ass0 : args[1],
ass : apply('assume, ass0),
c1show(progn,"仮定の設定",ass),
return(ass)
)$
/* ################################################################################## */
/* ### var_fact : facts()出力から変数リストに関連する事実を検出表示する 2021.04.06 ######## */
/* ################################################################################## */
var_fact([args]) := block([progn:"<var_fact>",debug,varL,wout],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of var_fact('help)--
機能: facts()出力から変数リストに関連する事実を表示する
文法: var_fact([a,b,c,d])
例示: var_fact([a,b,c,d]) -> [a<c,c<b,b<d]
--end of ass_set('help)--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of ass_set('ex)--"),
fact_forget([a,b,c,d]),
ass_set('ex),
return("--end of ass_set('ex)--"),
block_main, /* main ブロック ===================================*/
/* 変数リストから関連する事実(facts)を表示する */
varL : args[1],
wout : map('facts, varL), /* facts()の出力から変数リストvarLに関する要素を検出する */
wout : unique(flatten(wout)),
c1show(progn,varL," ->", wout),
return(wout)
)$
/* ################################################################################# */
/* ### fact_var : 引数で指定された事実(facts)に現れる変数をリストで返す 2021.04.06 ####### */
/* ################################################################################# */
fact_var([args]) := block([progn:"<fact_var>",debug,wfact,wvar],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of fact_var('help)--
機能: facts()出力から変数リストに関連する事実を表示する
文法: fact_var([a,b,c,d])
例示: fact_var([a<c,c<b,b<d]) -> [a,b,c,d]
fact_var('facts) -> facts()出力から変数リストに関連する事実を表示する
--end of fact_var('help)--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of ass_set('ex)--"),
fact_forget([a,b,c,d]),
ass_set('ex),
return("--end of ass_set('ex)--"),
block_main, /* main ブロック ===================================*/
/* 引数で指定された事実(facts)に現れる変数をリストで返す */
if args[1]='facts then (
wfact : facts(),
for i:1 thru length(wfact) do if rhs(wfact[i])=0 then wfact[i]:0,
wfact : delete(0,wfact)
) else wfact : args[1],
wvar : unique( append( map('lhs,wfact), map('rhs,wfact)) ),
c1show(progn,"事実に現れる変数変数リスト",wvar),
return(wvar)
)$
/* ################################################################################# */
/* ### fact_forget : 変数リスト/事実リストで指定された事実を消去する 2021.04.06 ########## */
/* ################################################################################# */
fact_forget([args]) := block([progn:"<fact_forget>",debug,wfact,wvar:[]],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of fact_forget('help)--
機能: 変数リスト/事実リストで指定された事実を消去する
文法: fact_forget([a,b,c,d])
例示: fact_forget([a,b,c,d]) -> [a,b,c,d] で指定された事実を消去する
--end of fact_forget('help)--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of ass_set('ex)--"),
fact_forget([a,b,c,d]),
ass_set('ex),
return("--end of ass_set('ex)--"),
block_main, /* main ブロック ===================================*/
/* 事実を消去する */
if listp(args[1]) and (rhs(args[1][1])=0)
then ( /* 変数リスト指定の場合 */
wvar : args[1],
wfact : map('facts, args[1]), wfact : unique(flatten(wfact))
)
else wfact : flatten(args[1]), /* 事実リストで指定の場合 */
c1show(progn,wvar,wfact," <- 消去される事実"),
wfact : flatten(forget(wfact)),
return(wfact)
)$ /* end of fact_forger() */
/* ################################################################################## */
/*############################################################################*/
/*### on3info #########2020.02.23,2021.03.08 ###*/
/* expr に含まれる変数varの関数on3(var...)の情報を表示する */
/*############################################################################*/
on3info([args]) := block([progn:"<on3info>",debug,std:flase,
expr,var, wL,ic,Lon3,Lon3lr0,Lon3lr, on3v,on3f,on3coef,
Lon3v,Lon3f,Lon3coef, undefpnts,outL,outf],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
if member('std, args) then (std:true, args:delete('std, args)),
c1show(std, args),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3info('help)--
機能: expr に含まれる変数varの関数on3(var...)の情報をリストで返す
結果のリストはoutLev()で取り出せる.
on3多項式を前提とするため,定数項が存在する合も考慮されている(変数毎のon3stdの機能を有する)
引数に'std がある場合は指定された変数に関する標準化の結果を返す
expr が on3有理式の場合は on3decomp21(expr,x,[仮定1,...]) によりon3多項式化を得る.
文法: on3info(expr,x,...) or on3info(expr)
on3info(expr,x,'factor), on3info(expr,x,'std)
例示: on3info(f1*log(x)*on3(x,1,2,co)+f0, x,'std)
-> f0*on3(x,minf,1,oo) + (f0+f1)*on3(x,1,2,co) + f0*on3(x,2,inf,co) (標準化)
--end of on3info('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3info('ex)--"),
block([progn:"<on3info_ex>", ex0, ex1, ex2, ex22, ex3, ex4, ex, cmds, L:[], out, chk],
print("---begin of on3info_ex---"),
ex0 : f1*log(x)*on3(x,1,2,co)+f0,
c0show("◆ 例0",ex0," <- on3std未処理の場合"),
c0show(on3info(ex0, x)),
c0show("◆ ",on3info(ex0,x,'std)," <- 'std 指定の場合"),
ex1 : on3info(f1*log(x)*on3(x,1,2,co)+f0,x,'std),
c0show("◆ 例1",ex1," <- on3std処理済みの場合"),
c0show(on3info(ex1, x)),
c0show("◆ 例1-2",ex1," <- 結果リストの一括取り込みと一括削除の例"),
cmds : sconcat("(",
"outLev(on3info(ex1,x),\"test_\"), /* 結果リストをtest_*で取り込む */ @",
"c0show(test_Lon3f), c0show(test_Lon3coef), /* 取り込みリストの表示 */ @",
"killvars([\"test_\"]) /* 取り込みリストの一括削除 */ , values",
")"),
chk2show(cmds,""),
ex2 : f*on3(x,1,3,co)/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)),
c0show("◆ 例2-1",ex2," <- 有理式の分母に適用した場合"),
c0show(ratdenom(ex2)),
c0show(on3info(ratdenom(ex2),x)),
ex22 : (f3*on3(x,1,3,co)+f4*on3(x,2,4,co))/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)),
c0show("◆ 例2-2",ex22," <- 有理式に適用した場合"),
c0show(ex22),
c0show(on3info(ex22,x,'std)),
c0show("■ on3decomp21(ex22,x,[1<a,a<2,2<c,c<3,3<b,b<4,4<d]) を実行しon3多項式(排他的分解済)を得る"),
c0show(on3decomp21(ex22,x,[1<a,a<2,2<c,c<3,3<b,b<4,4<d])),
c0show("◆ 例3",ex3," 第1引数が単変数でない場合"),
ex3 : f1*on3(t-u,1,3,co)+f2*on3(t-u,u,inf,co),
c0show(ex3),
c0show(on3info(ex3,t)),
ex4 : f1(x,y)*on3(x,1,8,co)*on3(y,minf,3,oo) + f2(x,y)*on3(y,2,5,cc),
c0show("◆ 例4",ex4," 2変数関数の場合"),
c0show(on3info(ex4,y)),
return("--- end of on3info_ex---")
), /* end of block */
print("--end of on3info('ex)--"),
return("--end of on3info('ex)--"),
block_main, /* main ブロック ====================================*/
expr : ratexpand(args[1]),
c1show(progn,on3vars(expr)),
if length(on3vars(expr)) > 0 then var : listofvars(on3vars(expr))[1],
if length(args) > 1 and member(args[2], listofvars(on3vars(expr))) then var : args[2],
c1show(progn,expr,on3vars(expr),var,std),
/* 失敗する
if member('decomp, args) then (
args : delete('decomp, args),
cshow(args),
out : on3decomp21(args),
cshow(progn,out),
return(out)
),
*/
/*** on3 有理式の'std : 暫定的対応 2021.02.16 ***/
if (on3typep(expr)='on3polyinv) and member('std,args) then (
expr : on3info(ratnumer(expr),ev(var),'std)
/ on3info(ratdenom(expr),ev(var),'std),
c0show(" ■ on3有理式を検出した->on3decomp21()によりon3排他的分解,on3多項式化を試みよ"),
return(expr)
),
if on3_same_var(expr,var) > 1 then (
expr : on3simp(expr,ev(var)),
if on3_same_var(expr,var) > 1 then (
c0show(progn," ERROR: 同一変数のon3関数の積を検出した"),
return("Error in on3info")
)
),
c2show(progn,"-----"),
retry, /*### retry point ###*/
c1show(progn,expr,var),
wL : f2l(expr),
ic : 0, Lon3 : [], Lon3lr0 : [],
wL : scanmap(lambda([u],
if listp(u) and u[1]=on3 and freeof(ev(var),u[2])=false then (
ic:ic+1, c1show("** find ",ic,u),
Lon3 : append(Lon3,[u]),
Lon3lr0 : append(Lon3lr0,[u[3],u[4]]),
u:sconcat("<<here-",ic,">>"), u) else u), wL),
/* on3検出関数リスト Lon3 とその端点リスト Lon3lr から
on3変数化リスト Lon3v, on3関数リストLon3f を生成 */
Lon3 : unique(Lon3),
Lon3lr0: unique(Lon3lr0), Lon3lr0 : sort(Lon3lr0, ordermagnitudep),
Lon3lr : delete(minf,Lon3lr0), Lon3lr : delete(inf,Lon3lr),
Lon3v : [], Lon3f : [], Lon3coef : [], undefpnts : [], outf : expr,
if length(Lon3)=0 then (
outL : ['expr=expr,'var=var,
'Lon3=Lon3,'Lon3v=Lon3v,'Lon3f=Lon3f,'Lon3coef=Lon3coef,
'Lon3lr0=Lon3lr0, 'Lon3lr='Lon3lr, 'undefpnts=undefpnts, 'outf=outf],
if std=true then return(outf) else return(outL)
),
outf : 0,
if length(Lon3)>0 then for ic:1 thru length(Lon3) do (
on3v : eval_string(sconcat("on3v_",ic)), /* on3() の変数化 */
Lon3v : endcons(on3v,Lon3v),
on3f : funmake(first(Lon3[ic]),rest(Lon3[ic],1)), /* [on3,x,xl,xr,,xlr] の関数化 */
Lon3f : endcons(on3f,Lon3f),
on3coef : ratcoef(expr,Lon3f[ic]), c1show(on3coef),
if member('factor, args) then on3coef : factor(on3coef), /* add 2020.06.03 */
Lon3coef : endcons(on3coef,Lon3coef),
outf : outf + on3coef * on3f
), /* end of if */
c1show(progn,is(equal(outf,expr))),
if member(is(equal(outf,expr)),[false,unknown]) then (
c1show(progn,"-> on3多項式に定数項が存在 -> 標準化し再試行する"),
expr : outf + (expr-outf)*on3(ev(var),minf,inf,oo),
go(retry)
),
undefpnts : map(numberp,Lon3lr), undefpnts : delete(true,undefpnts),
c1show(Lon3), c1show(Lon3v), c1show(Lon3f), c1show(Lon3coef),
c1show(Lon3lr0), c1show(Lon3lr), c1show(outf), c1show(map(numberp,Lon3lr)),
c1show("端点リスト内の非数値の個数",length(undefpnts)),
outL : ['expr=expr, 'var=var,
'Lon3=Lon3, 'Lon3v=Lon3v, 'Lon3f=Lon3f, 'Lon3coef=Lon3coef,
'Lon3lr0=Lon3lr0, 'Lon3lr=Lon3lr, 'undefpnts=undefpnts, 'outf=outf],
c1show(progn,outL),
c1show(progn,"return---",outf),
if std=true then return(outf) else return(outL)
)$ /* end of on3info */
/*############################################################################*/
/*### outLev #########2020.02.18 ###*/
/* L : [L1=[l11,l12],L2=[l21,l22]]
-> outLev_L1=[l11,l12], outLev_L2=[l21,l22] として参照出来るようにする. */
/*############################################################################*/
outLev([args]) := block([progn:"<outLev>",debug,L,Ll,Lr,prestr,str],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of outLev('help)--
機能: 名前付きリストを展開する
文法: outLev(outL,\"test_\")
例示: outL : [L1=[l11,l12],L2=[l21]]
outLev(outL,\"test_\") -> test_L1=[l11,l12], test_L2=[l21]
--end of outLev('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of outLev('ex)--"),
block([progn:"<outLev('ex)>",debug,ex,x,outL],
debug: ifargd(),
cmds : sconcat("(",
"/* outLev() の実行例 */ @",
"ex : on3(x,a,b,co)*on3(y,yl,yr,oo) + x*on3(x,c,d,cc), @",
"outL : on3info(ex,x), /* on3info()の結果(名前付きリスト)を得る */ @",
"c0show(outL), /* outL の内容確認 */ @",
"outLev(outL,\"test_\"), /* 変数test_* の形で展開 */ @",
"cshow(values) /* 変数一覧で確認する */ @",
")"),
chk2show(cmds,""),
return("-- end of outLev_ex --")
), /* end of block */
print("--end of outLev('ex)--"),
return("--end of outLev('ex)--"),
block_main, /* main ブロック ====================================*/
L : args[1], if length(args)<2 then prestr : "outLev_" else prestr : args[2],
c1show(progn,L),
Ll : map(lhs,L),
Lr : map(rhs,L),
for i:1 thru length(L) do (
str : sconcat(prestr,string(Ll[i])," : ",Lr[i]),
c1show(i,str),
eval_string(str),
c1show(eval_string(str))
), /* end of for */
c1show(progn,values)
)$ /* end of outLev() */
/*############################################################################*/
/* ON3on3 : ON3() -> on3() の変換 2020.02.20 */
/*############################################################################*/
ON3on3([args]) := block([progn:"<ON3on3>",debug,wL,out],
debug:ifargd(),
if listp(args[1]) then wL:args[1] else wL : f2l_full(args[1]),
c1show(progn,"pre-wl",wL),
wL : scanmap(lambda([u],
if listp(u) and u[1]=ON3 then (
u[1] : on3, u) else u), wL),
c1show(progn,"after-WL",wL),
out : l2f(wL),
c1show(progn,out),
return(out)
)$ /* end of ON3on3() */
/*############################################################################*/
/*### on3decomp_one ###### 2020.03.06 ###*/
/* 特定変数に着目したon3()関数の排他的領域分解を行う: 変数毎の逐次排他的領域分解
f1(x,y)*on3(x,x1,x2,xlr1)*on3(y,y1,y2,ylr1) の多項式を特定変数xf=xのon3(xf,...)の
{f1(x,y)*on3(y,y1,y2,ylr1)} * on3(xf,x1,x2,xlr1)
の多項式と見なし,それを排他的区分分解を試みる.
条件: 指定した特定変数に関する端点はすべて数値で大小関係は既知とする.
on3info(expr,var,'std)処理済み
例 ex : f1(x)*on3(x,1,3,co) + f2(x)*on3(x,2,5,co)
-> f(x,xf) : f1(x)*on3(xf,1,3,co) + f2(x)*on3(xf,2,5,co)
端点 minf---1---2---3---5---inf
-> f1(x)*on3(xf,1,2,co) + (f1(x)+f2(x))*on3(xf,2,3,co) + f2(x)*on3(xf,3,5,co)
端点の開閉
ev(f(x,xf),xf=1)=f1(x), ev(f(x,xf,xf=1.5)=f1(x), ev(f(x,xf),xf=2)=f1(x)+f2(x)
-> on3(xf,1,2,co)
ev(f(x,xf),xf=2)=f1(x)+f2(x), ev(f(x,xf,xf=2.5)=f1(x)+f2(x), ev(f(x,xf),xf=3)=f2(x)
-> on3(xf,2,3,co)
ev(f(x,xf),xf=3)=f2(x), ev(f(x,xf,xf=4)=f2(x), ev(f(x,xf),xf=5)=0
-> on3(xf,3,5,co)
*/
on3decomp_one([args]) := block([progn:"<on3decomp_one>",debug,
infunc0,inv,var,var_fix,infunc,outL,lrL, ic,evl,evm,evr,wl,wr,wlr,out],
debug : ifargd(), c1show(progn,debug),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3decomp_one('help)--
機能: 変数毎の逐次排他的領域分解:特定変数に着目したon3()関数の排他的領域分解を行う.
引数に'invが指定されると結果の逆数が返される.
条件: 指定した特定変数に関する端点はすべて数値で大小関係は既知とする.
on3info(expr,var,'std)処理済み
文法: on3decomp_one(on3func,var,...)
例示:
ex : f1(x)*on3(x,1,3,co) + f2(x)*on3(x,2,5,co)
-> f(x,xf) : f1(x)*on3(xf,1,3,co) + f2(x)*on3(xf,2,5,co)
端点 minf---1---2---3---5---inf
-> f1(x)*on3(xf,1,2,co) + (f1(x)+f2(x))*on3(xf,2,3,co) + f2(x)*on3(xf,3,5,co)
-> 1/f1(x)*on3(xf,1,2,co) + 1/(f1(x)+f2(x))*on3(xf,2,3,co) + 1/f2(x)*on3(xf,3,5,co)
('inv が指定された場合)
端点の開閉
ev(f(x,xf),xf=1)=f1(x), ev(f(x,xf,xf=1.5)=f1(x), ev(f(x,xf),xf=2)=f1(x)+f2(x)
-> on3(xf,1,2,co)
ev(f(x,xf),xf=2)=f1(x)+f2(x), ev(f(x,xf,xf=2.5)=f1(x)+f2(x), ev(f(x,xf),xf=3)=f2(x)
-> on3(xf,2,3,co)
ev(f(x,xf),xf=3)=f2(x), ev(f(x,xf,xf=4)=f2(x), ev(f(x,xf),xf=5)=0
-> on3(xf,3,5,co)
--end of on3decomp_one('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3decomp_one('ex)--"),
block([progn:"<on3decomp_one('ex)>",cmds,ans,ex,f,f1,f2,f20,f0,fy,fyx,vL],
cmds : sconcat("(","/* 例1. 排他的区分分解 */ @",
"ex : f1(x)*on3(x,minf,3,co) + f2(x)*on3(x,2,5,cc), @",
"f : on3decomp_one(ex,x) @",
")"),
ans : f1(x)*on3(x,minf,2,oo)+f2(x)*on3(x,3,5,cc)+(f2(x)+f1(x))*on3(x,2,3,co),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例2-1. 2変量関数を変数yで分解 */ @",
"f20 : f1(x,y)*on3(x,1,8,co)*on3(y,minf,3,oo) + f2(x,y)*on3(y,2,5,cc), @",
"fy : on3decomp_one(f20,y) @",
")"),
/*
ans : on3(x,1,8,co)*f1(x,y)*on3(y,minf,2,oo)
+on3(x,minf,inf,oo)*f2(x,y)*on3(y,3,5,cc)
+(on3(x,minf,inf,oo)*f2(x,y)+on3(x,1,8,co)*f1(x,y))*on3(y,2,3,co),
*/
ans : on3(x,1,8,co)*f1(x,y)*on3(y,minf,2,oo)
+f2(x,y)*on3(y,3,5,cc)
+(f2(x,y)+on3(x,1,8,co)*f1(x,y))*on3(y,2,3,co),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例2-2. fy を変数xで分解 */ @",
"fy : ratexpand(fy), fyx : on3decomp_one(fy,x) @",
")"),
ans : on3(x,1,8,co)
*(f1(x,y)*on3(y,minf,2,oo)+f2(x,y)*on3(y,3,5,cc)
+f2(x,y)*on3(y,2,3,co)+f1(x,y)*on3(y,2,3,co))
+on3(x,minf,1,oo)*(f2(x,y)*on3(y,3,5,cc)+f2(x,y)*on3(y,2,3,co))
+on3(x,8,inf,co)*(f2(x,y)*on3(y,3,5,cc)+f2(x,y)*on3(y,2,3,co)) ,
chk2show(cmds,ans),
c0show("●",ev(fy,y=2)),
return("-- end of on3decomp_one('ex) --")
), /* end of block */
print("--end of on3decomp_one('ex)--"),
return("--end of on3decomp_one('ex)--"),
block_main, /* main ブロック ====================================*/
infunc0 : args[1], var : args[2],
inv : false, if member('inv, args) then inv : true,
c1show("▶ ",progn," START ", var, inv),
c2show(infunc0),
if true then infunc0 : on3info(infunc0,var,'std),
if true then (c1show(progn,on3typep(infunc0),on3vars(infunc0)) ),
var_fix : eval_string(sconcat(var,"_fix")),
c1show(var_fix),
c1show(on3varfix(infunc0,ev(var),'on)), /* ??? */
infunc : on3varfix(infunc0,ev(var),'on),
c1show(progn,infunc0,var,var_fix),
c1show(progn,infunc),
outL : on3info(infunc,ev(var_fix)),
c1show(progn,outL),
outLev(outL,"w_"),
lrL : sort(w_Lon3lr0, ordermagnitudep),
killvars("w_"),
c1show(progn,lrL),
out : 0,
for ic:1 thru length(lrL)-1 do (
evl : ev(infunc,ev(var_fix)=lrL[ic]),
evm : ev(infunc,ev(var_fix)=(lrL[ic]+lrL[ic+1])/2),
evr : ev(infunc,ev(var_fix)=lrL[ic+1]),
wlr : "xx",
if member(is(equal(evm,evl)),[true]) and is(equal(lrL[ic],minf))=false
then wl:"c" else wl:"o",
if member(is(equal(evm,evr)),[true]) and is(equal(lrL[ic+1],inf))=false
then wr:"c" else wr:"o",
wlr : eval_string(sconcat(wl,wr)),
c1show(ic,lrL[ic],lrL[ic+1],evl,evm,evr,wl,wr,wlr),
c1show(is(equal(evm,evl)),is(equal(evm,evr)) ),
if inv=true then out : out + 1/evm * on3(ev(var),lrL[ic],lrL[ic+1],wlr)
else out : out + evm * on3(ev(var),lrL[ic],lrL[ic+1],wlr)
),
c1show(progn,"結果 ◆",var,inv,out),
return(out)
)$ /* end of on3decomp_one() */
/*#####################################################################*/
/* ### on3asdecomp : 未定端点を含むon3多項式の排他的分解 2021.02.09 ####### */
/*#####################################################################*/
on3asdecomp([args]) := block([progn:"<on3asdecomp>", debug,
expr, var, ass0, wL, inv, assadd, w_coef, w_expr, xm,xl,xr,evL, lr, outL, sortL, out],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3asdecomp('help)--
機能: 未定端点を含むon3多項式の排他的分解
文法: on3asdecomp(expr,var,[assumption])
例示: ---1---a---2---b---3---4---
ex1 : f1*on3(x,1,3,co) + f2*on3(x,2,4,co); ex2 : ex1 + f3*on3(x,a,b,co);
on3asdecomp(ex2,x,[1<a, a<2, 2<b, b<3],debug0);
-> (f2+f1)*on3(x,b,3,co)+(f3+f1)*on3(x,a,2,co)+f2*on3(x,3,4,co)
+(f3+f2+f1)*on3(x,2,b,co)+f1*on3(x,1,a,co)
on3asdecomp(ex2,x,[1<a,a<2,2<b,b<3],'inv);
-> on3(x,b,3,co)/(f2+f1)+on3(x,a,2,co)/(f3+f1)+on3(x,3,4,co)/f2
+on3(x,2,b,co)/(f3+f2+f1)+on3(x,1,a,co)/f1
--end of on3asdecomp('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3asdecomp('ex)--"),
on3asdecomp_ex(),
print("--end of on3asdecomp('ex)--"),
return("--end of on3asdecomp('ex)--"),
block_main, /* main ブロック ====================================*/
inv : if member('inv, args) then true else false,
expr : args[1], var : args[2],
if (length(args)>=3) and listp(args[3]) then ass0 : args[3] else ass0:[],
c1show(progn,expr,var,ass0),
/* 仮定の設定と仮定履歴の記録 */
if (length(args)>=3) and listp(ass0) then (
wL : apply('assume, ass0),
wL : delete('redandunt, wL), ass_hist : append(ass_hist,wL)
),
c1show(progn,"初期仮定",ass0),
outL : on3info(expr,var),
c1show(progn,"on3info()の結果",outL),
outLev(outL,"w_"),
c1show(progn,"端点リスト",w_Lon3lr0),
if errcatch( sortL:sort(w_Lon3lr0,"<"), return ) = [] then
cashow(progn," ◆ 端点ソートエラー: errcatch in sort(w_Lon3lr0L,\"<\") ")
else c1show("---No errcatch in sort(w_Lon3lr0,\"<\")",sortL),
c1show(progn,"端点リストのソート結果",sortL),
/* 中間点に関する仮定の追加 */
assadd : [],
for i:1 thru length(sortL)-1 do (
xm : (sortL[i] + sortL[i+1])/2,
if numberp(xm)=false then (
for j:1 thru i do
if is(xm < sortL[j])=unknown then assadd:endcons(xm>sortL[j], assadd),
for j:i+1 thru length(sortL) do
if is(xm < sortL[j])=unknown then assadd:endcons(xm<sortL[j], assadd)
) /* end of if */
), /* end of for i */
if length(assadd)>0 then for i:1 thru length(assadd) do assume(assadd[i]),
c1show(progn,"中間点に関する仮定",assadd),
c1show(facts()),
/* on3関数式の排他的分解形の生成 2021.02.09 */
w_coef : [], /* 係数リスト w_Lon3coef の名詞形リスト w_coef を作成 */
for i:1 thru length(w_Lon3) do w_coef : endcons('w_Lon3coef[i],w_coef),
/* 名詞形を作成 */
c1show(progn,"係数リストの名詞形",w_coef),
w_expr : 0,
for i:1 thru length(w_coef) do w_expr : w_expr + w_coef[i]*w_Lon3f[i],
c1show(progn,"名詞形関数",w_expr),
out : 0,
for i:1 thru length(sortL)-1 do (
xl : sortL[i], xr : sortL[i+1], xm : (xl+xr)/2,
evL : [ev(w_expr,ev(var)=xl), ev(w_expr,ev(var)=xm), ev(w_expr,ev(var)=xr)],
if (evL[2]=evL[1]) and (evL[2]=evL[3]) then lr:cc
else if (evL[2]=evL[1]) and (evL[2]#evL[3]) then lr:co
else if (evL[2]#evL[1]) and (evL[2]=evL[3]) then lr:oc
else lr:oo,
c1show(progn,i,[xl,xr],evL,xm,lr),
out : if inv=false then out + ev(evL[2],nouns)*funmake(on3,[ev(var),xl,xr,lr])
else out + 1/ev(evL[2],nouns)*funmake(on3,[ev(var),xl,xr,lr]),
c1show(i,evL[2],ev(var),xl,xr,lr)
),
c1show(progn,out),
killvars(["w_"]), forget(ass0,assadd), c1show(facts()), c1show(values),
return(out)
)$
/* ### end of on3asdecomp() ############################################ */
/*===on3asdecomp_ex() ===================================================*/
on3asdecomp_ex([args]) := block([progn:"<on3asdecomp_ex>",debug,
ex1,ex2,ex3,cmds,ans,f1,f2,f3,a,b,c,d,f20,fy,fyx,
ex,wn0,wd0,wn1,wd1,wn2,wd2,out],
cmds : sconcat("(",
"/* ◆ a, b が未定定数の場合の on3(x,a,b,??) の評価 */ @",
"[on3(a,a,a,cc), on3(a,a,a,co), on3(a,a,a,oc), on3(a,a,a,oo)]",
")"),
chk2show(cmds,[1,0,0,0]),
cmds : sconcat("(",
"/* 命題 a <= a < b は 暗黙仮定 a<b で評価される */ @",
"[on3(a,a,b,co), on3((a+b)/2,a,b,co), on3(b,a,b,co)]",
")"),
chk2show(cmds,[1,1,0]),
cmds : sconcat("(",
"/* 命題 a <= a <= b は 暗黙仮定 a<=b で評価される */ @",
"[on3(a,a,b,cc), on3((a+b)/2,a,b,cc), on3(b,a,b,cc)]",
")"),
cmds : sconcat("(",
"/* 例1 minf---1---2---3---4---inf */ @",
"ex1 : f1*on3(x,1,3,co) + f2*on3(x,2,4,co) + f0, @",
"out : on3asdecomp(ex1,x,debug0)",
")"),
ans : f0*on3(x,minf,1,oo)+f0*on3(x,4,inf,co)+(f2+f0)*on3(x,3,4,co)
+(f2+f1+f0)*on3(x,2,3,co)+(f1+f0)*on3(x,1,2,co),
chk2show(cmds,ans),
/* === a1 : assume(1<a,a<2,2<b,b<3) ===============
f2 c-----------------o
f1 c----------------o
-----1---a---2----b---3--------4---------> x
f3 c--------o
when a1 , xm : (2+b)/2 , is(xm >= a) ---> unknown ???
*/
cmds : sconcat("(",
"/* 例2 明示仮定 ---1---a---2---b---3---4--- */ @",
"ex1 : f1*on3(x,1,3,co) + f2*on3(x,2,4,co), ex2 : ex1 + f3*on3(x,a,b,co), @",
"out : on3asdecomp(ex2,x,[1<a, a<2, 2<b, b<3],debug0)",
")"),
ans : (f2+f1)*on3(x,b,3,co)+(f3+f1)*on3(x,a,2,co)+f2*on3(x,3,4,co)
+(f3+f2+f1)*on3(x,2,b,co)+f1*on3(x,1,a,co),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例3 明示仮定 ---a---c---b---d---, 'inv 指定 */ @",
"ex3 : f1*on3(x,a,b,co) + f2*on3(x,c,d,co),@",
"out : on3asdecomp(ex3,x,[a<c,c<b,b<d],'inv,debug0)",
")"),
ans : on3(x,c,b,co)/(f2+f1)+on3(x,b,d,co)/f2+on3(x,a,c,co)/f1,
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例4-1. 2変量関数を変数 y で分解 */ @",
"f20 : f1(x,y)*on3(x,1,8,co)*on3(y,minf,3,oo) + f2(x,y)*on3(y,2,5,cc), @",
"fy : on3asdecomp(f20,y,debug0)",
")"),
ans : on3(x,1,8,co)*f1(x,y)*on3(y,minf,2,oo)+f2(x,y)*on3(y,3,5,cc)
+(f2(x,y)+on3(x,1,8,co)*f1(x,y))*on3(y,2,3,co),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例4-2. 2変量関数を変数 x で分解 */ @",
" fy : ratexpand(fy), fyx : on3asdecomp(fy,x,debug0),",
" c0show(ev(fy,y = 2)), fyx",
")"),
ans : on3(x,1,8,co)*
(f1(x,y)*on3(y,minf,2,oo)+f2(x,y)*on3(y,3,5,cc)
+f2(x,y)*on3(y,2,3,co)+f1(x,y)*on3(y,2,3,co))
+on3(x,minf,1,oo)*(f2(x,y)*on3(y,3,5,cc)+f2(x,y)*on3(y,2,3,co))
+on3(x,8,inf,co)*(f2(x,y)*on3(y,3,5,cc)+f2(x,y)*on3(y,2,3,co)),
/* ● ev(fy,y = 2) = f2(x,2)+on3(x,1,8,co)*f1(x,2) */
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例5. 1変量on3有理式の分解 */ @",
" ex : 1/(f1*on3(x,1,5,co) + f2*on3(x,3,7,co)) + f0*on3(x,3,5,co), @",
" wn0 : ratnumer(ex), wd0 : ratdenom(ex), @",
" wn1 : on3simp(wn0), wd1 : on3simp(wd0), @",
" wn2 : on3asdecomp(wn1,x), wd2 : on3asdecomp(wd1,x,'inv), @",
" out : ev(on3simp(wn2*wd2),ratsimp)",
")"),
ans : (f1*f2*(on3(x,5,7,co)+on3(x,1,3,co))+f1^2*on3(x,5,7,co)
+(f0*f1*f2^2+(f0*f1^2+f1)*f2)*on3(x,3,5,co)+f2^2*on3(x,1,3,co))
/(f1*f2^2+f1^2*f2),
chk2show(cmds,ans),
return("---end of on3asdecomp_ex---")
)$ /* end of on3asdecomp_ex() */
/*############################################################################*/
/*### on3decompm ######### 2022.03.22 ###*/
/* 区間関数 on3(x,...) の多項式を排他的区間に分解する処理を変数リスト 'varsL=[x,y,z] に現れる順序で行なう｡
制限:3変数までのon3多項式｡適切な仮定の設定があれば,区間の端点は未定定数を許す｡
*/
on3decompm([args]) := block([progn:"on3decompm", debug,
kno_v, kno_a, expr, varsL, assw, outL, out1,out2, expandv2, expandv3, sum_i, sum_j,
v1, v1_Lon3f, v1_Lon3coef, www, v2, outLv2, wL,lrpout,new,old,out,sum],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3decompm('help)--
機能: 区間関数 on3(x,...) の多項式を排他的区間に分解する処理を変数リスト'varsL=[x,y,z] の順序で行なう｡
制限:3変数までのon3多項式｡適切な仮定の設定があれば,区間の端点は未定定数を許す｡以下の手順に従う｡
第1分解 expr : sum_{i=1}^iend v1_Lon3f[i]*v1_Lon3coef[i] = v1_outf
第2分解 v1_Lon3coef[i] : sum_{j=1}^jend v2_Lon3f[j]*v2_Lon3coef[j] = v2_outf
第3分解 v2_Lon3coef[j] : sum_{k=1}^kend v3_Lon3f[k]*v3_Lon3coef[k] = v3_outf
文法: on3decompm(expr, ’varsL=[x,y], 'assume=[...])
例示:
ex11 : f1(x)*on3(x,1,5,co) + f2(x)*on3(x,3,7,co),
on3decompm(ex11,'vars=[x]);
---> f1(x)*on3(x,1,3,co) + (f1(x)+f2(x))*on3(x,3,5,co) + f2(x)*on3(x,5,7,co)
ex12 : f1(x)*on3(x,1,5,co) + f2(x)*on3(x,a,b,co), /* 1--a--5--b */
assw1 : [1<a,a<5,5<b], /* 仮定の設定 */
on3decompm(ex12,'vars=[x], 'assume=assw1);
---> f1(x)*on3(x,1,a,co) + (f1(x)+f2(x))*on3(x,a,5,co) + f2(x)*on3(x,5,b,co),
ex22 : f2(x,y)*on3(x,3,7,co)*on3(y,b,d,co)
+ f1(x,y)*on3(x,1,5,co)*on3(y,2,6,co), /* --2--b--6--d-- */
assw2 : [2<b, b<6, 6<d], /* 仮定の設定 */
on3decompm(ex22,'vars=[x,y], 'assume=assw2),
---> on3(x,3,5,co)*((f1(x,y)+f2(x,y))*on3(y,b,6,co)+f2(x,y)*on3(y,6,d,co)
+f1(x,y)*on3(y,2,b,co))
+on3(x,5,7,co)*f2(x,y)*on3(y,b,d,co)
+on3(x,1,3,co)*f1(x,y)*on3(y,2,6,co),
--end of on3decompm('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3decompm('ex)--"),
block([progn:"<on3decompm('ex)>",
expr11, ans11, expr12, assw1, ans12, expr21, ans21, expr22, assw2, ans22, expr31, ans31,
ex_no, expr, ans, assw, exsL, varsL, outx, outL, out1,out2,out3, cmds ],
/* 1 変数 */
expr11 : f1(x)*on3(x,1,5,co) + f2(x)*on3(x,3,7,co),
ans11 : f1(x)*on3(x,1,3,co) + (f1(x)+f2(x))*on3(x,3,5,co) + f2(x)*on3(x,5,7,co),
expr12 : f1(x)*on3(x,1,5,co) + f2(x)*on3(x,a,b,co), /* 1--a--5--b */
assw1 : [1<a,a<5,5<b], /* 仮定の設定 */
ans12 : f1(x)*on3(x,1,a,co) + (f1(x)+f2(x))*on3(x,a,5,co) + f2(x)*on3(x,5,b,co),
/* 2変数 */
expr21 : f2(x,y)*on3(x,3,7,co)*on3(y,4,8,co)
+ f1(x,y)*on3(x,1,5,co)*on3(y,2,6,co),
ans21 : on3(x,3,5,co)*(f2(x,y)*on3(y,6,8,co)+(f1(x,y)+f2(x,y))*on3(y,4,6,co)
+f1(x,y)*on3(y,2,4,co))
+on3(x,5,7,co)*f2(x,y)*on3(y,4,8,co)
+on3(x,1,3,co)*f1(x,y)*on3(y,2,6,co),
expr22 : f2(x,y)*on3(x,3,7,co)*on3(y,b,d,co)
+ f1(x,y)*on3(x,1,5,co)*on3(y,2,6,co), /* --2--b--6--d-- */
assw2 : [2<b, b<6, 6<d], /* 仮定の設定 */
ans22 : on3(x,3,5,co)*((f1(x,y)+f2(x,y))*on3(y,b,6,co)+f2(x,y)*on3(y,6,d,co)
+f1(x,y)*on3(y,2,b,co))
+on3(x,5,7,co)*f2(x,y)*on3(y,b,d,co)
+on3(x,1,3,co)*f1(x,y)*on3(y,2,6,co),
/* 3変数 */
expr31 : f2*on3(x,3,7,co)*on3(y,4,8,co)*on3(z,0,10,co)
+ f1*on3(x,1,5,co)*on3(y,2,6,co)*on3(z,5,10,co),
ans31 : on3(x,1,3,co) * ( on3(y,2,6,co) * on3(z,5,10,co)*f1 )
+ on3(x,3,5,co) * ( on3(y,2,4,co) * on3(z,5,10,co)*f1
+ on3(y,4,6,co) * ( on3(z,0,5,co)*f2 + on3(z,5,10,co)*(f1+f2) )
+ on3(y,6,8,co) * on3(z,0,10,co)*f2 )
+ on3(x,5,7,co) * on3(y,4,8,co) * on3(z,0,10,co)*f2 ,
/*---手計算: 前進型逐次分解 ------------------------------------------------------------------
expr31 = f2*on3(x,3,7,co)*on3(y,4,8,co)*on3(z,0,10,co)
+ f1*on3(x,1,5,co)*on3(y,2,6,co)*on3(z,5,10,co),
= on3(x,1,5,co) * { on3(y,2,6,co)*on3(z,5,10,co)*f1 }
+ on3(x,3,7,co) * {on3(y,4,8,co)*on3(z,0,10,co)*f2}
= on3(x,1,3,co) * { on3(y,2,6,co)*on3(z,5,10,co)*f1 }
+ on3(x,3,5,co) * { on3(y,2,6,co)*on3(z,5,10,co)*f1 + on3(y,4,8,co)*on3(z,0,10,co)*f2 } #1
+ on3(x,5,7,co) * {on3(y,4,8,co)*on3(z,0,10,co)*f2}
#1 { on3(y,2,6,co)*on3(z,5,10,co)*f1 + on3(y,4,8,co)*on3(z,0,10,co)*f2 }
= on3(y,2,4,co) * on3(z,5,10,co)*f1
+ on3(y,4,6,co) * { on3(z,5,10,co)*f1 + on3(z,0,10,co)*f2 } #2
+ on3(y,6,8,co) * on3(z,0,10,co)*f2
= on3(x,1,3,co) * { on3(y,2,6,co) * on3(z,5,10,co)*f1 }
+ on3(x,3,5,co) * { on3(y,2,4,co) * on3(z,5,10,co)*f1
+ on3(y,4,6,co) * {on3(z,5,10,co)*f1 + on3(z,0,10,co)*f2 } #2
+ on3(y,6,8,co) * on3(z,0,10,co)*f2 }
+ on3(x,5,7,co) * { on3(y,4,8,co) * on3(z,0,10,co)*f2}
#2 { on3(z,5,10,co)*f1 + on3(z,0,10,co)*f2 }
= on3(z,0,5,co) * f2 + on3(z,5,10,co) * (f1+f2)
= on3(x,1,3,co) * { on3(y,2,6,co) * on3(z,5,10,co)*f1 }
+ on3(x,3,5,co) * { on3(y,2,4,co) * on3(z,5,10,co)*f1
+ on3(y,4,6,co) * { on3(z,0,5,co)*f2 + on3(z,5,10,co)*(f1+f2) }
+ on3(y,6,8,co) * on3(z,0,10,co)*f2 }
+ on3(x,5,7,co) * { on3(y,4,8,co) * on3(z,0,10,co)*f2 }
-----------------------------------------------------------------------------------------*/
/* c0show(assw), c0show(ecsort([2,6,b,d])), var_fact([b,d]), c0show(is(6>b), is(b<d)), */
exsL : [[expr11,[x],ans11],[expr12,[x],ans12,assw1],
[expr21,[x,y],ans21],[expr22,[x,y],ans22,assw2],
[expr31,[x,y,z],ans31]],
ex_no : 0,
for exL in exsL do (
c2show(var_fact([a,b,c,d])),
fact_forget([a,b,c,d]),
c2show(exL),
expr : exL[1], varsL : exL[2], ans : exL[3], assw : if length(exL) >3 then exL[4] else [],
if length(assw) # 0 then ass_set(assw), /* 仮定の設定 */
ex_no : ex_no + 1,
cmds : sconcat("( ",
"/* 例.",ex_no," on3decompm() の結果 */ @",
" c0show(expr, varsL, assw), @",
" out : on3decompm(expr,'vars=varsL, 'assume=assw, debug) @",
" )"),
chk1show(cmds,ans)
),
killvars(["x_"]),
return("-- end of on3decompm_ex --")
), /* end of block */
print("--end of on3decompm('ex)--"),
return("--end of on3decompm('ex)--"),
block_main, /* main ブロック ====================================*/
c1show(progn, "--- enter -------"),
if listp(args[1])=true then (v1_Lon3f:args[1], v1_Lon3coef : args[2], v2 : args[3]),
if listp(args[1])=false then (
expr : args[1], /* on3式 の指定 */
c1show(progn,expr),
kno_a : find_key_no(args,'assume), /* 設定する仮定のリスト */
assw : if (kno_a # 0) then rhs(args[kno_a])
else if length(args) > 2 then args[3] else [],
c1show(progn,assw),
kno_v : find_key_no(args,'vars), /* on3変数リストの指定 */
varsL : if kno_v # 0 then rhs(args[kno_v])
else if (length(args) > 1) then [args[2]]
else listofvars(expr),
if (kno_a # 0) and (kno_v = 0) then ( /* 仮定あり, 変数リスト無指定のとき */
varsL : listofvars(expr),
chk(e) := if not member(e, listofvars(assw)) then true,
varsL : sublist(varsL, chk)
),
c1show(progn,varsL),
/*===================================================
第1分解 expr : sum_{i=1}^iend v1_Lon3f[i]*v1_Lon3coef[i] = v1_outf
第2分解 v1_Lon3coef[i] : sum_{j=1}^jend v2_Lon3f[j]*v2_Lon3coef[j] = v2_outf
第3分解 v2_Lon3coef[j] : sum_{k=1}^kend v3_Lon3f[k]*v3_Lon3coef[k] = v3_outf
=========================================================*/
out1 : on3decomp21(expr,varsL[1], assw, debug), /* 仮定, 第1変数に関する排他的区間分解 */
c2show(progn,out1),
if length(varsL) <= 1 then return(out1),
outL : on3info(out1,varsL[1]),
c2show(outL),
outLev(outL,"v1_"),
c1show(progn,v1_Lon3f,v1_Lon3coef), /* 第1変数に関する on3 係数関数リスト */
v2 : varsL[2], /* 第2変数の指定 */
c2show(v2)
), /* 第1引数に on3 関数式を与えた場合の処理 */
expandv2 : if (length(varsL) > 1) and (length(v1_Lon3coef) > 1) then true else false,
c2show(expandv2),
if expandv2 then (
c1show(progn,expandv2,length(v1_Lon3coef),varsL[2],assw),
sum_i : 0,
for i:1 thru length(v1_Lon3coef) do (
out2 : on3decomp21(v1_Lon3coef[i], varsL[2], assw, debug), /* 第2分解 */
outL : on3info(out2, varsL[2]), outLev(outL,"v2_"),
c1show(i,v1_Lon3coef[i],v2_Lon3,v2_Lon3coef,v2_outf),
expandv3 : if (length(varsL) > 2) and (length(v2_Lon3coef) > 1) then true else false,
c1show(expandv3,length(v2_Lon3coef),varsL,assw),
if expandv3 then (
sum_j : 0,
for j:1 thru length(v2_Lon3coef) do (
out3 : on3decomp21(v2_Lon3coef[j], varsL[3], assw, debug), /* 第3分解 */
outL : on3info(out3, varsL[3]), outLev(outL,"v3_"),
v2_Lon3coef[j] : v3_outf, /* 重要 v2_Lon3coef[j] の更新 */
c1show(i,j,v3_outf), /* v3_outf : out3, */
sum_j : sum_j + v2_Lon3f[j] * v2_Lon3coef[j]
) /* end of for-j */
) /* end of expadv3=true */
else sum_j : v2_outf, /* v2_Lon3coef[j] の非更新結果を使う */
v1_Lon3coef[i] : sum_j, /* 重要 v1_Lon3coef[i] の更新 */
sum_i : sum_i + v1_Lon3f[i] * v1_Lon3coef[i]
), /* end of for-i */
v1_outf : sum_i /* v1_outf の更新 */
), /* end of expandv2=true */
c1show(progn,v1_outf),
out : v1_outf,
ass_forget([a,b,c,d]), killvars(["v1_","v2_","v3_"]),
return(out)
)$ /* end of on3decompm */
/*############################################################################*/
/*### on3decomp21 #########2021.02.11 ###*/
/* 指定変数Varに関するon3(var,,,,)関数式の排他的区分分解を試みる */
/*############################################################################*/
on3decomp21([args]) := block([progn:"<on3decomp21>",debug,on3func,var,ass0,
wL,assadd,wdenom,wnumer,psing,Lsing,outL,non3_denom,non3_numer,
nundef_denom,nundef_numer,Ln,Ld,Lnd,sortL,wn_coef,wd_coef,wn_expr,wd_expr,w_expr,
out,xm,xl,xr,lr,evdL,evL,
ex,ex1,ex2,L,cms,ans,ansd,f20,fy,fyx],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3decomp21('help)--
機能: 指定変数varに関するon3(var,,,,)関数式の排他的区分分解を変数var毎に試みる
on3有理式,未定端点に対応する, 特異点(分母が零になる点), 特異区間に対応
比較 : on3decomp()は未定端点無しの場合に多変数領域の排他的領域分解を与える
文法: on3decomp21(on3func,var,...)
例示:
on3decomp21(1/(x-3),x) -> 1/(x-3)*on3(x,minf,3,oo) + 1/(x-3)*on3(x,3,inf,oo) (特異点)
ex : f0 + f1*on3(x,a,b,co),
on3decomp21(ex,x),
-> f0*on3(x,minf,a,oo) + (f0+f1)*on3(x,a,b,co) + f0*on3(x,b,inf,co)
on3decomp21(1/(f0 + f1*on3(x,1,3,co)), x),
-> 1/f0*on3(x,minf,1,oo) + 1/(f0+f1)*on3(x,1,3,co) + 1/f0*on3(x,3,inf,co)
on3decomp21(1/(f0 + f1*on3(x,a,b,co)), x),
-> 1/f0*on3(x,minf,a,oo) + 1/(f0+f1)*on3(x,a,b,co) + 1/f0*on3(x,b,inf,co)
--end of on3decomp21('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3decomp21('ex)--"),
/* on3decomp21_ex(), */
block([progn:"<on3decomp21('ex)>",debug,a,b,c,d,f0,f1,f3,ass0,ex1,ex2,ex3,ex,x,out],
debug: ifargd(),
cmds : sconcat("(",
"/* 例1, on3多項式(未定端点を含む) 明示仮定 */ @",
" ex : f0 + f1*on3(x,a,b,co), @",
" out : on3decomp21(ex,x,[a<b],debug0)",
")"),
ans : f0*on3(x,minf,a,oo) + (f0+f1)*on3(x,a,b,co) + f0*on3(x,b,inf,co),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例2 on3多項式(係数部にxの関数), 未定端点, 明示仮定 ---a---c---b---d--- */ @",
"ex3 : f0(x) + f1(x)*on3(x,a,b,co) + f2(x)*on3(x,c,d,co),@",
"out : on3decomp21(1/ex3,x,[a<c,c<b,b<d],debug0)",
")"),
ans : on3(x,d,inf,co)/f0(x)+on3(x,c,b,co)/(f2(x)+f1(x)+f0(x))
+on3(x,b,d,co)/(f2(x)+f0(x))
+on3(x,a,c,co)/(f1(x)+f0(x))+on3(x,minf,a,oo)/f0(x),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例3 on3多項式,未定端点を含む, 明示仮定 ---1---a---2---b---3---4--- */ @",
"ex : f1*on3(x,1,3,co) + f2*on3(x,2,4,co) + f3*on3(x,a,b,co), @",
"out : on3decomp21(ex,x,[1<a, a<2, 2<b, b<3],debug0)",
")"),
ans : (f2+f1)*on3(x,b,3,co)+(f3+f1)*on3(x,a,2,co)+f2*on3(x,3,4,co)
+(f3+f2+f1)*on3(x,2,b,co)+f1*on3(x,1,a,co),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例4-1. on3有理式:分母が0となる区間が存在しない場合, 未定端点なし */ @",
" ex : f0*on3(x,2,6,co)/(f1*on3(x,1,5,co) + f2*on3(x,3,7,co)), @",
" out : on3decomp21(ex,x,debug0)",
")"),
ans : (f0*on3(x,5,6,co))/f2 + (f0*on3(x,3,5,co))/(f2+f1) + (f0*on3(x,2,3,co))/f1,
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例4-2. on3有理式:分母が0となる区間が存在する場合の対応, 未定端点なし */ @",
" ex : f0*on3(x,0,8,co)/(f1*on3(x,1,5,co) + f2*on3(x,3,7,co)), @",
" out : on3decomp21(ex,x,debug0)",
")"),
ansd : None*on3(x,7,8,oo) + (f0*on3(x,5,7,co))/f2 + (f0*on3(x,3,5,co))/(f2+f1)
+ (f0*on3(x,1,3,co))/f1 + None*on3(x,0,1,oo),
ans : (f0*on3(x,5,7,co))/f2 + (f0*on3(x,3,5,co))/(f2+f1)
+ (f0*on3(x,1,3,co))/f1,
cashow("注:特異区間を明示した解",ansd),
cashow(" --> ev(ansd,None=0) で特異区間項(None*で始まる項)を除いた表現を得る"),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例5-1 on3有理式:分母が0となる区間が存在しない場合 */ @",
"/* 未定端点を含む, 明示仮定 ---a---1---c---b---5---d--- */ @",
"ex : (f2*on3(x,1,5,co)+f3*on3(x,c,d,co))/(f0 + f1*on3(x,a,b,co)), @",
"out : on3decomp21(ex,x,[a<1,1<c,c<b,b<5,5<d],debug0)",
")"),
ans : ((f3+f2)*on3(x,c,b,co))/(f1+f0)+((f3+f2)*on3(x,b,5,co))/f0
+(f3*on3(x,5,d,co))/f0+(f2*on3(x,1,c,co))/(f1+f0),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例5-2 on3有理式:分母が0となる区間が存在する場合の対応, */ @",
"/* 未定端点を含む, 明示仮定 ---a---c---b---d--- */ @",
"ex : f0/(f1*on3(x,a,b,co) + f2*on3(x,c,d,co)), @",
"out : on3decomp21(ex,x,[a<c,c<b,b<d],debug0)",
")"),
ansd : None*on3(x,d,inf,oo)+(f0*on3(x,c,b,co))/(f2+f1)+(f0*on3(x,b,d,co))/f2
+(f0*on3(x,a,c,co))/f1+None*on3(x,minf,a,oo),
ans : (f0*on3(x,c,b,co))/(f2+f1)+(f0*on3(x,b,d,co))/f2
+(f0*on3(x,a,c,co))/f1,
chk2show(cmds,ans),
cashow("特異区間項(None*で始まる項)を含めた結果",ansd),
cashow(" --> ev(ansd,None=0) で特異区間項(None*で始まる項)を除いた表現を得る"),
cmds : sconcat("(",
"/* 例5-3 on3有理式:分母が0となる区間が存在する場合の対応, */ @",
"/* 未定端点を含む, 特異点[e,c], 明示仮定 ---a--(e)--(c)---b---d--- */ @",
"f0 : 1/((x-e)*(x-c)), @",
"ex : f0/(on3(x,a,b,co) + on3(x,c,d,co)), @",
"out : on3decomp21(ex,x,[a<e,e<c,c<b,b<d],debug0)",
")"),
ans : on3(x,e,c,oo)/((x-c)*(x-e)) + on3(x,c,b,oo)/(2*(x-c)*(x-e))
+ on3(x,b,d,co)/((x-c)*(x-e)) + on3(x,a,e,co)/((x-c)*(x-e)),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例6-1. 2変量関数を変数 y で分解 */ @",
"f20 : f1(x,y)*on3(x,1,8,co)*on3(y,minf,3,oo) + f2(x,y)*on3(y,2,5,cc), @",
"fy : on3decomp21(f20,y,debug0)",
")"),
ans : on3(x,1,8,co)*f1(x,y)*on3(y,minf,2,oo)+f2(x,y)*on3(y,3,5,cc)
+(f2(x,y)+on3(x,1,8,co)*f1(x,y))*on3(y,2,3,co),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例6-2. 2変量関数を変数 x で分解 */ @",
" fy : ratexpand(fy), fyx : on3decomp21(fy,x,debug0),",
" c0show(ev(fy,y = 2)), fyx",
")"),
ans : on3(x,1,8,co)*
(f1(x,y)*on3(y,minf,2,oo)+f2(x,y)*on3(y,3,5,cc)
+f2(x,y)*on3(y,2,3,co)+f1(x,y)*on3(y,2,3,co))
+on3(x,minf,1,oo)*(f2(x,y)*on3(y,3,5,cc)+f2(x,y)*on3(y,2,3,co))
+on3(x,8,inf,co)*(f2(x,y)*on3(y,3,5,cc)+f2(x,y)*on3(y,2,3,co)),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例7-1 on3多項式 + on3有理式 の排他的分解-1(共通分母), */ @",
"ex : on3(x,1,5,co) + on3(x,1,5,co)/(on3(x,1,3,co)+on3(x,2,4,co)), @",
"out : on3decomp21(ex,x,debug0)",
")"),
ans : 2*on3(x,3,4,co)+(3*on3(x,2,3,co))/2+2*on3(x,1,2,co),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例7-2 on3多項式 + on3有理式 の排他的分解-2(有理式部分の分解), */ @",
"ex : on3decomp21(on3(x,1,5,co)/(on3(x,1,3,co)+on3(x,2,4,co)),x) , @",
"cashow(ex), @",
"out : on3decomp21(on3(x,1,5,co) + ex, x,debug0)",
")"),
ans : on3(x,4,5,co)+2*on3(x,3,4,co)+(3*on3(x,2,3,co))/2+2*on3(x,1,2,co),
chk2show(cmds,ans),
return("-- end of on3decomp21_ex --")
), /* end of block */
print("--end of on3decomp21('ex)--"),
return("--end of on3decomp21('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1],
on3func : ratexpand(on3func),
/*** on3 有理式の'std : 暫定的対応 2021.02.16 ***/
if (on3typep(on3func)='on3polyinv) and member('std,args) then (
on3func : on3info(ratnumer(on3func),ev(var),'std)
/ on3info(ratdenom(on3func),ev(var),'std)
),
if length(args) < 2 then var : listofvars(on3func)[1] else var : args[2],
if on3_same_var(on3func,var) > 1 then (
on3func : on3simp(on3func,ev(var)),
c1show(progn,on3func),
if on3_same_var(on3func,var) > 1 then (
c0show(progn," ERROR: 同一変数のon3関数の積を検出した"),
return("Error in on3info")
)
),
c1show(progn,on3typep(on3func)),
if length(args)>1 and atom(args[2]) then var:args[2],
if length(args)>2 and listp(args[3]) then ass0 : args[3] else ass0 :[],
/* 仮定の設定と仮定履歴の記録 ass_hist : グローバル変数 */
if (length(args)>=3) and listp(ass0) then (
wL : apply('assume, ass0),
wL : delete('redandunt, wL), ass_hist : append(ass_hist,wL)
),
c1show(progn,"初期仮定",ass0),
c2show(progn,"◆ ",on3func,"◆"),
c2show(on3typep(on3func), on3vars(on3func), listofvars(on3func)),
if (length(args)=1) and (length(on3vars(on3func))=0) /* 非on3関数 */
then return(ratsimp(on3func))
else if (length(args)=1) and (length(on3vars(on3func))=1) /* 1変数on3関数で変数省略 */
then var : on3vars(on3func)[1]
else if (length(args) > 1) and member(args[2],listofvars(on3func))
then var : args[2] /* 2変数on3関数,変数指定 */
else (c0show(" ◆◆◆ Error in ",progn),return(ratsimp(on3func))),
c2show(var),
/* on3func を分子,分母に分け,分母に変数varに関する関数on3(var,...)が含まれているかを検査する */
wdenom : ratdenom(on3func), c1show(wdenom), wdenom : on3info(wdenom,var,'std),
c1show(progn,wdenom),
wnumer : ratnumer(on3func), c1show(wnumer), wnumer : on3info(wnumer,var,'std),
if on3typep(wnumer)='on3none then wnumer : wnumer*on3(var,minf,inf,oo),
if on3typep(wdenom)='on3none then wdenom : wdenom*on3(var,minf,inf,oo),
wnumer : ratdisrep(wnumer), wdenom : ratdisrep(wdenom),
c2show(progn,wdenom),
c2show(progn,wnumer),
/* 分母のon3info */
outL : on3info(wdenom,var), /* call on3info() */
c1show(progn,"分母",outL),
outLev(outL,"denom_"), /* 名前付きリストからその内容リストを生成する */
c3show(progn,values),
c3show(denom_undefpnts),
/* 分子のon3info() */
outL : on3info(wnumer,var),
c1show(progn,"分子",outL),
c2show(progn,"分子",outL),
outLev(outL,"numer_"),
c3show(numer_undefpnts),
/* non3_denom, non3_numer : 変数var に関する on3(var,...)の個数 */
/* nundef_denom, nundef_numer : 変数var に関するon3関するの未定な端点の個数 */
non3_denom : length(denom_Lon3), nundef_denom : length(denom_undefpnts),
non3_numer : length(numer_Lon3), nundef_numer : length(numer_undefpnts),
c2show(progn,"分母: ",non3_denom,nundef_denom),
c2show(progn,"分子: ",non3_numer,nundef_numer),
c2show(progn,"分母: ",wdenom),
c2show(progn,"分子: ",wnumer),
/* on3係数関数の簡約化 */
denom_Lon3coef : map('factor, denom_Lon3coef),
numer_Lon3coef : map('factor, numer_Lon3coef),
/* 分母のon3係数関数 denom_Lon3coef の零点(特異点)を求める */
c1show(denom_Lon3coef),
psing : [], Lsing : [],
for i:1 thru length(denom_Lon3) do (
c2show(ev(var),denom_Lon3coef[i]),
if freeof(ev(var),denom_Lon3coef[i])=false
then out : solve([denom_Lon3coef[i]=0],[ev(var)])
else out : [],
if length(out) > 0 then
for j:1 thru length(out) do (
if lhs(out[j])=ev(var) then psing : endcons(rhs(out[j]), psing)
),
c2show(psing)
),
psing : unique(psing),
c1show("特異点(分母の零点): ",psing),
/* 分子,分母の端点リスト,特異点の合併 : Lnd */
Ln : numer_Lon3lr0, Ld : denom_Lon3lr0,
Lnd : unique(append(Ln,Ld,psing)), c1show(Ln,Ld,Lnd),
/* add begin======================================================*/
if errcatch( sortL:sort(Lnd,"<"), return ) = [] then
cashow(progn," ◆ 端点ソートエラー: errcatch in sort(Lnd,\"<\") ")
else c1show("---No errcatch in sort(Lnd,\"<\")",sortL),
c1show(progn,"端点リストのソート結果",sortL),
/* 中間点に関する仮定の追加 */
assadd : [],
for i:1 thru length(sortL)-1 do (
xm : (sortL[i] + sortL[i+1])/2,
if numberp(xm)=false then (
for j:1 thru i do
if is(xm < sortL[j])=unknown then assadd:endcons(xm>sortL[j], assadd),
for j:i+1 thru length(sortL) do
if is(xm < sortL[j])=unknown then assadd:endcons(xm<sortL[j], assadd)
) /* end of if */
), /* end of for i */
if length(assadd)>0 then (
wL : apply('assume, assadd), wL : delete('redundant, wL),
ass_hist : append(ass_hist,wL)
),
c1show(progn,"中間点に関する仮定",assadd), c2show(facts()),
c1show(denom_Lon3coef),
/* on3関数式の排他的分解形の生成 2021.02.09 */
wd_coef : [], /* 係数リスト denom_Lon3coef の名詞形リスト wd_coef を作成 */
for i:1 thru length(denom_Lon3) do wd_coef : endcons('denom_Lon3coef[i],wd_coef),
/* 名詞形を作成 */
c1show(progn,"分子:係数リストの名詞形",wd_coef),
wn_coef : [], /* 係数リスト numer_Lon3coef の名詞形リスト wn_coef を作成 */
for i:1 thru length(numer_Lon3) do wn_coef : endcons('numer_Lon3coef[i],wn_coef),
/* 名詞形を作成 */
c1show(progn,"分子:係数リストの名詞形",wn_coef),
wd_expr : 0,
for i:1 thru length(wd_coef) do wd_expr : wd_expr + wd_coef[i]*denom_Lon3f[i],
c1show(progn,"分母:名詞形関数",wd_expr),
wn_expr : 0,
for i:1 thru length(wn_coef) do wn_expr : wn_expr + wn_coef[i]*numer_Lon3f[i],
c1show(progn,"分子:名詞形関数",wn_expr),
/*** 簡約化1：on3(z,minf,inf,oo) ---> 1 2021.02.14 ***/
w_expr : wn_expr/wd_expr, w_expr : letsimp(w_expr,on3rule1),
c1show(w_expr), /* [on3係数関数の名詞形] =〔分子/分母〕の名詞形関数 */
/* 端点リスト(特異点を含む)の中間点での係数関数(名詞形)を生成する */
out : 0,
for i:1 thru length(sortL)-1 do (
xl : sortL[i], xr : sortL[i+1], xm : (xl+xr)/2,
/* on3(atom,minf,inf,oo)=1 とする処理が必要 -> letsimp(expr, on3rule1) 2021.02.14 */
/* xl,xm,xr で分母 wd_expr が 0 になるケースを回避する */
evdL : [ev(wd_expr,ev(var)=xl), ev(wd_expr,ev(var)=xm), ev(wd_expr,ev(var)=xr)],
evdL : letsimp(evdL,on3rule1),
evL : [0, 0, 0],
evL[1] : if evdL[1] = 0 then 'none else ev(w_expr,ev(var)=xl),
evL[2] : if evdL[2] = 0 then 'None else ev(w_expr,ev(var)=xm), /* 特異区間 */
evL[3] : if evdL[3] = 0 then 'none else ev(w_expr,ev(var)=xr),
evL : letsimp(evL,on3rule1),
if (evL[2]=evL[1]) and (evL[2]=evL[3]) then lr:cc
else if (evL[2]=evL[1]) and (evL[2]#evL[3]) then lr:co
else if (evL[2]#evL[1]) and (evL[2]=evL[3]) then lr:oc
else if (evL[2]#evL[1]) and (evL[2]#evL[3]) then lr:oo
else lr:'unknown,
/* 特異区間を記録する */
if evL[2] = 'None then Lsing : endcons(funmake(on3,[ev(var),xl,xr,lr]),Lsing),
/* 特異点を区間から避ける */
if member(xl,psing) then (if lr=cc then lr:oc, if lr=co then lr:oo),
if member(xr,psing) then (if lr=cc then lr:co, if lr=oc then lr:oo),
c2show(progn,i,[xl,xm,xr],evL,lr),
/* 中間点評価に基づく結果の排他的区分分解表現を生成する */
out : out + ev(evL[2],nouns) * funmake(on3,[ev(var),xl,xr,lr])
), /* end oof for-i */
c1show(progn),c1show("特異区間(分母が零になる区間)表示: ",out),
c1show("特異点,特異区間",psing,Lsing),
killvars(["denom_","numer_"]), forget(ass0,assadd), c2show(facts()),
c2show(values),
out : ev(out,None=0), /* 特異区間表示:Noneを無くす */
return(out)
)$ /*end of on3decomp21() */
/* ########################################################################## */
/* ### ecsort() : errcatch 付きソート関数 ##################################### */
ecsort([args]) := block([progn:"<ecsort>",debug,L,sortL],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of ecsort('help)--
機能: 未定定数を含むリストのソートをエラー停止無しに実行する
文法: ecsort(List)
例示:
ecsort([1,3,2,4]); -> [1,2,3,4]
ecsort([1,3,a,b]); -> ◆ ソートエラー: errcatch in sort(L,<)
(assume(1<a, a<3, 3<b),ecsort([1,3,a,b])); -> [1,a,3,b]
--end of ecsort('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of ecsort('ex)--"),
block([assL,a,b,out,cmds],
cmds : sconcat("(",
"/* 例1 ソート結果(正常) */ @",
"out : ecsort([1,3,2,4]), out @",
")"
),
chk2show(cmds,[1,2,3,4]),
cmds : sconcat("(",
"/* 例2 ソートエラーとその回避 */ @",
"out : ecsort([1,3,a,b]), out @",
")"
),
chk2show(cmds,""),
cmds : sconcat("(",
"/* 例3 仮定の設定,ソート,仮定の解除 */ @",
"assL : [1<a, a<3, 3<b], apply('assume, assL), @",
"out : ecsort([1,3,a,b]), forget(assL), out @",
")"
),
chk2show(cmds,[1,a,3,b])
), /* end of block*/
print("--end of ecsort('ex)--"),
return("--end of ecsort('ex)--"),
block_main, /* main ブロック ====================================*/
L : args[1],
c1show(progn,L),
if errcatch( sortL:sort(L,"<"), return ) = [] then
cashow(progn," ◆ ソートエラー: errcatch in sort(L,\"<\") ")
else c1show("---No error in sort(L,\"<\")",sortL),
c1show(progn,"ソート結果",sortL),
return(sortL)
)$ /* end of ecsort() */
/*############################################################################*/
/*### killvars #########2020.03.11 ###*/
/* values; で表示される変数リストからkeysで指定された変数を(一括)削除する */
/*############################################################################*/
killvars([args]):=block([progn:"<killvars>",debug,keys,key,str,svL],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of killvars('help)--
機能: values; で表示される変数リストからkeysで指定された変数を(一括)削除する
文法: killvars([\"denom_\",\"numer_\",\"w_\",\"out_\"],...)
例示:
values;
killvars([\"denom_\",\"numer_\",\"w_\",\"out_\"]);
values;
--end of killvars('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of killvars('ex)--"),
block([progn:"<killvars('ex)>",debug],
debug: ifargd(),
c0show("現在の変数リスト:",values),
c0show(killvars(["denom_","numer_","w_","out_"])),
c0show("上記処理後の変数リスト:",values),
return("-- end of killvars_ex --")
), /* end of block */
print("--end of killvars('ex)--"),
return("--end of killvars('ex)--"),
block_main, /* main ブロック ====================================*/
if listp(args[1])=false then keys:[args[1]] else keys:args[1],
svL : [], /* keys:["denom_","numer_","w_","out_"], */
for i:1 thru length(keys) do (
key : keys[i],
for j:1 thru length(values) do (
if ssearch(key,string(values[j])) > 0 then svL:endcons(string(values[j]),svL)
),
c1show(svL),
for j:1 thru length(svL) do (
str : sconcat("kill(",svL[j],")"), eval_string(str)
)
),
c1show(progn,"after",values),
return(values)
)$ /* end of killvars() */
/*#####################################################################*/
/* on3decomp : on3一般式の排他的分解処理全般 2019.10.20 */
/*#####################################################################*/
on3decomp([args]) := block([progn:"<on3decomp>",debug,nonum,exp0,
Lw:[],LR:[],wone,ww,w:[],wl:[],fone,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3decomp('help)--
機能: on3一般式の排他的分解処理全般
文法: on3decomp(expr,...)
例示: on3decomp(on3(x,1,2,co)+f0) =
f0*on3(x,minf,1,oo)+f0*on3(x,2,inf,co)+(f0+1)*on3(x,1,2,co)
on3decomp(1/(on3(x,1,2,co)+f0)) =
on3(x,minf,1,oo)/f0+on3(x,2,inf,co)/f0+on3(x,1,2,co)/(f0+1)
--end of on3decomp('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3decomp('ex)--"),
block([progn:"<on3decomp('ex)>",Lex0,L,out],
on3ex(),
Lex0 : [ex14,1/ex14,ex18,ex19, ex1m7, ex1m8,
f1*on3(x,1,2,co),ex1a,ex1b,ex27],
if length(args) > 0 then (
if listp(args[1]) then L:copylist(args[1]) else L:[args[1]]
) else L : copylist(Lex0),
exansL :
[["on3(x,1,2,co)+f0",
"f0*on3(x,minf,1,oo)+f0*on3(x,2,inf,co)+(f0+1)*on3(x,1,2,co)"],
["1/(on3(x,1,2,co)+f0)",
"on3(x,minf,1,oo)/f0+on3(x,2,inf,co)/f0+on3(x,1,2,co)/(f0+1)", "on3show"],
["f1*on3(x,5,7,co)+f1*on3(x,3,5,co)",
"f1*on3(x,3,7,co)", "領域結合"],
["f2*on3(x,2,5,co)+f1*on3(x,1,3,co)+f3*on3(x,0,inf,co)",
sconcat("f3*on3(x,5,inf,co)+(f3+f2)*on3(x,3,5,co)+(f3+f2+f1)*on3(x,2,3,co)",
"+(f3+f1)*on3(x,1,2,co)+f3*on3(x,0,1,co)")],
["on3(x,3,10,co)/(f2*on3(x,2,8,co)+f1*on3(x,1,5,co))",
"on3(x,5,8,co)/f2+on3(x,3,5,co)/(f2+f1)", "on3show"],
["f2*on3(x,2,8,co)+f1*on3(x,1,5,co)",
"f2*on3(x,5,8,co)+(f2+f1)*on3(x,2,5,co)+f1*on3(x,1,2,co)"],
["1/(f2*on3(x,3,7,co)+f1*on3(x,1,5,co))+f0*on3(x,3,5,co)",
"on3(x,5,7,co)/f2+((f0*f2+f0*f1+1)*on3(x,3,5,co))/(f2+f1)+on3(x,1,3,co)/f1",
"on3show"],
["1/((f2*on3(x,3,7,co))/(f22*on3(x,3,5,co)+f21*on3(x,1,3,co))+f1*on3(x,1,5,co))+f0",
sconcat("f0*on3(x,minf,1,oo)+f0*on3(x,5,inf,co)",
"+((f0*f1*f22+f22+f0*f2)*on3(x,3,5,co))/(f1*f22+f2)",
"+((f0*f1+1)*on3(x,1,3,co))/f1"),
"on3show"],
["f0*on3(y,5,6,co)+f1*on3(x,1,2,co)*on3(y,3,4,co)",
sconcat("f0*on3(x,minf,1,oo)*on3(y,5,6,co)+f0*on3(x,1,inf,co)*on3(y,5,6,co)",
"+f1*on3(x,1,2,co)*on3(y,3,4,co)")]
],
print("== on3decomp_ex : 排他的領域分解 =="),
exchk("on3decomp",exansL,debug0),
/* start */
if false then (
cshow(L),
for ex in L do (
print("---<例 排他的領域分解>---"),
ldisplay(ex),
print("---> out:on3decomp(ex,show)"),
out:on3decomp(ex,show),
ldisplay(out)
)
),
return("--- end of on3decomp('ex) ---")
), /* end of block */
print("--end of on3decomp('ex)--"),
return("--end of on3decomp'ex)--"),
block_main, /* main ブロック ====================================*/
exp0 : args[1],
if numberp(exp0) then return(exp0),
if listp(expr) then Lw:copylist(exp0)
else Lw:f2l(ev(exp0,expand,infeval)),
d1show(Lw),
expr : l2f(Lw),
/*** [0] 本処理の適用可能性を調べる ***/
LR:on3lrl(expr), d2show(LR), /* call on3lrl */
for i thru length(LR[1]) do (
nonum:false,
for j:2 thru length(LR[2][i])-1 do
/* if not numberp(LR[2][i][j]) then nonum:true */
if not constantp(LR[2][i][j]) then nonum:true
),
if Lw[1]="+" and nonum then
( cshow("---> on3多項式で領域が未定のため無処理とする"),
if member(show,args) then on3show(expr),
return(expr)),
/*** [1] 不完全on3項の完全on3項化(多項式の整形) : f1*on3(x,xl,xr,lr) + ...
f0 -> f0*on3(x,minf,inf,oo),
f0*on3(y,2,3,co) -> f0*on3(x,minf,inf,oo)*on3(y,2,3,co) ***/
w:LR[1], /* on3変数の取得: call on3vars */
d1show("S1:不完全on3項の完全on3項化開始 "),
wone : 1, for i thru length(w) do wone:wone*on3(w[i],minf,inf,oo),
d1show("begin on3one",Lw,w,wone),
Lw:scanmap(lambda([u],
if listp(u) and u[1]="+" then (
d2show("start scanmap:",u),
for i:2 thru length(u) do (
/* call on3rule2 and l2f, f2l */
d2show(l2f(u[i])),
ww :l2f(u[i])*wone,
ww : letsimp(ww,on3rule2), /*** on3rule5 ではない!!***/
/* ww : ratsubst(on3,ON3,ww), */ ww : ON3on3(ww),
d1show("--letsimp(ww)-->",ww),
wl:partition(fone*ww,on3),
d2show(i,wl),
if listp(u[i]) and member("/",flatten(u[i])) then u[i]
else u[i]:["*",wl[1],f2l(wl[2])]
), /* end of for-i */
d2show("end of do",u), u ) else u), Lw), /* end of scanmap */
Lw : ev(Lw,fone=1,infeval),
d1show("S1:不完全on3項の完全on3項化の結果",l2f(Lw)),
/*** [2] 排他的区間処理(on3decomp_decomp)と
逆数処理(on3decomp_inv)の必要箇所をマーキング ***/
d2show("before attempt",Lw),
Lw:scanmap(lambda([u],
if listp(u) and (u[1]="+" or u[1]="-") and member(on3,flatten(u)) then (
u : ['('on3decomp_decomp),u], d2show(u), u
) else u), Lw, bottomup),
Lw:scanmap(lambda([u],
if listp(u) and u[1]="/" and member(on3,flatten(u[3])) then (
u : ["*", u[2], ['('on3decomp_inv), u[3]]]
) else u), Lw, bottomup),
d1show("S2:マーキングの結果",Lw,l2f(Lw)),
/*** [3] on3decomp_decomp と on3decomp_inv の評価 ***/
out : ev(l2f(Lw),fone=1,infeval),
out : on3ev(on3simp(out),factor), /* <------------------- */
d2show(out),
/*** 出力形式の指定 ***/
if member(show,args) then on3show(out),
if member(list,args) then return(f2l(out)) else return(out)
)$
/*--- on3decomp_ex -------------------------------------------- */
on3decomp_ex([args]) := block([progn:"<on3decomp_ex>",Lex0,L,out],
on3ex(),
Lex0 : [ex14,1/ex14,ex18,ex19, ex1m7, ex1m8,
f1*on3(x,1,2,co),ex1a,ex1b,ex27],
if length(args) > 0 then (
if listp(args[1]) then L:copylist(args[1]) else L:[args[1]]
) else L : copylist(Lex0),
exansL :
[["on3(x,1,2,co)+f0",
"f0*on3(x,minf,1,oo)+f0*on3(x,2,inf,co)+(f0+1)*on3(x,1,2,co)"],
["1/(on3(x,1,2,co)+f0)",
"on3(x,minf,1,oo)/f0+on3(x,2,inf,co)/f0+on3(x,1,2,co)/(f0+1)", "on3show"],
["f1*on3(x,5,7,co)+f1*on3(x,3,5,co)",
"f1*on3(x,3,7,co)", "領域結合"],
["f2*on3(x,2,5,co)+f1*on3(x,1,3,co)+f3*on3(x,0,inf,co)",
sconcat("f3*on3(x,5,inf,co)+(f3+f2)*on3(x,3,5,co)+(f3+f2+f1)*on3(x,2,3,co)",
"+(f3+f1)*on3(x,1,2,co)+f3*on3(x,0,1,co)")],
["on3(x,3,10,co)/(f2*on3(x,2,8,co)+f1*on3(x,1,5,co))",
"on3(x,5,8,co)/f2+on3(x,3,5,co)/(f2+f1)", "on3show"],
["f2*on3(x,2,8,co)+f1*on3(x,1,5,co)",
"f2*on3(x,5,8,co)+(f2+f1)*on3(x,2,5,co)+f1*on3(x,1,2,co)"],
["1/(f2*on3(x,3,7,co)+f1*on3(x,1,5,co))+f0*on3(x,3,5,co)",
"on3(x,5,7,co)/f2+((f0*f2+f0*f1+1)*on3(x,3,5,co))/(f2+f1)+on3(x,1,3,co)/f1",
"on3show"],
["1/((f2*on3(x,3,7,co))/(f22*on3(x,3,5,co)+f21*on3(x,1,3,co))+f1*on3(x,1,5,co))+f0",
sconcat("f0*on3(x,minf,1,oo)+f0*on3(x,5,inf,co)",
"+((f0*f1*f22+f22+f0*f2)*on3(x,3,5,co))/(f1*f22+f2)",
"+((f0*f1+1)*on3(x,1,3,co))/f1"),
"on3show"],
["f0*on3(y,5,6,co)+f1*on3(x,1,2,co)*on3(y,3,4,co)",
sconcat("f0*on3(x,minf,1,oo)*on3(y,5,6,co)+f0*on3(x,1,inf,co)*on3(y,5,6,co)",
"+f1*on3(x,1,2,co)*on3(y,3,4,co)")]
],
print("== on3decomp_ex : 排他的領域分解 =="),
exchk("on3decomp",exansL,debug0),
/* start */
if false then (
cshow(L),
for ex in L do (
print("---<例 排他的領域分解>---"),
ldisplay(ex),
print("---> out:on3decomp(ex,show)"),
out:on3decomp(ex,show),
ldisplay(out)
)
),
return("--- end of on3decomp_ex ---")
)$
/*--- fsplit: on3show.mx -----------------------------------------------*/
/*#####################################################################*/
/* <on3show>: on3関数式の表示 */
/*######################################################################*/
on3show([args]) ::= block([debug, funcs, u, out:[]],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3show('help)--
機能: on3関数式の表示
文法: on3show(funcs)
例示: display2d_old:display2d$ display2d:true$
on3show(on3decomp(f0+f1*on3(x,1,3,co)));
display2d:display2d_old$
on3show(''ex)$ <- 注意
--end of on3show('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3show('ex)--"),
on3show_ex(),
/*
block([],
return('normal_return)
), /* end of block */
*/
print("--end of on3show('ex)--"),
return("--end of on3show('ex)--"),
block_main, /* main ブロック ====================================*/
funcs : args[1],
out : append(out,[""]),
out : append(out,buildq([u:funcs],['u,"=",on3show_sub(u)])), /* on3show_sub */
/* display2d_old:display2d, display2d:true, */
buildq([u:out],print(splice(u)))
/* display2d:display2d_old */
)$ /* end of on3show() */
/*** 副関数 ***/
on3show_sub(funcs,[args]) := block([progn:"<on3show_sub>",debug,
won3:[],out:[],sum,lp:[],lpf,lpo,fone,won3i,
L:[],Lout:[],wi:[],wj:[],wjout,workh,M],
debug:ifargd(),
L:f2l(funcs), d1show(L),
/*** S1: 前処理 *************************************************/
if not listp(L) or not member(on3,flatten(L)) then return(funcs),
if listp(L) and L[1]="*" and listp(L[2]) and not member(on3,L[2])
and on3typep(L[3])=on3poly
then ( for i:2 thru length(L[3]) do L[3][i][2] : L[3][i][2]*L[2],
L : L[3], d2show(L), funcs : l2f(L) ),
if not L[1] = "+" then return(funcs),
/*** S2: 排他処理済みon3多項式の関数部の整理した結果を返す ***/
/*-----------------------------------------------------------
f0*on3(x,2,inf,co) + (f1+f0)*on3(x, 1, 2, co)
-> [[f1+f3,[[x,1,2,co]]], [f2, [[on3,x,3,4,co]]]]
f1*on3(x,1,3,co)*on3(y,2,6,co)+f2*on3(x,3,5,co)*on3(y,2,4,co)
-> [[f1,[[x,1,3,co],[y,2,6,co]]],[f2,[[x,3,5,co],[y,2,4,co]]]]
-----------------------------------------------------------------*/
won3:[], out:[],
for i:2 thru length(L) do (
won3 : cons(cons("*",partition(L[i],on3)[2]), won3) ),
won3:unique(won3),
d2show(won3,length(won3)),
out:["+"],
for i:1 thru length(won3) do (
sum :0, won3i : l2f(won3[i]),
for j:2 thru length(L) do (
lp : partition(fone*l2f(L[j]),on3),
lpf : ev(l2f(lp[1]),fone=1), lpo : l2f(lp[2]),
if lpo*won3i = lpo then sum : sum + lpf
), /* end of for j */
out : endcons(["*",sum,won3[i]],out),
d2show(i,out)
), /* end of for i */
d2show(out),
/* 演算子を削除 */
out:scanmap(lambda([u],if listp(u) then u:rest(u,1) else u), out),
/*** S3: 表示処理 *****************************************************/
L : copylist(out), Lout : copylist(out),
d2show(Lout),
for i thru length(L) do (
Lout[i][1] : L[i][1], wi:sconcat(""),
for j thru length(L[i][2]) do ( /* on変数に亘る繰り返し */
wj : L[i][2][j],
d2show(wj,wj[4]),
if wj[4]=cc then wjout:sconcat("(",wj[2]," <= ",wj[1]," <= ",wj[3],")")
else if wj[4]=co then wjout:sconcat("(",wj[2]," <= ",wj[1]," < ",wj[3],")")
else if wj[4]=oc then wjout:sconcat("(",wj[2]," < ",wj[1]," <= ",wj[3],")")
else if wj[4]=oo then wjout:sconcat("(",wj[2]," < ",wj[1]," < ",wj[3],")")
else wjout:"",
wi:sconcat(wi,wjout),
if j < length(L[i][2]) then wi:sconcat(wi," & "),
d2show(wi)
), /* end of for-j */
Lout[i][2] : sconcat(wi), d2show(Lout[i])
), /* end of for-i */
Lout : endcons([0, sconcat("( otherwise )")], Lout),
d2show(Lout),
workh[i,j] := Lout[i][j],
M : genmatrix(workh,length(Lout),2),kill(workh),
return(ev(M))
)$ /* end of on3show_sub() */
/*--- on3show_ex -------------------------------------------- */
on3show_ex([args]) := block([progn:"<on3show_ex>",ex,Lex0,L,out],
on3ex(),
Lex0 : [ex14,ex28,ex1c,ex1d],
if length(args) > 0 then (
if listp(args[1]) then L:copylist(args[1]) else L:[args[1]]
) else L : copylist(Lex0),
/* start */
display2d_old:display2d, display2d:true,
for ex in L do ( print("---<例 表示>---"),
ldisplay(ex),
print("---> out : on3show(on3decomp(ex))"),
out : on3show(on3decomp(ex))
),
print("--- another use by on3decomp(ex18,show) ---"),
on3decomp(ex18,show),
display2d:display2d_old,
return("--- end of on3show_ex ---")
)$ /* end of on3showex() */
/*### --- fsplit: on3diff.mx --- #######################################*/
/* <on3diff> : on3 関数の微分(多変数関数の1変数に関するp階偏微分) */
/*######################################################################*/
on3diff([args]) := block(
[progn:"<on3diff>",debug,expr,var,p, same,type,number,out,z,zl,zr,zlr,
exp0,func,dfunc,fL:[],dfL:[],fl,fr,dfl,dfr,vp,chk,
LR,T,on3v,fLT,dfLT,ft,dft,tl,tm,tr,ftl,ftm,ftr,wftl,wftm,wftr,fcontinue,
dftl,dftr,wdftl,wdtfl,wdftr,dfok,val,im,ip,err:false],
debug:ifargd(), /*** デバッグモードの判定 ***/
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3diff('help)--
機能: on3 関数の微分(多変数関数の1変数に関するp階偏微分)を求める
文法: on3diff(expr,var,p,...)
例示: on3diff(expr,var) <- p=1 として1階偏微分を返す
★ ◎ on3diff(sin(x),x) = cos(x)
★ ◎ on3diff(x^2*on3(x,0,1,co) + %e^(1-x)*on3(x,1,inf,co), x, 1)
= 2*x*on3(x,0,1,co)-%e^(1-x)*on3(x,1,inf,oo)
--end of on3diff('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3diff('ex)--"),
on3diff_ex(),
/*
block([],
return('normal_return)
), /* end of block */
*/
print("--end of on3diff('ex)--"),
return("--end of on3diff('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1], var : args[2],
if (length(args) > 2)
and (not member(args[3],[debug1,debug2,debug3,show,list]))
then (p: args[3]) else p:1 ,
if debug > 0 then
print("on3diff(func,var,p): 区間で異なる関数の",var,"に関する",p,"次導関数を求める"),
/*** start ***/
if listp(expr) then exp0:l2f(expr) else exp0:ev(expr,expand,infeval),
/* タイプの検査 */
type:on3typep(exp0),
LR : on3lrl(expr),
d1show("タイプの検査",type),
d1show("端点検査",LR),
if type='on3none then return(diff(expr,x,p)), /* 非on3式のとき */
number:true,
for i thru length(LR[1]) do if LR[3][i]=false then number:false,
if (type=on3inv or type=on3polyinv) and number=false then
( print(" ---> on3分数式かつ非数値領域のため処理を中止する"),
return("Not Evaluated")),
func : on3decomp(exp0), /* call on3decomp : 排他的領域分解 */
d1show("S0: on3decompの結果 :",func),
gradef(on3(z,zl,zr,zlr),0,0,0,0), /* 関数微分を定義する */
if not integerp(p) then (cshow("p is not integer",p), return("No Action")),
/* 1階微分する毎に端点検査を行う必要がある */
for k:1 thru p do ( /* 1階微分の繰り返し */
dfunc : diff(func,var,1),
dfunc: ev(dfunc,expand,infeval),
if dfunc = 0 then return(out:0),
fL:f2l(func), dfL:f2l(dfunc),
d2show("S2: 関数部の形式的微分結果:",k,dfunc),
d2show(dfL),
LR : on3lrl(func), T:[],
for i thru length(LR[1]) do if LR[1][i]=var then T:LR[2][i],
d2show(var,T),on3v:var,
/* 端点での微分係数の存在を検査（接線の有無を調べる）*/
fLT : scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var then
(d2show(u), u:ev(u,u[2]=tvar), u) else u ), fL),
ft:l2f(fLT),
dfLT : scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var then
(d2show(u), u:ev(u,u[2]=tvar), u) else u ), dfL),
dft:l2f(dfLT),
d2show("S3: 関数部と定義域部を分離する関数の生成"),
d2show(ft),
d2show(dft),
/**** oo cahnge ***/
dfL:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var then
(d2show(u), u[5]:oo, u) else u ), dfL),
for i thru length(dfL) do (
same:false,
scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var
and u[3]=u[4] then
(d2show(u), same:true, same) else u ), dfL[i]),
if same then dfL:delete(dfL[i],dfL)
),
d2show("S4:導関数の定義域を一旦[oo]に変更する: ",dfL),
/* 端点での微分可能性を調べる
(端点x0での関数f(x)の連続性と導関数f'(x)の両極限の一致性に基づく) */
for i:2 thru length(T)-1 do (
tl:(T[i-1]+T[i])/2, tm:T[i], tr:(T[i]+T[i+1])/2,
/* f(x) errcatch */
ftl:ev(ft,tvar=tl), ftm:ev(ft,tvar=tm), ftr:ev(ft,tvar=tr), /* 関数抽出 */
/* 関数値 */
if errcatch(wftl:ev(ftl,ev(var)=tm),
wftm:ev(ftm,ev(var)=tm),
wftr:ev(ftr,ev(var)=tr),return)=[]
then (print("---> 端点での連続性が評価不能でした"), return("error") ),
wftl:ev(ftl,ev(var)=tm), wftm:ev(ftm,ev(var)=tm), wftr:ev(ftr,ev(var)=tm),
d2show("---端点での微分可能性検査---",i,tm),
d2show(tl,tm,tr), d2show(ftl,ftm,ftr), d2show(wftl,wftm,wftr),
if wftl=wftm and wftr=wftm
then (chsow("f-continue"), fcontinue:true) else fcontinue:false,
if fcontinue then (
/* f'(x) */
d2show(fcontinue),
if errcatch(
dftl:ev(dft,tvar=tl), dftr:ev(dft,tvar=tr), /* 関数抽出 */
wdftl:ev(dftl,ev(var)=tm), wdftr:ev(dftr,ev(var)=tm), /* 関数値 */
return)=[]
then (print("---> 端点での微分係数が評価不能でした"),
return("Not Evauated") ),
dftl:ev(dft,tvar=tl), dftr:ev(dft,tvar=tr), /* 関数抽出 */
wdftl:ev(dftl,ev(var)=tm), wdftr:ev(dftr,ev(var)=tm), /* 関数値 */
d2show(tm,dftl,dftr),
d2show(tm,wdftl,wdftr),
if wdftl=wdftr then (d2show("df-ok"), dfok:true) else dfok:false ,
d2show(i,tm,fcontinue,dfok),
if fcontinue and dfok then ( /* 再考の必要あるかも */
dfL:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=var
then (d2show(u),chk:fase,
if u[3]=tm then (u[5]:co, chk:true)
else if u[4]=tm and chk=false then u[5]:oc, u)
else u
),dfL)
) /* 端点変更 の終わり */
) /* end of fcontinue then */
), /* end of for-i */
out:l2f(dfL),out:on3std(out),d2show("S5:1階微分の結果:",k,out),
func:out
), /* end of for-k */
d2show("Diff",out),
/*** 出力形式の指定 ***/
if member(show,args) then on3show(out),
if member(list,args) then return(f2l(out)) else return(out)
)$
/*--- on3diff_ex ------------------------------------------------------*/
on3diff_ex([args]) := block([progn:"<on3diff_ex",p,x,ex,ex1,ex2,ex3,df,Lex0,L],
ex1 : x^2 * on3(x,0,1,co) + %e^(1-x) * on3(x,1,inf,co),
ex2 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo),
ex3 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo) + sin(x)*on3(x,minf,inf,oo),
exansL : [["微分"],
["on3diff(sin(x),x)", "cos(x)"],
["on3diff(x^2*on3(x,0,1,co) + %e^(1-x)*on3(x,1,inf,co), x, 1)",
"2*x*on3(x,0,1,co)-%e^(1-x)*on3(x,1,inf,oo)", "on3show"],
[sconcat("on3diff(x^2*on3(x,minf,0,oo)+1/2*(1-x^2)*on3(x,0,1,oo)",
"+(1-x)*on3(x,1,inf,oo)",", x, 1)"),
"2*x*on3(x,minf,0,oo)-on3(x,1,inf,co)-x*on3(x,0,1,oo)", "on3show"],
[sconcat("on3diff(x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo)",
" + (1-x)*on3(x,1,inf,oo) + sin(x)*on3(x,minf,inf,oo)",
", x, 1)"),
sconcat("(cos(x)+2*x)*on3(x,minf,0,oo)+(cos(x)-1)*on3(x,1,inf,co)",
"+(cos(x)-x)*on3(x,0,1,oo)"), "on3show"]
],
print("== on3diff : 微分 =="),
c1show(exansL),
exchk("",exansL),
if false then (
p:1,
Lex0 : [ex1,ex2,ex3],
if length(args) > 0 then (
if listp(args[1]) then L:copylist(args[1]) else L:[args[1]]
) else L : copylist(Lex0),
/* start */
for ex in L do ( print("◆ 例 微分 "),
ldisplay(ex),
print(" ---> df : on3diff(ex,x,",p,",show)"),
df : on3diff(ex,x,p,show),
ldisplay(df)
) /* end of do */
),
return("--- end of on3diff_ex ---")
)$
/*#######################################################################*/
/*--- on3integ_ex 2021.02.27 ------------------------------------------*/
/*#######################################################################*/
on3integ_ex([args]) := block([progn:"<on3integ_ex",
x,ex,F,Fx,Lex0,ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8,out,
cmds,ans],
/*
ex1 : x^2 * on3(x,0,1,co) + %e^(1-x) * on3(x,1,inf,co),
ex2 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo),
ex3 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo) + sin(x),
ex4 : x*y*on3(x,1,4,co)*on3(y,2,4,co)+ x^2*on3(x,3,4,co)*on3(y,6,8,co),
ex5 : f1*on3(x,a,b,co)+f2*on3(x,c,d,co),
ex6 : f1*on3(x,0,1,co)*on3(y,x,1,co) + f2*on3(x,0,1,co)*on3(y,x,2,co),
ex7 : f1*on3(x,1,2,co)*on3(y,y1(x),y2(x),co),
ex8 : f0+1/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)),
*/
cmds : sconcat("( ",
"/* 例1. 不定積分 */ @",
" ex : on3(x,1,3,co) + on3(x,5,7,oc), @",
" F : on3integ(ex,x) @",
" )"),
ans : 2*on3(x,7,inf,oo)+(x-5)*on3(x,5,7,oc)+2*on3(x,3,inf,co)+(x-1)*on3(x,1,3,co),
chk1show(cmds,ans),
c0show("注: 不定積分関数 F の微分:",on3diff(F,x)," <- 端点の開閉に注意"),
cmds : sconcat("( ",
"/* 例2-1. 不定積分(on3多項式:非排他分解) */ @",
" ex : on3(x,1,5,co) + on3(x,3,7,oc), @",
" F : on3integ(ex,x) @",
" )"),
ans : 4*on3(x,7,inf,oo)+4*on3(x,5,inf,co)+(x-3)*on3(x,3,7,oc)+(x-1)*on3(x,1,5,co),
chk1show(cmds,ans),
c0show("注: 不定積分関数 F の排他的分解:",on3decomp21(F,x)),
cmds : sconcat("( ",
"/* 例2-2. 不定積分(on3多項式:非排他分解->排他的分解,不定積分,排他的分解) */ @",
" ex : on3(x,1,5,co) + on3(x,3,7,oc), @",
" ex1 : on3decomp21(ex,x), c0show(\"on3排他分解:\",ex1),@",
" F : on3integ(ex1,x) @",
" )"),
ans : 2*on3(x,7,inf,oo)+4*on3(x,5,inf,co)+(x-5)*on3(x,5,7,cc)+2*on3(x,3,inf,oo)
+(2*x-6)*on3(x,3,5,oo)+(x-1)*on3(x,1,3,cc),
chk1show(cmds,ans),
c0show("注: 不定積分関数 F の排他的分解:",on3decomp21(F,x)),
c0show("注: 不定積分関数 F の微分:",on3diff(F,x)),
cmds : sconcat("( ",
"/* 例3. 不定積分 */ @",
" ex : %e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co), @",
" F : on3integ(ex,x) @",
" )"),
ans : (1-%e^(1-x))*on3(x,1,inf,co)+on3(x,1,inf,co)/3+(x^3*on3(x,0,1,co))/3,
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
cmds : sconcat("( ",
"/* 例4. 不定積分 */ @",
" ex : %e^x*on3(x,minf,0,oo)+%e^(-x)*on3(x,0,inf,co), @",
" F : on3integ(ex,x), F : on3decomp21(F,x) @",
" )"),
ans : %e^x*on3(x,minf,0,oo)+%e^-x*(2*%e^x-1)*on3(x,0,inf,co),
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
cmds : sconcat("( ",
"/* 例5. 不定積分 */ @",
" ex : 3*x^2*on3(x,3,4,co)*on3(y,6,8,co)+2*x*on3(x,1,4,co)*y*on3(y,2,4,co), @",
" F : on3integ(ex,x), F : on3decomp21(F,x) @",
" )"),
ans : on3(x,3,4,co)*((x-3)*(x^2+3*x+9)*on3(y,6,8,co)+(x-1)*(x+1)*y*on3(y,2,4,co))
+on3(x,4,inf,co)*(37*on3(y,6,8,co)+15*y*on3(y,2,4,co))
+(x-1)*(x+1)*on3(x,1,3,co)*y*on3(y,2,4,co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false,*/
cmds : sconcat("( ",
"/* 例6. 不定積分 */ @",
" ex : f1*on3(x,a,b,co)+f2*on3(x,c,d,co), @",
" F : on3integ(ex,x) @",
" )"),
ans : (d*f2-c*f2)*on3(x,d,inf,co)+(f2*x-c*f2)*on3(x,c,d,co)
+(b*f1-a*f1)*on3(x,b,inf,co) +(f1*x-a*f1)*on3(x,a,b,co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例7. 不定積分 */ @",
" ex : f1*on3(x,a,b,co)+f2*on3(x,c,d,co), @",
" F : on3integ(ex,x) @",
" )"),
ans : (d*f2-c*f2)*on3(x,d,inf,co)+(f2*x-c*f2)*on3(x,c,d,co)
+(b*f1-a*f1)*on3(x,b,inf,co) +(f1*x-a*f1)*on3(x,a,b,co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例8. 不定積分 */ @",
" ex : f0+1/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)), @",
" ex : on3decomp21(ex,x,[a<c,c<b,b<d],debug0), c0show(ex), @",
" F : on3integ(ex,x) @",
" )"),
ans : ((d*(f0*f2+1))/f2-(b*(f0*f2+1))/f2)*on3(x,d,inf,co)
+(((f0*f2+f0*f1+1)*x)/(f2+f1)-(c*(f0*f2+f0*f1+1))/(f2+f1))*on3(x,c,b,co)
+((c*(f0*f1+1))/f1-(a*(f0*f1+1))/f1)*on3(x,c,inf,co)
+(((f0*f2+1)*x)/f2-(b*(f0*f2+1))/f2)*on3(x,b,d,co)
+((b*(f0*f2+f0*f1+1))/(f2+f1)-(c*(f0*f2+f0*f1+1))/(f2+f1))*on3(x,b,inf,co)
+(((f0*f1+1)*x)/f1-(a*(f0*f1+1))/f1)*on3(x,a,c,co),
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例9. 不定積分関数 (y に関して) */ @",
" ex : f2*on3(x,0,1,co)*on3(y,x,2,co)+f1*on3(x,0,1,co)*on3(y,x,1,co), @",
" F : on3integ(ex,y), F : ev(F, ratexpand, ratsimp) @",
" )"),
ans : on3(x,0,1,co)*(f2*y-f2*x)*on3(y,x,2,co)
+on3(x,0,1,co)*(f1*y-f1*x)*on3(y,x,1,co)
+(2*f2-f2*x)*on3(x,0,1,co)*on3(y,2,inf,co)
+(f1-f1*x)*on3(x,0,1,co)*on3(y,1,inf,co),
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例10. 不定積分関数 (y に関して) */ @",
" ex : f1*on3(x,1,2,co)*on3(y,y1(x),y2(x),co), @",
" F : on3integ(ex,y) @",
" )"),
ans : (f1*y2(x)-f1*y1(x))*on3(x,1,2,co)*on3(y,y2(x),inf,co)
+on3(x,1,2,co)*(f1*y-f1*y1(x))*on3(y,y1(x),y2(x),co),
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例11. 2重定積分 */ @",
" ex : (y+x+5)*(on3(x,2,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc) @",
" +on3(x,-3,-2,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc) @",
" +on3(x,-2,2,co)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc) @",
" +on3(x,-2,2,co)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc)), @",
" Fx : on3integ(ex,y,minf,inf), print(\" Fx = \",Fx), @",
" F : on3integ(Fx,x,minf,inf)",
" )"),
ans : 25*%pi,
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
return("--end of on3integ_ex--")
)$
/*#######################################################################*/
/*### on3integ : on3多項式の数式積分 2021.02.27 #########################*/
/*#######################################################################*/
on3integ([args]) :=
block([progn:"<on3integ>",debug,on3func,var,vl0,vr0,out,
vl,vr,lr,lr1,f,wl,wr,F,definteg,Findef,Fdef,wFdef,wFdef_sum,
Findef_sum,Fdef_sum,Frest,Fl,Fr,Frf],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3integ('help)--
機能: on3()関数を含む式の不定積分,定積分を返す.未定端点,on3有理式に対応(on3decomp21()を使用)
文法: on3integ(on3func,var,{vl,vr},...)
F_i(x) = (F_i(x)-F_i(xl))*on3(x,xl,xr,lr)
+(F_i(xr)-F_i(xl))*on3(x,xr,inf,lr1),
where if xl=minf then F_i(xl)=0 (積分定数の定義),
lr=cc or oc then lr1=oo, lr=co or oo then lr1=co
例示: on3integ(on3func,x) 変数xに関する不定積分
on3integ(2*x, x) -> x^2
on3integ(2*x + on3(x,1,3,co), x)$
-> x^2 + (x-1)*on3(x,1,3,co) + (3-1)*on3(x,3,inf,co)
f2 : 2*on3(x,0,%pi/2,cc)*sin(2*x)+cos(x)*on3(x,0,%pi/2,cc)$
on3integ(f2,x) ->
(-on3(x,0,%pi/2,cc)*cos(2*x))+3*on3(x,%pi/2,inf,oo)
+(sin(x)+1)*on3(x,0,%pi/2,cc)
f4 : 2*on3(x,0,%pi/4,cc)*sin(2*x)+cos(x)*on3(x,0,%pi/2,cc)
on3integ(f4,x) ->
(on3(x,0,%pi/4,cc)*(1-cos(2*x))+on3(x,%pi/4,inf,oo)
+sin(x)*on3(x,0,%pi/2,cc)+on3(x,%pi/2,inf,oo)
on3integ(on3func,x,xl,xr) 変数xに関する区間[xl,xr]の定積分
on3integ(f4,x,minf,inf) -> 2
ev(out4,x = inf) -> 2
on3integ(expr(-x)*on3(x,0,inf,co),x,0,inf); -> 1
--end of on3integ('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3integ('ex)--"),
if true then on3integ_ex(),
print("--end of on3integ('ex)--"),
return("--end of on3integ('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1], var : args[2],
c1show(progn,on3func,var),
/* on3func:expand(on3func), */
if length(args)>=4 then (definteg:true, vl0 : args[3], vr0 :args[4])
else definteg:false,
c2show(progn,definteg),
c1show(progn, on3typep(on3func), on3vars(on3func)),
if on3typep(on3func)='on3none then (
/* on3none:on3関数を含まない場合 */
Findef_sum : integrate(on3func,ev(var)),
c2show(Findef_sum),
if definteg then (
Fdef_sum : integrate(on3func,ev(var),vl0,vr0),
c2show(Fdef_sum)
),
if definteg then return(Fdef_sum) else return(Findef_sum)
),
if member(on3typep(on3func),['on3inv,'on3polyinv,'on3unknown]) then (
out:on3decomp21(on3func,ev(var)),
if is(out=on3func) # true then (
on3func : out,
c1show(progn,"入力式on3funcをon3decomp21()で標準化 ->",on3func)
)
),
outLev(on3info(on3func,ev(var)),"w_"),
c2show(progn,w_Lon3),
c2show(progn,w_Lon3coef),
/* 不定積分関数を生成する */
Findef_sum:0, wFdef_sum:0,
for i:1 thru length(w_Lon3coef) do (
f : w_Lon3coef[i], vl : w_Lon3[i][3], vr : w_Lon3[i][4], lr:w_Lon3[i][5],
F : integrate(f,ev(var)),
c2show(progn,i,f,F),
if is(vl=minf) then wl:0 else wl:ev(F,ev(var)=vl),
Findef : (F-wl)*w_Lon3f[i],
if is(vr=inf) then wr: limit(F,ev(var),inf)
else wr: ev(F,ev(var)=vr),
wFdef : wr - wl,
if lr=cc or lr=oc then lr1:oo,
if lr=co or lr=oo then lr1:co,
Frest : (wr - wl)*on3(ev(var),vr,inf,lr1),
c2show(i,Findef), c2show(i,Frest),
Findef_sum : Findef_sum + Findef + Frest,
wFdef_sum : wFdef_sum + wFdef
),
c2show("不定積分関数 ",Findef_sum),
c2show("全区間定積分 ",wFdef_sum),
outLev(on3info(Findef_sum,ev(var)),"w_"),
c2show(w_Lon3f),c2show(w_Lon3coef),
/* 定積分を求める */
if definteg then (
if is(vl0=minf) then Fl:0 else Fl:ev(Findef_sum,ev(var)=vl0),
if is(vr0=inf) then Fr: ev(Findef_sum,ev(var)=inf)
else Fr: ev(Findef_sum,ev(var)=vr0),
c2show("定積分(不定積分関数より)==",var,ev(var),vl0,vr0),
c2show(Fl),c2show(Fr),
Fdef_sum : Fr - Fl,
c2show("定積分(不定積分関数より) ",Fdef_sum),
if is(vl0=minf) and is(vr0=inf) then Fdef_sum : wFdef_sum,
c2show("定積分",Fdef_sum)
),
if member('view,args) and (length(listofvars(on3func)) = 1) then (
c1show("Plot of f(x) and F(x)"),
g1 : gr2v([explicit(on3func,ev(var),0,%pi/2)],'title="f(x)",'noview),
g2 : gr2v([explicit(Findef_sum,ev(var),0,%pi/2)],'title="F(x)",'noview),
mk_draw([g1,g2],
['file_name=sconcat(figs_dir,"/","fig-fandF"),
'columns=2, 'dimensions=[1000,500]],
'view)
), /* end of if-TRUE */
killvars(["w_"]),
if definteg then return(Fdef_sum) else return(Findef_sum)
)$ /* end of on3integ() */
/*#######################################################################*/
/*### on3integ19 : on3多項式の数式積分 2019.06.28 ##########################*/
/*#######################################################################*/
/*
f1(x,y)*on3(x,xl,xr,xlr)*on3(y,yl,yr,ylr) を x で不定積分する
-> { (F1(x,y)-F1(xl,y))*on3(x,xl,xr,xlr)
+ (F1(xr,y)-F1(xl,y))*on3(x,xr,inf,xlr1) } * on3(y,yl,yr,ylr)
where F1(x,y) = integral(f1(x,y), x)
xlr=cc or oc then xlr1=oo, xlr=co or oo then xlr1=co
-> (F1(xr,y)-F1(xl,y)) * on3(y,yl,yr,ylr) を xの区間[xl,xr]での定積分とする
f1(x,y)*on3(y,yl,yr,ylr) を x で不定積分する
-> f1(x,y)*on3(x,minf,inf,oo)*on3(y,yl,yr,ylr) を x で不定積分する
F1(minf,y), F1(inf,y) が有限確定のときのみ意味をもつ
*/
on3integ19([args]) :=
block([progn:"<on3integ19>",debug,on3func,var,vl0,vr0, var_fix,one,L,
Li,vl,vr,lr,lr1,f,wl,wr,F,definteg,Findef,Fdef,Findef_sum,Fdef_sum,
Lif,Fif,var_fix_on,Frest],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3integ19('help)--
機能: on3()関数を含む式の不定積分,定積分を返す.(on3decomp()を必要としない)
文法: on3integ19(on3func,var,{vl,vr},...)
F_i(x) = (F_i(x)-F_i(xl))*on3(x,xl,xr,lr)
+(F_i(xr)-F_i(xl))*on3(x,xr,inf,lr1),
where if xl=minf then F_i(xl)=0 (積分定数の定義),
lr=cc or oc then lr1=oo, lr=co or oo then lr1=co
例示: on3integ19(on3func,x) 変数xに関する不定積分
on3integ19(2*x, x) -> x^2
on3integ19(2*x + on3(x,1,3,co), x)$
-> x^2 + (x-1)*on3(x,1,3,co) + (3-1)*on3(x,3,inf,co)
f2 : 2*on3(x,0,%pi/2,cc)*sin(2*x)+cos(x)*on3(x,0,%pi/2,cc)$
on3integ19(f2,x) ->
(-on3(x,0,%pi/2,cc)*cos(2*x))+3*on3(x,%pi/2,inf,oo)
+(sin(x)+1)*on3(x,0,%pi/2,cc)
f4 : 2*on3(x,0,%pi/4,cc)*sin(2*x)+cos(x)*on3(x,0,%pi/2,cc)
on3integ19(f4,x) ->
(on3(x,0,%pi/4,cc)*(1-cos(2*x))+on3(x,%pi/4,inf,oo)
+sin(x)*on3(x,0,%pi/2,cc)+on3(x,%pi/2,inf,oo)
on3integ19(on3func,x,xl,xr) 変数xに関する区間[xl,xr]の定積分
on3integ19(f4,x,minf,inf) -> 2
ev(out4,x = inf) -> 2
on3integ19(exp(-x)*on3(x,0,inf,co),x,0,inf); -> 1
--end of on3integ19('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3integ19('ex)--"),
on3integ19_ex(),
/*
block([proogn:"<on3varfix_ex>",debug],
return("-- end of on3varfix_ex --")
), /* end of block */
*/
print("--end of on3integ19('ex)--"),
return("--end of on3integ19('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1], var : args[2],
on3func:expand(on3func),
if length(args)>=4 then (definteg:true, vl0 : args[3], vr0 :args[4])
else definteg:false,
/*
if length(args)>=4 and member(minf, args) and member(inf, args)
then definteg:true else definteg:false,
*/
c1show(progn,definteg),
c1show(progn, on3typep(on3func), on3vars(on3func)),
if on3typep(on3func)='on3none then (
/* on3none:on3関数を含まない場合 */
Findef_sum : integrate(on3func,var),
c1show(Findef_sum),
if definteg then (
Fdef_sum : integrate(on3func,var,vl0,vr0),
cshow(Fdef_sum)
),
if definteg then return(Fdef_sum) else return(Findef_sum)
),
if member(on3typep(on3func),['on3inv,'on3polyinv,'on3unknown]) then (
c0show(progn,on3typep(on3func),"->",
"被積分関数の簡素化を検討して下さい(see on3decomp)"),
return("Error return")
),
/* change 2012.01.25, 2019.04.14 */
on3func : on3std(on3func), /* ratsimp, factor の障害を防ぐ */
on3func:expand(on3func),
L : f2l(on3func),
if L[1] = on3 then (
L : [f2l(one*on3func)], /* on3monoone */
L : ev(L, one=1)
),
/* on3(積分変数,.. -> on3(var_fix とし,積分に反応しないようにする */
L:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var
then (u[2]:var_fix, u) else u),L),
if L[1]="+" then L:delete(L[1],L) else if L[1]="*" then L:[L],
c1show(progn,L),
Findef_sum :0, Fdef_sum:0,
for i thru length(L) do (
c1show("**",i,L[i]),
/* 積分変数に関する定義関数on3()の存在有無と存在時の境界点vl,vrを見出す */
vl:null, vr:null, var_fix_on:false, Li:L[i],
Li:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var_fix
then (var_fix_on:true, vl:u[3], vr:u[4], lr:u[5], u) else u
) ,Li),
/* Li:delete(null,Li), */
c1show(Li,var_fix_on),
c1show(var,vl,vr, Li[2]),
ratprint:false,
/* on3(var_fix,..)を除いた関数部を取り出す */
Lif : Li,
Lif:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var_fix
then (u:1, u) else u
) ,Lif),
f : l2f(Lif), /* 積分変数に関するon3式のみを除いた被積分関数関数 */
c1show(f,var),
F : integrate(f,var), /* 被積分関数部 f の不定積分 indefinite integral */
c1show(F),
Findef : F,
if var_fix_on then (
if is(vl=minf) then wl : 0 else wl : ev(F, ev(var)=vl),
Findef : (F - wl)*on3(var,vl,vr,lr)
),
c1show(Findef),
Frest : 0, Fdef:0,
if var_fix_on then (
if is(vl=minf) then wl : 0 else wl : ev(F, ev(var)=vl),
/* if is(vr=inf) then wr : 0 else wr : ev(F, ev(var)=vr), */
if is(vr=inf) then wr : limit(F,ev(var),inf) /* 極限値 */
else wr : ev(F, ev(var)=vr),
Fdef : wr - wl, /* 定積分 definite integral */
if lr=cc or lr=oc then lr1:oo,
if lr=co or lr=oo then lr1:co,
Frest : (wr - wl)*on3(var,vr,inf,lr1)
),
c1show(Frest),
Fdef_sum : Fdef_sum + Fdef,
Findef_sum : Findef_sum + Findef + Frest
), /* end of for-i */
/* Findef_sum : on3decomp(Findef_sum), */
/* Fdef_sum : on3decomp(Fdef_sum), */
c1show(Fdef_sum),
Fdef_sum : ratsimp(Fdef_sum), Findef_sum : ratsimp(Findef_sum),
if member('view,args) and (length(listofvars(on3func)) = 1) then (
c1show("Plot of f(x) and F(x)"),
g1 : gr2v([explicit(on3func,ev(var),0,%pi/2)],'title="f(x)",'noview),
g2 : gr2v([explicit(Findef_sum,ev(var),0,%pi/2)],'title="F(x)",'noview),
mk_draw([g1,g2],
['file_name=sconcat(figs_dir,"/","fig-fandF"),
'columns=2, 'dimensions=[1000,500]],
'view)
), /* end of if-TRUE */
if definteg then return(Fdef_sum) else return(Findef_sum)
)$ /* end of on3integ19() */
/*#######################################################################*/
/*+++ 2019.04.19 +++++++++++++++++++++++++++++++++++++++++++++++++++*/
/*#######################################################################*/
on3integ19_ex([args]) :=
block([progn:"<on3integ19_ex>",debug,c11,c12,c21,c22,ex,cmds,dF,out,outsum,
f,F,Fans],
debug:ifargd(),
c11 : on3(t,0,1,co)*on3(u,0,t,cc)*on3(v,0,t-u,cc),
c12 : on3(t,1,2,co)*on3(u,t-1,1,cc)*on3(v,0,t-u,cc),
c21 : on3(t,1,2,co)*on3(u,0,t-1,cc)*on3(v,t-u-1,1,cc),
c22 : on3(t,2,3,cc)*on3(u,t-2,1,cc)*on3(v,t-u-1,1,cc),
/*------------------------------------------
◆ 3個の和の分布
[ 2 ]
[ t ]
[ -- (0 <= t < 1) ]
[ 2 ]
[ ]
[ 2 ]
[ 2 t - 6 t + 3 ]
f3(t) = [ - -------------- (1 <= t < 2) ]
[ 2 ]
[ ]
[ 2 ]
[ (t - 3) ]
[ -------- (2 <= t < 3) ]
[ 2 ]
[ ]
[ 0 ( otherwise ) ]
-------------------------------------------------*/
if false then (
outsum : 0,
for ex in [c11,c12,c21,c22] do (
cshow("========================================="),
out : on3integ19(ex,v,minf,inf), cshow(out),
out : on3integ19(out,u,minf,inf), cshow(ratsimp(out)),
outsum : outsum + ratsimp(out)
),
cshow(on3decomp(outsum))
), /* end of if-false */
cmds : sconcat("( ",
"/* 例1. 不定積分 */ @",
"f : f0, cashow(on3typep(f)), @",
"F : on3integ19(f,x) ",
" )"),
Fans : f0*x,
chk1show(cmds,Fans),
cmds : sconcat("( ",
"/* 例2. 不定積分 */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), @",
"F : on3integ19(f,x), F : on3decomp(F)",
" )"),
Fans : 2*(f2+f1)*on3(x,6,inf,co) + (f2*x-4*f2+2*f1)*on3(x,4,6,co)
+2*f1*on3(x,3,4,co) + f1*(x-1)*on3(x,1,3,co),
chk1show(cmds,Fans),
cmds : sconcat("( ",
"/* 例3. 不定積分 */@",
"f : 2*sin(2*x)*on3(x,0,%pi/2,cc) + 3*cos(3*x)*on3(x,0,%pi/3,cc),@",
"F : on3integ19(f,x)",
" )"),
Fans : on3(x,0,%pi/3,cc)*sin(3*x)+on3(x,0,%pi/2,cc)*(1-cos(2*x))+2*on3(x,%pi/2,inf,oo),
chk1show(cmds,Fans),
cashow(on3ev(F,factor)),
print("例4a: 微分関数の積分"),
f : exp(x-1)*on3(x,minf,1,oo) + exp(1-x)*on3(x,1,inf,co),
c0show(f),
df : on3diff(f,x),
c0show("df:on3diff(f,x) ->",df),
out : on3integ19(df,x),
c0show("out : on3integ19(df,x) ->",out),
out1 : on3ev(out,expand),
c0show("out1 : on3ev(out,expand) ->",out1),
c0show(is(equal(out1,f))),
chk1 : on3(x,1,inf,co)-on3(x,1,inf,oo)-on3(x,1,1,cc),
c0show(on3ev(chk1,expand)),
gr2v_fdf(f,df),
print("例4b: 積分関数の微分"),
f : exp(x-1)*on3(x,minf,1,oo) + exp(1-x)*on3(x,1,inf,co),
c0show(f),
F : on3integ19(f,x),
c0show("F : on3integ19(f,x) ->",F),
F : on3ev(F,expand),
c0show("F : on3ev(F,expand) ->",F),
dF : on3diff(F,x),
c0show("dF : on3diff(F,x) ->",dF),
c0show(is(equal(dF,f))),
cmds : sconcat("( ",
"/* F (直前の結果) の微分 on3diff(F,x) と f の比較(端点を除いて一致する)*/ @",
"dF : on3diff(F,x) @",
" )"),
chk1show(cmds,on3decomp(f)),
return("--end of on3integ19_ex--")
)$ /* end of on3integ19_ex() */
/*#######################################################################*/
/*--- on3integ20_ex 2021.02.27 ------------------------------------------*/
/*#######################################################################*/
on3integ20_ex([args]) := block([progn:"<on3integ20_ex",
x,ex,F,Fx,Lex0,ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8,out,
cmds,ans],
/*
ex1 : x^2 * on3(x,0,1,co) + %e^(1-x) * on3(x,1,inf,co),
ex2 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo),
ex3 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo) + sin(x),
ex4 : x*y*on3(x,1,4,co)*on3(y,2,4,co)+ x^2*on3(x,3,4,co)*on3(y,6,8,co),
ex5 : f1*on3(x,a,b,co)+f2*on3(x,c,d,co),
ex6 : f1*on3(x,0,1,co)*on3(y,x,1,co) + f2*on3(x,0,1,co)*on3(y,x,2,co),
ex7 : f1*on3(x,1,2,co)*on3(y,y1(x),y2(x),co),
ex8 : f0+1/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)),
*/
cmds : sconcat("( ",
"/* 例1. 不定積分 */ @",
" ex : on3(x,1,3,co) + on3(x,5,7,oc), @",
" F : on3integ20(ex,x) @",
" )"),
ans : 2*on3(x,7,inf,oo)+(x-5)*on3(x,5,7,oc)+2*on3(x,3,inf,co)+(x-1)*on3(x,1,3,co),
chk1show(cmds,ans),
c0show("注: 不定積分関数 F の微分:",on3diff(F,x)," <- 端点の開閉に注意"),
cmds : sconcat("( ",
"/* 例2-1. 不定積分(on3多項式:非排他分解) */ @",
" ex : on3(x,1,5,co) + on3(x,3,7,oc), @",
" F : on3integ20(ex,x) @",
" )"),
ans : 4*on3(x,7,inf,oo)+4*on3(x,5,inf,co)+(x-3)*on3(x,3,7,oc)+(x-1)*on3(x,1,5,co),
chk1show(cmds,ans),
c0show("注: 不定積分関数 F の排他的分解:",on3decomp21(F,x)),
cmds : sconcat("( ",
"/* 例2-2. 不定積分(on3多項式:非排他分解->排他的分解,不定積分,排他的分解) */ @",
" ex : on3(x,1,5,co) + on3(x,3,7,oc), @",
" ex1 : on3decomp21(ex,x), c0show(\"on3排他分解:\",ex1),@",
" F : on3integ20(ex1,x) @",
" )"),
ans : 2*on3(x,7,inf,oo)+4*on3(x,5,inf,co)+(x-5)*on3(x,5,7,cc)+2*on3(x,3,inf,oo)
+(2*x-6)*on3(x,3,5,oo)+(x-1)*on3(x,1,3,cc),
chk1show(cmds,ans),
c0show("注: 不定積分関数 F の排他的分解:",on3decomp21(F,x)),
c0show("注: 不定積分関数 F の微分:",on3diff(F,x)),
cmds : sconcat("( ",
"/* 例3. 不定積分 */ @",
" ex : %e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co), @",
" F : on3integ20(ex,x) @",
" )"),
ans : (1-%e^(1-x))*on3(x,1,inf,co)+on3(x,1,inf,co)/3+(x^3*on3(x,0,1,co))/3,
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
cmds : sconcat("( ",
"/* 例4. 不定積分 */ @",
" ex : %e^x*on3(x,minf,0,oo)+%e^(-x)*on3(x,0,inf,co), @",
" F : on3integ20(ex,x), F : on3decomp21(F,x) @",
" )"),
ans : %e^x*on3(x,minf,0,oo)+%e^-x*(2*%e^x-1)*on3(x,0,inf,co),
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
cmds : sconcat("( ",
"/* 例5. 不定積分 */ @",
" ex : 3*x^2*on3(x,3,4,co)*on3(y,6,8,co)+2*x*on3(x,1,4,co)*y*on3(y,2,4,co), @",
" F : on3integ20(ex,x), F : on3decomp21(F,x) @",
" )"),
ans : on3(x,3,4,co)*((x-3)*(x^2+3*x+9)*on3(y,6,8,co)+(x-1)*(x+1)*y*on3(y,2,4,co))
+on3(x,4,inf,co)*(37*on3(y,6,8,co)+15*y*on3(y,2,4,co))
+(x-1)*(x+1)*on3(x,1,3,co)*y*on3(y,2,4,co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false,*/
cmds : sconcat("( ",
"/* 例6. 不定積分 */ @",
" ex : f1*on3(x,a,b,co)+f2*on3(x,c,d,co), @",
" F : on3integ20(ex,x) @",
" )"),
ans : (d*f2-c*f2)*on3(x,d,inf,co)+(f2*x-c*f2)*on3(x,c,d,co)
+(b*f1-a*f1)*on3(x,b,inf,co) +(f1*x-a*f1)*on3(x,a,b,co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例7. 不定積分 */ @",
" ex : f1*on3(x,a,b,co)+f2*on3(x,c,d,co), @",
" F : on3integ20(ex,x) @",
" )"),
ans : (d*f2-c*f2)*on3(x,d,inf,co)+(f2*x-c*f2)*on3(x,c,d,co)
+(b*f1-a*f1)*on3(x,b,inf,co) +(f1*x-a*f1)*on3(x,a,b,co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例8. 不定積分 */ @",
" ex : f0+1/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)), @",
" ex : on3decomp21(ex,x,[a<c,c<b,b<d],debug0), c0show(ex), @",
" F : on3integ20(ex,x) @",
" )"),
ans : ((d*(f0*f2+1))/f2-(b*(f0*f2+1))/f2)*on3(x,d,inf,co)
+(((f0*f2+f0*f1+1)*x)/(f2+f1)-(c*(f0*f2+f0*f1+1))/(f2+f1))*on3(x,c,b,co)
+((c*(f0*f1+1))/f1-(a*(f0*f1+1))/f1)*on3(x,c,inf,co)
+(((f0*f2+1)*x)/f2-(b*(f0*f2+1))/f2)*on3(x,b,d,co)
+((b*(f0*f2+f0*f1+1))/(f2+f1)-(c*(f0*f2+f0*f1+1))/(f2+f1))*on3(x,b,inf,co)
+(((f0*f1+1)*x)/f1-(a*(f0*f1+1))/f1)*on3(x,a,c,co),
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例9. 不定積分関数 (y に関して) */ @",
" ex : f2*on3(x,0,1,co)*on3(y,x,2,co)+f1*on3(x,0,1,co)*on3(y,x,1,co), @",
" F : on3integ20(ex,y), F : ev(F, ratexpand, ratsimp) @",
" )"),
ans : on3(x,0,1,co)*(f2*y-f2*x)*on3(y,x,2,co)
+on3(x,0,1,co)*(f1*y-f1*x)*on3(y,x,1,co)
+(2*f2-f2*x)*on3(x,0,1,co)*on3(y,2,inf,co)
+(f1-f1*x)*on3(x,0,1,co)*on3(y,1,inf,co),
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例10. 不定積分関数 (y に関して) */ @",
" ex : f1*on3(x,1,2,co)*on3(y,y1(x),y2(x),co), @",
" F : on3integ20(ex,y) @",
" )"),
ans : (f1*y2(x)-f1*y1(x))*on3(x,1,2,co)*on3(y,y2(x),inf,co)
+on3(x,1,2,co)*(f1*y-f1*y1(x))*on3(y,y1(x),y2(x),co),
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例11. 2重定積分 */ @",
" ex : (y+x+5)*(on3(x,2,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc) @",
" +on3(x,-3,-2,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc) @",
" +on3(x,-2,2,co)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc) @",
" +on3(x,-2,2,co)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc)), @",
" Fx : on3integ20(ex,y,minf,inf), print(\" Fx = \",Fx), @",
" F : on3integ20(Fx,x,minf,inf)",
" )"),
ans : 25*%pi,
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
return("--end of on3integ20_new_ex--")
)$
/*#######################################################################*/
/*### on3integ20 : on3多項式の数式積分 2021.02.27 #########################*/
/*#######################################################################*/
on3integ20([args]) :=
block([progn:"<on3integ20>",debug,on3func,var,vl0,vr0,out,
vl,vr,lr,lr1,f,wl,wr,F,definteg,Findef,Fdef,wFdef,wFdef_sum,
Findef_sum,Fdef_sum,Frest,Fl,Fr,Frf],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3integ20('help)--
機能: on3()関数を含む式の不定積分,定積分を返す.(on3decomp()を必要としない)
文法: on3integ20(on3func,var,{vl,vr},...)
F_i(x) = (F_i(x)-F_i(xl))*on3(x,xl,xr,lr)
+(F_i(xr)-F_i(xl))*on3(x,xr,inf,lr1),
where if xl=minf then F_i(xl)=0 (積分定数の定義),
lr=cc or oc then lr1=oo, lr=co or oo then lr1=co
例示: on3integ20(on3func,x) 変数xに関する不定積分
on3integ20(2*x, x) -> x^2
on3integ20(2*x + on3(x,1,3,co), x)$
-> x^2 + (x-1)*on3(x,1,3,co) + (3-1)*on3(x,3,inf,co)
f2 : 2*on3(x,0,%pi/2,cc)*sin(2*x)+cos(x)*on3(x,0,%pi/2,cc)$
on3integ20(f2,x) ->
(-on3(x,0,%pi/2,cc)*cos(2*x))+3*on3(x,%pi/2,inf,oo)
+(sin(x)+1)*on3(x,0,%pi/2,cc)
f4 : 2*on3(x,0,%pi/4,cc)*sin(2*x)+cos(x)*on3(x,0,%pi/2,cc)
on3integ20(f4,x) ->
(on3(x,0,%pi/4,cc)*(1-cos(2*x))+on3(x,%pi/4,inf,oo)
+sin(x)*on3(x,0,%pi/2,cc)+on3(x,%pi/2,inf,oo)
on3integ20(on3func,x,xl,xr) 変数xに関する区間[xl,xr]の定積分
on3integ20(f4,x,minf,inf) -> 2
ev(out4,x = inf) -> 2
on3integ20(exp(-x)*on3(x,0,inf,co),x,0,inf); -> 1
--end of on3integ20('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3integ20('ex)--"),
if true then on3integ20_ex(),
print("--end of on3integ20('ex)--"),
return("--end of on3integ20('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1], var : args[2],
c1show(progn,on3func,var),
/* on3func:expand(on3func), */
if length(args)>=4 then (definteg:true, vl0 : args[3], vr0 :args[4])
else definteg:false,
c2show(progn,definteg),
c1show(progn, on3typep(on3func), on3vars(on3func)),
if on3typep(on3func)='on3none then (
/* on3none:on3関数を含まない場合 */
Findef_sum : integrate(on3func,ev(var)),
c2show(Findef_sum),
if definteg then (
Fdef_sum : integrate(on3func,ev(var),vl0,vr0),
c2show(Fdef_sum)
),
if definteg then return(Fdef_sum) else return(Findef_sum)
),
if member(on3typep(on3func),['on3inv,'on3polyinv,'on3unknown]) then (
out:on3decomp21(on3func,ev(var)),
if is(out=on3func) # true then (
on3func : out,
c1show(progn,"入力式on3funcをon3decomp21()で標準化 ->",on3func)
)
),
outLev(on3info(on3func,ev(var)),"w_"),
c2show(progn,w_Lon3),
c2show(progn,w_Lon3coef),
/* 不定積分関数を生成する */
Findef_sum:0, wFdef_sum:0,
for i:1 thru length(w_Lon3coef) do (
f : w_Lon3coef[i], vl : w_Lon3[i][3], vr : w_Lon3[i][4], lr:w_Lon3[i][5],
F : integrate(f,ev(var)),
c2show(progn,i,f,F),
if is(vl=minf) then wl:0 else wl:ev(F,ev(var)=vl),
Findef : (F-wl)*w_Lon3f[i],
if is(vr=inf) then wr: limit(F,ev(var),inf)
else wr: ev(F,ev(var)=vr),
wFdef : wr - wl,
if lr=cc or lr=oc then lr1:oo,
if lr=co or lr=oo then lr1:co,
Frest : (wr - wl)*on3(ev(var),vr,inf,lr1),
c2show(i,Findef), c2show(i,Frest),
Findef_sum : Findef_sum + Findef + Frest,
wFdef_sum : wFdef_sum + wFdef
),
c2show("不定積分関数 ",Findef_sum),
c2show("全区間定積分 ",wFdef_sum),
outLev(on3info(Findef_sum,ev(var)),"w_"),
c2show(w_Lon3f),c2show(w_Lon3coef),
/* 定積分を求める */
if definteg then (
if is(vl0=minf) then Fl:0 else Fl:ev(Findef_sum,ev(var)=vl0),
if is(vr0=inf) then Fr: ev(Findef_sum,ev(var)=inf)
else Fr: ev(Findef_sum,ev(var)=vr0),
c2show("定積分(不定積分関数より)==",var,ev(var),vl0,vr0),
c2show(Fl),c2show(Fr),
Fdef_sum : Fr - Fl,
c2show("定積分(不定積分関数より) ",Fdef_sum),
if is(vl0=minf) and is(vr0=inf) then Fdef_sum : wFdef_sum,
c2show("定積分",Fdef_sum)
),
if member('view,args) and (length(listofvars(on3func)) = 1) then (
c1show("Plot of f(x) and F(x)"),
g1 : gr2v([explicit(on3func,ev(var),0,%pi/2)],'title="f(x)",'noview),
g2 : gr2v([explicit(Findef_sum,ev(var),0,%pi/2)],'title="F(x)",'noview),
mk_draw([g1,g2],
['file_name=sconcat(figs_dir,"/","fig-fandF"),
'columns=2, 'dimensions=[1000,500]],
'view)
), /* end of if-TRUE */
killvars(["w_"]),
if definteg then return(Fdef_sum) else return(Findef_sum)
)$ /* end of on3integ20() */
/*--- fsplit: on3solve.mx ---------------------------------------------*/
/*#####################################################################*/
/* <on3solve> on3 関数方程式の求解 (多変数対応版) */
/*#####################################################################*/
on3solve([args]) := block([progn:"<on3solve>",debug,
eqns:[],eqvars:[],wind:[],type,tlr:[],
tvlist:[tv1,tv2,tv3,tv4,tv5,tv6],
teqns:[],teqnsm:[],LR:[],fL:[],fLT:[],w,w1,w2,
var,tl,tm,tr,ftm,wftml,wftmr,wfl,wfr,
eqsum,teqsum,number,tvar,wans:[],wansk,chk,ans:[]],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3solve('help)--
機能: on3 関数方程式の求解 (多変数対応版)
文法: on3solve(funcs,vars,...)
例示:
例1. 不等式の求解
eq1 : x^2 * on3(x,minf,0,oo) + (1-x^2)/2 * on3(x,0,1,co)
+ (1-x) * on3(x,1,inf,co) - 1/8$
out : on3solve(eq1, x);
-> [x = -1/2^(3/2),x = sqrt(3)/2]
例2. 連立不等式の求解
eq21 : (x^2+y^2-2)*on3(y,0,inf,co) + (x^2+y^2-9)*on3(y,minf,0,oo)$
eq22 : (x-y)*on3(x,1,inf,co) + (3*x-2*y)*on3(x,0,1,co)
+ (2*x-y)*on3(x,minf,0,oo)$
out : on3solve([eq21,eq22],[x,y]);
-> [[x = -3/sqrt(5),y = -6/sqrt(5)],
[x = 2^(3/2)/sqrt(13),y = (3*sqrt(2))/sqrt(13)],
[x = 1,y = 1]]
--end of on3solve('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3solve('ex)--"),
on3solve_ex(),
print("--end of on3solve('ex)--"),
return("--end of on3solve('ex)--"),
block_main, /* main ブロック ====================================*/
funcs :args[1], vars : args[2],
d1show("--- enter on3solve ---"),
d2show(funcs), d2show(vars),
/*** S1 ******************************************************/
d1show("S1: 前処理:端点情報を得る"),
d1show("LR : [[x,y],[[minf,x1,...,inf],[minf,y1,...,inf]],[true,false]]---"),
eqns:[false], eqvars:[false],
if not listp(funcs) then eqns[1]:funcs else eqns:copylist(funcs),
if not listp(vars) then eqvars[1]:vars else eqvars:copylist(vars),
eqsum : 0,
for k thru length(eqns) do ( /* タイプの検査 */
type:on3typep(eqns[k]),
LR : on3lrl(eqns[k]),
d2show("タイプの検査",type), d2show("端点検査",LR),
number:true,
for i thru length(LR[1]) do if LR[3][i]=false then number:false,
if (type=on3inv or type=on3polyinv) and number=false then
( print(" ---> on3分数式かつ非数値領域のため処理を中止する"),
return("Not Evaluated")),
eqns[k] : on3decomp(eqns[k]),
eqsum : eqsum + eqns[k] ), /* end of for-k */
d2show(eqns),
LR : on3lrl(eqsum),
d2show(LR),
/***** S2 ****************************************************/
d1show("S2: 関数部とon3部を分離する"),
teqns:copylist(eqns),
teqsum:0,
for i thru length(eqns) do (
fL : f2l(eqns[i]),
for j thru length(LR[1]) do (
var : LR[1][j], tvar:tvlist[j],
d2show(var,tvar),
fLT : scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var then
(d2show(u), u:ev(u,u[2]=tvar), u) else u ), fL),
fL : fLT ), /* end of for-j */
teqns[i]:l2f(fL),
teqsum : teqsum + teqns[i]
), /* end of for-i */
d1show(teqns),
/***** S3 ***************************************************************/
d1show("S3: 変数の個数による次元処理を回避する方策"),
d2show(LR),
wind : makelist([],i,1,length(LR[1])),
for i:1 thru length(LR[1]) do wind[i] : makelist(j,j,1,length(LR[2][i])-1),
d2show(ind),
if length(LR[1]) = 1 then (
out : outermap(h,wind[1],1),
h(i) := [[LR[2][1][i],LR[2][1][i+1]]],
out: makelist(h(i),i,1,length(LR[2][1])-1),
out : ev(out), d2show(out) ) /* end of 1-var */
else if length(LR[1]) > 1 then (
/**** 以下の関数を自動生成する
--- for LR[1]=2
out : flatten(outermap(h, wind[1], wind[2])),
h(i1,i2) :=
[ [LR[2][1][i1],LR[2][1][i1+1]], [LR[2][2][i2],LR[2][2][i2+1]] ],
--- for LR[1]=3
out : flatten(outermap(h, wind[1], wind[2], wind[3])),
h(i1,i2,i3) :=
[ [LR[2][1][i1],LR[2][1][i1+1]], [LR[2][2][i2],LR[2][2][i2+1]],
[LR[2][3][i3],LR[2][3][i3+1]] ],
***/
w : "flatten(outermap(h",
for i:1 thru length(LR[1]) do w:sconcat(w,", wind[",i,"]"),
w : sconcat(w,"))"),
d2show(w),
out : eval_string(w),
w1 : "h(i1",
for i:2 thru length(LR[1]) do w1:sconcat(w1,",i",i), w1:sconcat(w1,") :="),
d2show(w1),
w2 : "[ [LR[2][1][i1],LR[2][1][i1+1]]",
for i:2 thru length(LR[1]) do
w2 : sconcat(w2,", [LR[2][",i,"][i",i,"],LR[2][",i,"][i",i,"+1]]"),
w2 : sconcat(w2," ]"),
d2show(w2),
w : sconcat(w1,w2),
eval_string(w),
out:ev(out), d2show(out) ), /* end of else-if */
kill(h),
/**** S4 **************************************/
d1show("S4: 排他的領域毎の求解処理"),
for i thru length(out) do ( /* 排他的領域毎の処理 */
teqnsm : copylist(teqns),
tlr : makelist(0,j,1,length(LR[1])),
for j thru length(LR[1]) do ( /* 変数毎の処理 */
tl : out[i][j][1],
tm : (out[i][j][1]+out[i][j][2])/2,
tr : out[i][j][2],
d2show(tl,tm,tr),
ftm:ev(teqsum,ev(tvlist[j])=tm), /* 関数抽出(mirage) */
d2show(tm,ftm),
wftml : ev(ftm,ev(LR[1][j])=tl),
wftmr : ev(ftm,ev(LR[1][j])=tr),
for jj thru length(LR[1]) do (
if jj # j then wftml:ev(wftml,tvlist[jj]=ev(LR[1][jj])),
if jj # j then wftmr:ev(wftmr,tvlist[jj]=ev(LR[1][jj]))
) /* end of for-jj */ ,
wfl:ev(eqsum,ev(LR[1][j])=tl), wfr:ev(eqsum,ev(LR[1][j])=tr),
if wfl = wftml and wfr = wftmr then tlr[j]:cc
else if wfl = wftml and wfr # wftmr then tlr[j]:co
else if wfl # wftml and wfr=wftmr then tlr[j]:oc
else tlr[j]:oo,
d2show(tlr),
teqnsm : ev(teqnsm, ev(tvlist[j])=tm),
d2show(teqnsm)
), /* end of for-j 変数 */
wans:[],
d1show(teqnsm),
wans : solve(teqnsm,LR[1]), /*** 求解処理 ***/
d1show(wans),
if not listp(wans) then return(),
for k:1 thru length(wans) do (
chk : 1,
for j thru length(LR[1]) do (
tl : out[i][j][1], tr : out[i][j][2],
if length(LR[1])=1 then wansk : rhs(wans[k])
else wansk : rhs(wans[k][j]),
d2show(tl,tr,tlr[j],wansk,on3(wansk,tl,tr,tlr[j])),
chk : chk * on3(wansk,tl,tr,tlr[j])
), /* end of for-j */
d1show(chk,wans[k]),
if chk = 1 then ans : endcons(wans[k],ans),
d2show(ans) ) /* end of for-k */
), /* end of for-i */
return(ans)
)$
/*#######################################################################*/
/*--- on3solve_ex ------------------------------------------------------*/
/*#######################################################################*/
on3solve_ex([args]) := block([progn:"<on3solve_ex>",
eq1, out, eq21, eq22, ans],
print("--begin of on3solve_ex--"),
cmds : sconcat("( ",
"/* 例1. 不等式の求解 */ @",
"eq1 : x^2 * on3(x,minf,0,oo) + (1-x^2)/2 * on3(x,0,1,co) ",
"+ (1-x) * on3(x,1,inf,co) -1/8, @",
"out : on3solve(eq1, x)",
" )"),
ans : [x = -1/2^(3/2),x = sqrt(3)/2],
chk1show(cmds,ans),
cmds : sconcat("( ",
"/* 例2. 連立不等式の求解 */ @",
"eq21 : (x^2+y^2-2)*on3(y,0,inf,co) + (x^2+y^2-9)*on3(y,minf,0,oo), @",
"eq22 : (x-y)*on3(x,1,inf,co) + (3*x-2*y)*on3(x,0,1,co) ",
" + (2*x-y)*on3(x,minf,0,oo), @",
"out : on3solve([eq21,eq22],[x,y])",
" )"),
ans : [[x = -3/sqrt(5),y = -6/sqrt(5)],
[x = 2^(3/2)/sqrt(13),y = (3*sqrt(2))/sqrt(13)],[x = 1,y = 1]],
chk1show(cmds,ans),
return("--- end of on3solve_ex ---")
)$
/*##################################################################################*/
/*### on3chgv : 矩形領域の変数変換
f(x,y) on D(x,y) -> t=x+y, u=y -> g(t,u) on G(t,u) -> g(t) = integral(g(t,u),u)
2020.06.03 ###*/
/*##################################################################################*/
on3chgv([args]) := block([progn:"<on3chgv>",debug,f0,sum,sw,on3part,outf,outf_coef,out],
debug:ifargd(),
f0 : args[1],
outLev(on3info(f0,x),"x_"),
c1show(progn,x_Lon3coef),
sum : 0,
for i:1 thru length(x_Lon3f) do (
c1show(x_Lon3coef[i]),
outLev(on3info(x_Lon3coef[i],y),"y_"),
c1show(y_Lon3coef),
for j:1 thru length(y_Lon3f) do (
sw : 1,
if sw=1 then (
c1show(i,j,x_Lon3f[i],y_Lon3f[j],y_Lon3coef[j]),
on3part : on3chgvar2(x_Lon3f[i]*y_Lon3f[j])
) else if sw=2 then (
on3part : on3ineq([[t-u,0,1,cc],[u,0,1,cc]],'resultonly,'noplot)
) else if sw=3 then (
xl:x_Lon3[i][3], xr:x_Lon3[i][4],xlr:x_Lon3[i][5],
yl:y_Lon3[j][3], yr:y_Lon3[j][4],ylr:y_Lon3[j][5],
c1show(xl,xr,yl,yr),
on3part : on3(t,xl+yl,xl+yr,co)*on3(u,yl,t-xl,cc)
+ on3(t,xl+yr,xr+yl,co)*on3(u,yl,yr,cc)
+ on3(t,xr+yl,xr+yr,cc)*on3(u,t-xr,yr,cc)
)
else (
cshow(progn,"unknow sw =",sw), quit()
),
sum : sum + y_Lon3coef[j]*on3part
)
), /* end of for-i */
c1show(sum),
sum : ratsubst(u,y,sum),
sum : ratsubst(t-u,x,sum),
c1show(sum),
outLev(on3info(sum,t,'factor),"w_"),
out : w_outf,
c1show(out),
/* g(t,u) = w_outf */
killvars(["x_","y_","w_"]),
return(out)
)$ /* end of on3chgv() */
/*### --- fsplit: on3chgvar2.mx --- #####################################*/
/* <on3chgvar2> */
/* 矩形領域上の２変数関数f(x,y)を変数変換(t=x+y,u=y)した g(t,u) を返す */
/*######################################################################*/
on3chgvar2([args]) := block([progn:"<on3chgvar2>",debug,func,
i,funcL:[], x,y,x0,x1,y0,y1,lr1,lr2,f,fout,wL,won3,outL:[],outfun],
local(f),
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3chgvar2('help)--
機能: 矩形領域上の２変数関数f(x,y)を変数変換(t=x+y,u=y)した g(t,u) を返す
文法: on3chgvar2(func,...)
例示:
ex : on3(x,0,1,co)*on3(y,0,1,co)$ on3chgvar2(ex);
-> on3(t,1,2,co)*on3(u,t-1,1,cc)+on3(t,0,1,co)*on3(u,0,t,cc)
ex : on3(x,0,inf,co)*on3(y,0,inf,co)$ on3chgvar2(ex);
-> on3(t,0,inf,co)*on3(u,0,t,cc)
--end of on3chgvar2('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3chgvar2('ex)--"),
on3chgvar2_ex(),
print("--end of on3chgvar2('ex)--"),
return("--end of on3chgvar2('ex)--"),
block_main, /* main ブロック ====================================*/
func : ratexpand(args[1]),
c1show(progn,func),
funcL : f2l(on3std(func)),
d1show(funcL),
if funcL[1]="*" then funcL : ["+",funcL], /* 単項式の多項式化 */
d1show("after",funcL),
for i:2 thru length(funcL) do (
c1show(progn,i,funcL[i]),
x : funcL[i][3][2], y : funcL[i][4][2],
x0 : funcL[i][3][3], y0 : funcL[i][4][3],
x1 : funcL[i][3][4], y1 : funcL[i][4][4],
lr1 : funcL[i][3][5], lr2 : funcL[i][4][5],
define(f(x,y), funcL[i][2]),
d1show(f(x,y)),
fout : f(t-u,u),
d1show(fout),
/*** case begin *****************************************************/
if x0=minf and x1=inf then (
/*1*/ if y0=minf and y1=inf then (
wL : [fout,[t,minf,inf,oo, u,minf,inf,oo]], outL:endcons(wL, outL))
/*2*/ else if y0=minf and numberp(y1) then (
wL : [fout,[t,minf,inf,oo, u,minf,y1,oc]], outL:endcons(wL, outL))
/*3*/ else if numberp(y0) and y1=inf then (
wL : [fout,[t,minf,inf,oo, u,y0,inf,co]], outL:endcons(wL, outL))
/*4*/ else if numberp(y0) and numberp(y1) then (
wL : [fout,[t,minf,inf,oo, u,y0,y1,cc]], outL:endcons(wL, outL))
)
else if x0=minf and numberp(x1) then (
/*5*/ if y0=minf and y1=inf then (
wL : [fout,[t,minf,inf,oo, u,t-x1,inf,co]], outL:endcons(wL, outL))
/*6*/ else if y0=minf and numberp(y1) then (
wL : [fout,[t,minf,x1+y1,oc, u,t-x1,y1,cc]], outL:endcons(wL, outL))
/*7*/ else if numberp(y0) and y1=inf then (
wL : [fout,[t,minf,x1+y0,oc, u,y0,inf,co]], outL:endcons(wL, outL),
wL : [fout,[t,x1+y0,inf,co, u,t-x1,inf,co]], outL:endcons(wL, outL))
/*8*/ else if numberp(y0) and numberp(y1) then (
wL : [fout,[t,minf,x1+y0,oc, u,y0,y1,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x1+y0,y1,cc, u,t-x1,y1,cc]], outL:endcons(wL, outL))
)
else if numberp(x0) and x1=inf then (
/*9*/ if y0=minf and y1=inf then (
wL : [fout,[t,minf,inf,oo, u,minf,t-x0,oc]], outL:endcons(wL, outL))
/*10*/ else if y0=minf and numberp(y1) then (
wL : [fout,[t,minf,x0+y1,oc, u,minf,t-x0,oc]],outL:endcons(wL, outL),
wL : [fout,[t,x0+y1,inf,co, u,minf,y1,oc]],outL:endcons(wL, outL))
/*11*/ else if numberp(y0) and y1=inf then (
wL : [fout,[t,x0+y0,inf,co, u,y0,t-x0,cc]], outL:endcons(wL, outL))
/*12*/ else if numberp(y0) and numberp(y1) then (
wL : [fout,[t,x0+y0,x0+y1,cc, u,y0,t-x0,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x0+y1,inf,co, u,y0,y1,cc]], outL:endcons(wL,outL))
)
else if numberp(x0) and numberp(x1) then (
/*13*/ if y0=minf and y1=inf then (
wL : [fout,[t,minf,inf,oo, u,t-x1,t-x0,cc]], outL:endcons(wL,outL))
/*14*/ else if y0=minf and numberp(y1) then (
wL : [fout,[t,minf,x0+y1,oc, u,t-x1,t-x0,cc]],outL:endcons(wL, outL),
wL : [fout,[t,x0+y1,x1+y1,cc, u,t-x1,y1,cc]], outL:endcons(wL,outL))
/*15*/ else if numberp(y0) and y1=inf then (
wL : [fout,[t,x0+y0,x1+y0,cc, u,y0,t-x0,cc]], outL:endcons(wL,outL),
wL : [fout,[t,x1+y0,inf,co, u,t-x1,t-x0,cc]], outL:endcons(wL,outL))
/*16*/ else if numberp(y0) and numberp(y1) and x0+y1 < x1+y0 then (
wL : [fout,[t,x0+y0,x0+y1,co, u,y0,t-x0,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x0+y1,x1+y0,co, u,y0,y1,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x1+y0,x1+y1,co, u,t-x1,y1,cc]], outL:endcons(wL, outL))
/*17*/ else if numberp(y0) and numberp(y1) and x0+y1 = x1+y0 then (
wL : [fout,[t,x0+y0,x0+y1,co, u,y0,t-x0,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x1+y0,x1+y1,co, u,t-x1,y1,cc]], outL:endcons(wL, outL))
/*18*/ else if numberp(y0) and numberp(y1) and x0+y1 > x1+y0 then (
wL : [fout,[t,x0+y0,x1+y0,co, u,y0,t-x0,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x1+y0,x0+y1,co, u,t-x1,t-x0,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x0+y1,x1+y1,co, u,t-x1,y1,cc]], outL:endcons(wL, outL))
)
else print("*** Error in on3chgvar2 : 想定外のケースを検出した ***")
/*** case end **********************************************************/
),
d1show(outL),
/*** 結果を関数形に変換する ***/
outfun : 0,
for i thru length(outL) do (
if length(outL[i][2]) = 4 then
won3 : funmake(on3,[outL[i][2][1],outL[i][2][2],
outL[i][2][3],outL[i][2][4]])
else if length(outL[i][2]) = 8 then
won3 : funmake(on3,[outL[i][2][1],outL[i][2][2],
outL[i][2][3],outL[i][2][4]])
*
funmake(on3,[outL[i][2][5],outL[i][2][6],
outL[i][2][7],outL[i][2][8]]),
outfun : outfun + outL[i][1] * won3
), kill(f),
d1show(outfun),
return(outfun)
)$ /* end of on3chgvar2() */
/*#######################################################################*/
/*--- on3chgvar2_ex -----------------------------------------------------*/
/*#######################################################################*/
on3chgvar2_ex([args]) := block([progn:"<on3chgvar2_ex>",debug,
x,y,ex0,ex1,ex2,ex3,ex4,ex,out],
debug:ifargd(),
print("領域(x,y)を変換{t=x+y,u=y}によって移した領域(t,u)を求める"),
ex0 : on3(x,0,1,co)* on3(y,0,1,co),
ex1 : on3(x,0,inf,co)* on3(y,0,inf,co),
ex2 : on3(x,1,inf,co)* on3(y,1,inf,co),
ex3 : on3(x,minf,0,oc)* on3(y,minf,0,oc),
ex4 : on3(x,minf,inf,oo)* on3(y,minf,inf,oo),
for ex in [ex0,ex1,ex2,ex3,ex4] do
(out:on3chgvar2(ex), ldisplay(ex),ldisplay(out)),
return("---done---")
)$
/*#######################################################################*/
/*--- on3chgvar2_test ---------------------------------------------------*/
/*#######################################################################*/
on3chgvar2_test() := block([progn:"<on3chgvar2_test>",debug,
ex,ans,cmds, x0,x1,y0,y1,i0,i1],
x0 : 0, x1 : 1, y0 : 0, y1 : 1,
ex[1] : on3(x, minf, inf, oo) * on3(y, minf, inf, oo),
ans[1] : on3(t,minf,inf,oo) * on3(u,minf,inf,oo),
ex[2] : on3(x,minf, inf, oo) * on3(y, minf, y1, oc),
ans[2] : on3(t,minf,inf,oo) * on3(u,minf,y1,oc),
ex[3] : on3(x, minf, inf, oo) * on3(y, y0, inf, co),
ans[3] : on3(t,minf,inf,oo) * on3(u,y0,inf,co),
ex[4] : on3(x, minf, inf, oo) * on3(y, y0, y1, cc),
ans[4] : on3(t,minf,inf,oo) * on3(u,y0,y1,cc),
ex[5] : on3(x, minf, x1, oc) * on3(y, minf, inf, oo),
ans[5] : on3(t,minf,inf,oo) * on3(u,t-x1,inf,co),
ex[6] : on3(x, minf, x1, oc) * on3(y, minf, y1, oc),
ans[6] : on3(t,minf,x1+y1,oc) * on3(u,t-x1,y1,cc),
ex[7] : on3(x, minf, x1, oc) * on3(y, y0, inf, co),
ans[7] : on3(t,minf,x1+y0,oc) * on3(u,y0,inf,co)
+ on3(t,x1+y0,inf,co) * on3(u,t-x1,inf,co),
ex[8] : on3(x, minf, x1, oc) * on3(y, y0, y1, cc),
ans[8] : on3(t,minf,x1+y0,oc) * on3(u,y0,y1,cc)
+ on3(t,x1+y0,y1,cc) * on3(u,t-x1,y1,cc),
ex[9] : on3(x, x0, inf, co) * on3(y, minf, inf, oo),
ans[9] : on3(t,minf,inf,oo) * on3(u,minf,t-x0,oc),
ex[10] : on3(x, x0, inf, co) * on3(y, minf, y1, oc),
ans[10]: on3(t,minf,x0+y1,oc) * on3(u,minf,t-x0,oc)
+ on3(t,x0+y1,inf,co) * on3(u,minf,y1,oc),
ex[11] : on3(x, x0, inf, co) * on3(y, y0, inf, co),
ans[11]: on3(t,x0+y0,inf,co) * on3(u,y0,t-x0,cc),
ex[12] : on3(x, x0, inf, co) * on3(y, y0, y1, cc),
ans[12]: on3(t,x0+y0,x0+y1,cc) * on3(u,y0,t-x0,cc)
+ on3(t,x0+y1,inf,co) * on3(u,y0,y1,cc),
ex[13] : on3(x, x0, x1, cc) * on3(y, minf, inf, oo),
ans[13]: on3(t,minf,inf,oo) * on3(u,t-x1,t-x0,cc),
ex[14] : on3(x, x0, x1, cc) * on3(y, minf, y1, oc),
ans[14]: on3(t,minf,x0+y1,oc) * on3(u,t-x1,t-x0,cc)
+ on3(t,x0+y1,x1+y1,cc) * on3(u,t-x1,y1,cc),
ex[15] : on3(x, x0, x1, cc) * on3(y, y0, inf, co),
ans[15]: on3(t,x0+y0,x1+y0,cc) * on3(u,y0,t-x0,cc)
+ on3(t,x1+y0,inf,co) * on3(u,t-x1,t-x0,cc),
x0 : 0, x1 : 3, y0 : 0 , y1 : 2,
ex[16] : on3(x, 0, 3, cc) * on3(y, 0, 2, cc), /* x0 + y1 < x1 + y0 */
ans[16]: on3(t,x0+y0,x0+y1,co) * on3(u,y0,t-x0,cc)
+ on3(t,x0+y1,x1+y0,co) * on3(u,y0,y1,cc)
+ on3(t,x1+y0,x1+y1,co) * on3(u,t-x1,y1,cc),
x0 : 0, x1 : 1, y0 : 0 , y1 : 1,
ex[17] : on3(x, 0, 1, cc) * on3(y, 0, 1, cc), /* x0 + y1 = x1 + y0 */
ans[17]: on3(t,x0+y0,x0+y1,co) * on3(u,y0,t-x0,cc)
+ on3(t,x1+y0,x1+y1,co) * on3(u,t-x1,y1,cc),
x0 : 0, x1 : 2, y0 : 0 , y1 : 3,
ex[18] : on3(x, 0, 2, cc) * on3(y, 0, 3, cc), /* x0 + y1 > x1 + y0 */
ans[18]: on3(t,x0+y0,x1+y0,co) * on3(u,y0,t-x0,cc)
+ on3(t,x1+y0,x0+y1,co) * on3(u,t-x1,t-x0,cc)
+ on3(t,x0+y1,x1+y1,co) * on3(u,t-x1,y1,cc),
/************ case end ******************************/
print("=== on3chgvar2_test start ==="),
i0 : 1, i1 : 18,
for i:1 thru i1 do (
cmds : sconcat("(","c0show(i,ex[i]), on3chgvar2(ex[i])",")"),
chk1show(cmds,ans[i])
),
return("---on3chgvar2_test end ---")
)$
/*#######################################################################*/
/*### on3D2G_ex() : 例と解答 */
/*#######################################################################*/
on3D2G_ex([args]) := block([progn:"<on3D2G_ex>",debug,
ex16,ans16,ex15,ans15,ex14,ans14,ex13,ans13,
ex12,ans12,ex11,ans11,ex10,ans10,ex9,ans9,
ex8,ans8,ex7,ans7,ex6,ans6,ex5,ans5,
ex4,ans4,ex3,ans3,ex2,ans2,ex1,ans1, exans, ex,out,ans,ansL],
debug:ifargd(),
ex1 : on3(x, minf, inf, oo) * on3(y, minf, inf, oo),
ans1 : [["ans1:E",0, on3(t,minf,inf,oo) * on3(u,minf,inf,oo), 0]],
ex2 : on3(x,minf, inf, oo) * on3(y, minf, yr, oc),
ans2 : [["ans2:E",0, on3(t,minf,inf,oo) * on3(u,minf,yr,oc), 0]],
ex3 : on3(x, minf, inf, oo) * on3(y, yl, inf, co),
ans3 : [["ans3:E",0, on3(t,minf,inf,oo) * on3(u,yl,inf,co), 0]],
ex4 : on3(x, minf, inf, oo) * on3(y, yl, yr, cc),
ans4 : [["ans4:A",0, on3(t,minf,inf,oo) * on3(u,yl,yr,cc), 0]],
ex5 : on3(x, minf, xr, oc) * on3(y, minf, inf, oo),
ans5 : [["ans5:E",0, 0, on3(t,minf,inf,oo) * on3(u,t-xr,inf,co)]],
ex6 : on3(x, minf, xr, oc) * on3(y, minf, yr, oc),
ans6 : [["ans6:E",0, 0, on3(t,minf,xr+yr,oc) * on3(u,t-xr,yr,cc)]],
ex7 : on3(x, minf, xr, oc) * on3(y, yl, inf, co),
ans7 : [["ans7:E",0, on3(t,minf,xr+yl,oc) * on3(u,yl,inf,co),
on3(t,xr+yl,inf,oo) * on3(u,t-xr,inf,co)]],
ex8 : on3(x, minf, xr, oc) * on3(y, yl, yr, cc),
ans8 : [["ans8:A",0, on3(t,minf,xr+yl,oc) * on3(u,yl,yr,cc),
on3(t,xr+yl,xr+yr,oc) * on3(u,t-xr,yr,cc)]],
ex9 : on3(x, xl, inf, co) * on3(y, minf, inf, oo),
ans9 : [["ans9:E",on3(t,minf,inf,oo) * on3(u,minf,t-xl,oc), 0, 0]],
ex10 : on3(x, xl, inf, co) * on3(y, minf, yr, oc),
ans10: [["ans10:E", on3(t,minf,xl+yr,oc) * on3(u,minf,t-xl,oc),
on3(t,xl+yr,inf,oo) * on3(u,minf,yr,oc), 0]],
ex11 : on3(x, xl, inf, co) * on3(y, yl, inf, co),
ans11: [["ans11:E", on3(t,xl+yl,inf,co) * on3(u,yl,t-xl,cc), 0, 0]],
ex12 : on3(x, xl, inf, co) * on3(y, yl, yr, cc),
ans12: [["ans12:A", on3(t,xl+yl,xl+yr,cc) * on3(u,yl,t-xl,cc),
on3(t,xl+yr,inf,oo) * on3(u,yl,yr,cc), 0]],
ex13 : on3(x, xl, xr, cc) * on3(y, minf, inf, oo),
ans13: [["ans13:B", 0, on3(t,minf,inf,oo) * on3(u,t-xr,t-xl,cc), 0]],
ex14 : on3(x, xl, xr, cc) * on3(y, minf, yr, oc),
ans14: [["ans14:B", 0, on3(t,minf,xl+yr,oc) * on3(u,t-xr,t-xl,cc),
on3(t,xl+yr,xr+yr,oc) * on3(u,t-xr,yr,cc)]],
ex15 : on3(x, xl, xr, cc) * on3(y, yl, inf, co),
ans15: [["ans15:B ",
on3(t,xl+yl,xr+yl,cc) * on3(u,yl,t-xl,cc),
on3(t,xr+yl,inf,oo) * on3(u,t-xr,t-xl,cc),0]],
/* type A : xr-xl > yr-yl <=> xr+yl > xl+yr
xl : 0, xr : 3, yl : 0 , yr : 2,
type B : xr-xl < yr-yl <=> xr+yl < xl+yr
xl : 0, xr : 2, yl : 0 , yr : 3,
type E : xr-xl = yr-yl <=> xr+yl = xl+yr
xl : 0, xr : 2, yl : 0 , yr : 2,
*/
ex16 : on3(x, xl, xr, cc) * on3(y, yl, yr, cc),
ans16: [["ans16A: when xr-xl > yr-yl ",
on3(t,xl+yl,xl+yr,cc) * on3(u,yl,t-xl,cc),
on3(t,xl+yr,xr+yl,oc) * on3(u,yl,yr,cc),
on3(t,xr+yl,xr+yr,oc) * on3(u,t-xr,yr,cc)],
["ans16B: when xr-xl < yr-yl",
on3(t,xl+yl,xr+yl,cc) * on3(u,yl,t-xl,cc),
on3(t,xr+yl,xl+yr,oc) * on3(u,t-xr,t-xl,cc),
on3(t,xl+yr,xr+yr,oc) * on3(u,t-xr,yr,cc)],
["ans16E(Aに合わせる): when xr-xl = yr-yl, yl+xr=yr+xl is true",
on3(t,xl+yl,xl+yr,cc) * on3(u,yl,t-xl,cc),0,
on3(t,xr+yl,xr+yr,oc) * on3(u,t-xr,yr,cc)] ],
/***run***/
cshow(progn," is go."),
on3D2G(ex16),
out : on3D2G(ex16,'typeA),
ans : ans16[1][2]+ans16[1][3]+ans16[1][4],
chkshow(ans16[1][1],out,ans),
out : on3D2G(ex16,'typeB),
ans : ans16[2][2]+ans16[2][3]+ans16[2][4],
chkshow(ans16[2][1],out,ans),
out : on3D2G(ex16,'typeE),
ans : ans16[3][2]+ans16[3][3]+ans16[3][4],
chkshow(ans16[3][1],out,ans),
if member('test, args) then for exans in [[ex15,ans15],[ex14,ans14],[ex13,ans13],
[ex12,ans12],[ex11,ans11],[ex10,ans10],[ex9,ans9],
[ex8,ans8],[ex7,ans7],[ex6,ans6],[ex5,ans5],
[ex4,ans4],[ex3,ans3],[ex2,ans2],[ex1,ans1]] do (
ex : exans[1], ansL : exans[2],
ans : ansL[1][2]+ansL[1][3]+ansL[1][4],
out : on3D2G(exans[1]),
chkshow(ansL[1][1],out,ans),
c0show("-- end of ",progn,"---")
),
return("-- set on3D2G_ex --")
)$ /* end of on3D2G_ex() */
/*#########################################################################*/
/* on3D2G : 矩形領域 D(x,y) 変換 t=x+y, u=y のとき G(t,u) を求める 2020.06.19 */
/*#########################################################################*/
on3D2G([args]) := block([progn:"<on3D2G>",debug,
exans, ex,ans, exL, xL,yL, xl,xr,xlr, yl,yr,ylr, xrng, yrng,type,D,G,
x_l,x_r,y_l,y_r,
t_l,t_r, tl,tr,tlr, tL, u_l,u_r, ul,ur,ulr, uL,
Ga,Gb,out,anss ],
/*#######################################################################*/
/*### plus : minf inf を含む変数x,yの和(差)の演算 2020.06.12 ###*/
/*#######################################################################*/
plus(x,y) := block([],
c1show(x,y),
if (x = -minf) then x : inf,
if (y = -minf) then y : inf,
if (x = -inf) then x : minf,
if (y = -inf) then y : minf,
if (x = minf) and (y = minf) then return(minf),
if (x = inf) and (y = inf) then return(inf),
if (x = minf) and (y # inf) then return(minf),
if (y = minf) and (x # inf) then return(minf),
if (x = inf) and (y # minf) then return(inf),
if (y = inf) and (x # minf) then return(inf),
return(x+y)
), /* end of plus() */
/*##############################################################################*/
/* addjoin : on3項の和の結合 2020.06.27 */
/*##############################################################################*/
addjoin(tl,tr,tlr, ul,ur,ulr) := block([progn:"<addjoin>",debug,
t_l, t_r, tL, uL, iL,indL],
debug:ifargd(),
t_l:[0,0,0], t_r:[0,0,0],
for i:1 thru 3 do (
t_l[i] : if member(tlr[i],[cc,co]) then "c" else "o",
t_r[i] : if member(tlr[i],[oc,cc]) then "c" else "o"
),
c1show(progn,t_l,t_r),
c1show(progn,tl,tr,tlr),
tL:[0,0,0], uL:[0,0,0],
for i:1 thru 3 do (
c1show(i,tl[i],tr[i],tlr[i]),
tL[i] : funmake(on3,[t,tl[i],tr[i],tlr[i]]),
if (tlr[i] # cc) and (tl[i]=tr[i]) then tL[i]:0,
/* 重要 is(equal(minf,0)) -> false, is(equal(minf+inf,0)) -> error */
if (tl[i] # minf+inf) and (tr[i] # minf+inf)
and is(equal(tr[i]-tl[i],0)) then tL[i]:0,
uL[i] : funmake(on3,[u,ul[i],ur[i],ulr[i]]),
if (ulr[i] # cc) and (ul[i]=ur[i]) then uL[i]:0
),
c1show(tL),c1show(uL),
indL : [[1,2],[1,3],[2,3]], c1show(indL),
for iL in indL do (
c1show(iL,tL[iL[1]]),
if (tlr[iL[1]] # cc) and (tl[iL[1]]=tr[iL[1]]) then tL[iL[1]]:0,
if (tlr[iL[2]] # cc) and (tl[iL[2]]=tr[iL[2]]) then tL[iL[2]]:0,
if (uL[iL[1]]=uL[iL[2]]) and (tr[iL[1]]=tl[iL[2]]) and (tL[iL[1]] # 0)
then (
c1show("match : ",iL),
tr[iL[1]]:tr[iL[2]],
tlr[iL[1]]:eval_string(sconcat(t_l[iL[1]],t_r[iL[2]])),
tl[iL[2]] : minf, tr[iL[2]]:minf,tlr[iL[2]]:oo,
tL[iL[1]] : funmake(on3,[t,tl[iL[1]],tr[iL[1]],tlr[iL[1]]]),
if (tlr[iL[1]] # cc) and (tl[iL[1]]=tr[iL[1]]) then tL[iL[1]]:0,
tL[iL[2]] : 0,
c1show(tL)
)
), /* end of for iL */
c1show(progn,tL),c1show(progn,uL),
return([tL,uL])
), /* end of addjoin() */
/***main part of on3D2G *****************************************************/
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
if args[1]='test then go(block_test),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3D2G('help)--
機能: on3D2G : 矩形領域 D(x,y) 変換 t=x+y, u=y のとき G(t,u) を求める
文法: on3D2G(on3(x,xl,xr,xlr)*on3(y,yl,yr,ylr),'typeA|'typeB|'typeE)
or on3D2G([on3,x,xl,xr,xlr],[on3,y,yl,yr,ylr],'typeA|'typeB|'typeE)
on3D2G('ex|'test)
例示: on3D2G([on3,x,xl,xr,cc],[on3,y,yl,yr,oc],'typeA)
-> on3(t,tl,tr,tlr)*on3(u,ul,ur,ulr) + ...
--end of on3D2G('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
block([progn:"<on3D2G('ex)>",debug,x,xl,xr,y,yl,yr,ex,out],
ex : on3(x,xl,xr,co)*on3(y,yl,yr,cc),
c0show(on3D2G(ex)),
c0show(on3D2G(ex,'typeA)),
c0show(on3D2G(ex,'typeB)),
c0show(on3D2G(ex,'typeE)),
ex : on3(x, xl, xr, cc) * on3(y, yl, inf, co),
c0show(on3D2G(ex)),
return("--end of on3D2g('ex)--")
),
return('normal_return),
block_test, /* test ブロック ===================================*/
block([progn:"<on3D2G('test)>",debug],
on3D2G_ex('test),
return("--end of on3D2G('test)--")
),
return("on3D2G('test) is normal_return"),
block_main, /* main ブロック ====================================*/
if listp(args[1]) # true then (
ex : ev(args[1]),
exL : f2l(ex),
c1show(progn,ex), c1show(exL),
xL : exL[3], yL : exL[4],
c1show(progn,xL,yL)
),
if (length(args)>=2) and listp(args[1]) and listp(args[2]) then (
/* [on3,x,xl,xr,xlr], [on3,y,yl,yr,ylr] */
if listp(args[1]) then xL : args[1] else xL : f2l(args[1]),
if listp(args[2]) then yL : args[2] else yL : f2l(args[2])
),
xl : xL[3], xr : xL[4], xlr : xL[5], xrng : plus(xr,-xl),
yl : yL[3], yr : yL[4], ylr : yL[5], yrng : plus(yr,-yl),
c0show("-- D:xl<x<xr, yl<y<yr --(t=x+y,u=y)--> G:G(t,u) --"),
c0show("◇ ",ex),
/* 自己判定 */
type:"by Case",
if is(xrng > yrng) then type:"A"
else if is(xrng < yrng) then type:"B"
else if is(xrng = yrng) then type:"E",
c1show("自己判定結果 ",type),
/* 自己判定結果が "by Case" の場合, 引数指定に基づく仮定を適用する */
if type="by Case" then (
if member('typeA,args) then (
c0show("判定結果: by Case -> type A (xrng > yrng) を仮定する"),
type:"A", assume(xrng > yrng)
),
if member('typeB,args) then (
c0show("判定結果: by Case -> type B (xrng < yrng) を仮定する"),
type:"B", assume(xrng < yrng)
),
if member('typeE,args) then (
c0show("判定結果: by Case -> type E (xrng = yrng) を仮定する"),
type:"E", assume(equal(xrng , yrng))
)
),
c0show(xL,yL),c0show(xrng,yrng,type,facts(yr)),
if type="by Case" then (
G(t,u) := if xrng <= yrng then
'on3(t,yl+xl,yr+xl,cc)*on3(u,yl,t-xl,cc)
+ 'on3(t,yr+xl,yl+xr,oc)*on3(u,yl,yr,cc)
+ 'on3(t,yl+xr,yr+xr,oc)*on3(u,t-xr,yr,cc)
else
'on3(t,yl+xl,yl+xr,cc)*on3(u,yl,t-xl,cc)
+ 'on3(t,yl+xr,yr+xl,oc)*on3(u,t-xr,t-xl,cc)
+ 'on3(t,yr+xl,yr+xr,oc)*on3(u,t-xr,yr,cc),
c0show(G(t,u)),
return(G(t,u))
),
if member(xlr,[cc,co]) then x_l:"c" else x_l:"o",
if member(xlr,[cc,oc]) then x_r:"c" else x_r:"o",
if member(ylr,[cc,co]) then y_l:"c" else y_l:"o",
if member(ylr,[cc,oc]) then y_r:"c" else y_r:"o",
c0show(x_l,x_r,y_l,y_r),
/* D(x,y) := on3(x,xl,xr,xlr)*on3(y,yl,yr,ylr), */
/* t = x+y, u = y */
/*=== type A (xrng > yrng) ===========================================
Ga[1] = 'on3(t,yl+xl,yr+xl,cc)*on3(u,yl,t-xl,cc)
Ga[2] = 'on3(t,yr+xl,yl+xr,oc)*on3(u,yl,yr,cc)
Ga[3] = 'on3(t,yl+xr,yr+xr,oc)*on3(u,t-xr,yr,cc)
=== type B (xrng < yrng) ============================================
Gb[1] = 'on3(t,yl+xl,yl+xr,cc)*on3(u,yl,t-xl,cc)
Gb[2] = 'on3(t,yl+xr,yr+xl,oc)*on3(u,t-xr,t-xl,cc)
Gb[3] = 'on3(t,yr+xl,yr+xr,oc)*on3(u,t-xr,yr,cc)
=== type E (xrng = yrng) ============================================
Ge[1] = 'on3(t,yl+xl,yr+xl,cc)*on3(u,yl,t-xl,cc) <- yr+xl=yl+xr
Ge[2] = 'on3(t,yr+xl,yl+xr,oc)*on3(u,ul*,ur*,cc)=0 <- yl+xr=yr+xl
Ge[3] = 'on3(t,yl+xr,yr+xr,oc)*on3(u,t-xr,yr,cc) <- yl+xr=yr+xl
type E は type A type B において第2項が0になり第1項,第3項が一致する
=====================================================================
上記3項における t, u の開閉は, xl,xr,yl,yrがすべてc(閉)の場合を示す.
変数tの開閉は cc,oc,oc 以外に co,co,cc が許される.
以下に t,u の具体的な開閉の定義規則を与える
on3(x,xl,xr,xlr)*on3(y,yl,yr,ylr)
xlr -> x_l, x_r, ylr -> y_l, y_r : "c" or "o"
on3(t,tl[i],tr[i],tlr[i])*on3(u,ul[i],ur[i],ulr[i])
=======================================================================*/
/*### iflr##############################################################*/
iflr(x_lr,y_lr,tu_lr) := block([progn:"<iflr>",debug,out],
out : if (x_lr="c") and (y_lr="c") and (tu_lr="o") then "c" else "o",
return(out)
), /* end of iflr() */
tl:[0,0,0], tr:[0,0,0], tlr:[0,0,0], t_l:["x","x","x"], t_r:["x","x","x"],
ul:[0,0,0], ur:[0,0,0], ulr:[0,0,0], u_l:["x","x","x"], u_r:["x","x","x"],
tl[1] : plus(xl,yl),
t_l[1] : iflr(x_l,y_l,"o"),
tr[1] : if type # "B" then plus(xl,yr) else plus(xr,yl),
t_r[1] : if type # "B" then iflr(x_l,y_r,"o") else iflr(x_r,y_l,"o"),
tlr[1] : eval_string(sconcat(t_l[1],t_r[1])),
tl[2] : if type # "B" then plus(xl,yr) else plus(xr,yl),
t_l[2] : if type # "B" then iflr(x_l,y_r,t_r[1]) else iflr(x_r,y_l,t_r[1]),
tr[2] : if type # "B" then plus(xr,yl) else plus(xl,yr),
t_r[2] : if type # "B" then iflr(x_r,y_l,"o") else iflr(x_l,y_r,"o"),
tlr[2] : eval_string(sconcat(t_l[2],t_r[2])),
tl[3] : if type # "B" then plus(xr,yl) else plus(xl,yr),
t_l[3] : if type # "B" then iflr(x_r,y_l,t_r[2]) else iflr(x_l,y_r,t_r[2]),
tr[3] : plus(xr,yr),
t_r[3] : iflr(x_r,y_r,"o"),
tlr[3] : eval_string(sconcat(t_l[3],t_r[3])),
ul[1] : yl,
u_l[1] : y_l,
ur[1] : plus(t,-xl),
u_r[1] : x_l,
ulr[1] : eval_string(sconcat(u_l[1],u_r[1])),
ul[2] : if type # "B" then yl else plus(t,-xr),
u_l[2] : if type # "B" then y_l else x_r,
ur[2] : if type # "B" then yr else plus(t,-xl),
u_r[2] : if type # "B" then y_r else x_l,
ulr[2] : eval_string(sconcat(u_l[2],u_r[2])),
ul[3] : plus(t,-xr),
u_l[3] : x_r,
ur[3] : yr,
u_r[3] : y_r,
ulr[3] : eval_string(sconcat(u_l[3],u_r[3])),
c0show("before join & reduce ->"),
c0show(tl,tr,tlr),
c0show(ul,ur,ulr),
if type="E" then
G(t,u) := funmake(on3,[t,tl[1],tr[1],tlr[1]])*funmake(on3,[u,ul[1],ur[1],ulr[1]])
+ funmake(on3,[t,tl[3],tr[3],tlr[3]])*funmake(on3,[u,ul[3],ur[3],ulr[3]])
else
G(t,u) := funmake(on3,[t,tl[1],tr[1],tlr[1]])*funmake(on3,[u,ul[1],ur[1],ulr[1]])
+ funmake(on3,[t,tl[2],tr[2],tlr[2]])*funmake(on3,[u,ul[2],ur[2],ulr[2]])
+ funmake(on3,[t,tl[3],tr[3],tlr[3]])*funmake(on3,[u,ul[3],ur[3],ulr[3]]),
c1show(G(t,u)),
/* xl,xr,yl,yr が minf, inf の場合を含めて"和"を定める.(minf+infは未処理とする) */
/* 項の結合 join : on3(t,t1l,t1r,tllr)*same + on3(t,t2l,t2r,t2lr)*same
- when t1r=t2l -> on3(t,t1l,t2r,t12lr)*same */
[tL, uL] : addjoin(tl,tr,tlr, ul,ur,ulr), /* addjpin の呼び出し */
c0show("after join & reduce ->"),c0show(tL), c0show(uL),
/*### output by chkshow ##################################*/
out : tL[1]*uL[1]+tL[2]*uL[2]+tL[3]*uL[3],
forget([xrng > yrng, xrng < yrng, xrng = yrng]),
return(out)
)$ /* end of on3D2G */
/*######################################################################*/
/* <on3factor>: on3poly の関数部を因数分解した表現を返す */
/*######################################################################*/
on3factor([args]) := block([progn:"<on3factor>",debug,expr, L:[],
sum,ton3,func,funcL:[],
on3type,on3none,on3monoone,on3mono,on3inv,on3poly,on3polyinv,on3unknown],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3factor('help)--
機能: on3poly の関数部を因数分解した表現を返す
文法: on3factor(expr,...)
例示: ex = x*on3(x,3,4,co)+(x^2-2*x+1)*on3(x,1,2,co)$
on3factor(ex);
-> x*on3(x,3,4,co)+(x-1)^2*on3(x,1,2,co)
--end of on3factor('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3factor('ex)--"),
/* on3factor_ex(), */
block([progn:"<on3factor('ex)>",debug,ex],
debug:ifargd(),
ex : (x^2-2*x+1)*on3(x,1,2,co)+ x*on3(x,3,4,co),
print("---ex---"),
ldisplay(ex),
cshow(on3factor(ex)),
return("--- end of on3factor('ex) ---")
), /* end of block */
print("--end of on3factor('ex)--"),
return("--end of on3factor('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
expr : on3std(expr),
if listp(expr) then L : copylist(L)
else L : f2l(expr),
on3type:on3typep(L), /* call on3typep */
d1show(on3type),
/*** on3poly 出ない場合は無処理とする ***/
if on3type # on3poly then return(expr),
sum : 0,
for i:2 thru length(L) do ( /* 関数部とon3部を分離する */
ton3:1,
funcL : scanmap(lambda([u], if listp(u) and u[1]=on3 then
(ton3:ton3*l2f(u), u:1) else u ), L[i]),
func : factor(l2f(funcL)), /* 関数部の因数分解 */
d2show(func,ton3),
sum : sum + func*l2f(ton3)
), /* end of for-i */
d1show(sum),
return(sum)
)$ /* end of on3factor() */
/*### --- fsplit: on3dim2_uni2.mx --- ##################################*/
/* <on3dim2_uni2> : 一様分布の和の分布 2019.06.21 */
/*######################################################################*/
on3dim2_uni2([args]) := block([progn:"<on3dim2_uni2>",debug,out,cmds,ans,
plotmode:true,viewmode:false,olddisplay2d,
x,y,t,u,f,g,h, xmean,xvar,xsd,nord, gh,gf,ga,dlist,glist,L],
debug:ifargd(),
if member(noplot,args) then (
plotmode:false, print("---Run with NoPlot Mode---") ),
if member(view,args) then (
viewmode:true, print("---Run with View Mode---") ),
if member(noview,args) then (
viewmode:false, print("---Run with NoView Mode---") ),
printf(true," 一様分布 U[0,1]に従う独立確率変数の和の分布(密度関数)を求める~%"),
olddisplay2d:display2d, display2d:true,
local(f,g,h,gh,gf,nord),
/*** 1個の和の分布 ********************************************/
print("◆ 1個の和の分布"),
f[1](t) := 1*on3(t,0,1,cc),
mshow(f[1](t)),
cmds : sconcat("( ",
"f[1](t)",
" )"),
ans : on3(t,0,1,cc),
chk1show(cmds,ans),
on3show(f[1](t)),
/*** 2個の和の分布 ********************************************/
print("◆ 2個の和の分布"),
g[2](x,y) := f[1](x)*f[1](y),
mshow(g[2](x,y)),
/* cshow("n=2",values),cshow(findstr(h)),*/
/* remarray(h), */
h[2](t,u) := on3chgv(g[2](x,y)), /* 同時分布 */
cshow(h[2](t,u)),
out : on3integ19(h[2](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
out : out_outf, killvars(["out_"]),
define(f[2](t), out),
cmds : sconcat("( ",
"f[2](t)",
" )"),
ans : t*on3(t,0,1,co) - (t-2)*on3(t,1,2,co),
chk1show(cmds,ans),
display2d:true, on3show(f[2](t)), display2d:false,
/*** 3個の和の分布 *********************************************/
print("◆ 3個の和の分布"),
g[3](x,y) := f[2](x)*f[1](y),
mshow(g[3](x,y)),
h[3](t,u) := on3chgv(g[3](x,y)), /* 同時分布 */
mshow(h[3](t,u)),
out : on3integ19(h[3](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
out : out_outf, killvars(["out_"]),
define(f[3](t), out),
cmds : sconcat("( ",
"f[3](t)",
" )"),
ans : t^2/2*on3(t,0,1,co) - (2*t^2-6*t+3)/2*on3(t,1,2,co)
+ (t-3)^2/2*on3(t,2,3,co),
display2d:false, chk1show(cmds,ans),
display2d:true, on3show(f[3](t)), display2d:false,
/*** 4個の和の分布 *********************************************/
print("◆ 4個の和の分布"),
g[4](x,y) := f[2](x)*f[2](y),
mshow(g[4](x,y)),
h[4](t,u) := on3chgv(g[4](x,y)), /* 同時分布 */
mshow(h[4](t,u)),
out : on3integ19(h[4](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
out : out_outf, killvars(["out_"]),
define(f[4](t), out),
cmds : sconcat("( ",
"f[4](t)",
" )"),
ans : t^3/6*on3(t,0,1,co) - (3*t^3-12*t^2+12*t-4)/6*on3(t,1,2,co)
+ (3*t^3-24*t^2+60*t-44)/6*on3(t,2,3,co)
- (t-4)^3/6*on3(t,3,4,co),
chk1show(cmds,ans),
display2d:true, on3show(f[4](t)), display2d:false,
/*** 5個の和の分布 *********************************************/
print("◆ 5個の和の分布"),
g[5](x,y) := f[3](x)*f[2](y),
mshow(g[5](x,y)),
h[5](t,u) := on3chgv(g[5](x,y),debug0), /* 同時分布 */
mshow(h[5](t,u)),
out : on3integ19(h[5](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
c1show(progn,out_outf),
out : out_outf, killvars(["out_"]),
c1show(progn,out),
define(f[5](t), out),
cmds : sconcat("( ",
"f[5](t)",
" )"),
ans : t^4/24*on3(t,0,1,co)
- (4*t^4-20*t^3++30*t^2-20*t+5)/24*on3(t,1,2,co)
+ (6*t^4-60*t^3+210*t^2-300*t+155)/24*on3(t,2,3,co)
- (4*t^4-60*t^3+330*t^2-780*t+655)/24*on3(t,3,4,co)
+ (t-5)^4/24*on3(t,4,5,co),
chk1show(cmds,ans),
display2d:true, on3show(f[5](t)), display2d:false,
/*** 結果の作図 ***/
if plotmode then (
gh[1] : gr2d(title="h(t) = f[1](t), t=x_1",
grid=true, yrange=[-0.5, 1.5], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[1](t), t,-1, 2), ylabel="Dens."),
gh[2] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[2](t,u), t = x_1, u = x_2",
xlabel="t", ylabel="u", zlabel="h[2](t,u)",
explicit(h[2](t,u), t,-1,3, u,-1,3)
),
gh[3] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[3](t,u), t = x_1 + x_2, u = x_3",
xlabel="t", ylabel="u", zlabel="h[3](t,u)",
explicit(h[3](t,u), t,-1,3, u,-1,3)
),
gh[4] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[4](t,u), t = x_1 + x_2, u = x_3 + x_4",
xlabel="t", ylabel="u", zlabel="h[4](t,u)",
explicit(h[4](t,u), t,-1,4, u,-1,4)
),
gh[5] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[5](t,u), t = x_1 + x_2 + x_3, u = x_4 + x_5",
xlabel="t", ylabel="u", zlabel="h[5](t,u)",
explicit(h[5](t,u), t,-1,5, u,-1,5)
),
gf[1] : gr2d(title="f[1](t)",
grid=true, yrange=[-0.5, 1.5], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[1](t), t,-1, 2), ylabel="Dens."),
gf[2] : gr2d(title="f[2](t)",
grid=true, yrange=[-0.5, 1.5], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[2](t), t,-1, 3), ylabel="Dens."),
gf[3] : gr2d(title="f[3](t)",
grid=true, yrange=[-0.2, 1.2], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[3](t), t,-0.5, 3.5), ylabel="Dens."),
gf[4] : gr2d(title="f[4](t)",
grid=true, yrange=[-0.2, 1.0], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[4](t), t,0, 4), ylabel="Dens."),
gf[5] : gr2d(title="f[5](t)",
grid=true, yrange=[-0.1, 0.9], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[5](t), t, 0.5, 4.5), ylabel="Dens."),
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3dim2_uni2-sum"),
columns=2, dimensions=[1000,1500]],
glist : [gh[1],gf[1], gh[2],gf[2], gh[3],gf[3], gh[4],gf[4], gh[5],gf[5]],
if viewmode then mk_draw(glist,dlist,'view)
else mk_draw(glist,dlist,'noview),
/* 和の分布から平均の分布(確率密度関数)への変換 */
kill(x),
/* gav[1](x) := ratsubst(x,t,f[1](t)), */
for i:1 thru 5 do
gav[i](x) := ratsubst(i*x,t, f[i](t)) * i,
/* 一様分布U[0,1]の平均xmean=1/2,分散xvar=1/12 から
算術平均 AV=(X_1 + ,,, + x_n)/n の平均E(AV)=xmean, 分散V(AV)=xvar/n を求め,
正規分布N(E(AV),V(AV)) の確率密度関数 nord[n](x) を作成する. */
xmean : 1/2, xvar : 1/12,
for i:1 thru 5 do (
xsd : sqrt(xvar/i),
define(nord[i](x), 1/(sqrt(2*%pi)*xsd) * %e^(-((x-xmean)/xsd)^2/2)),
c1show(nord[i](x))
),
/* av[n](x) の確率密度関数 gav[n](x) と
正規分布N(E(AV),V(AV)) の確率密度関数 nord[n](x)の gr2dオブジェクト ga[n] */
for i:1 thru 5 do (
L : [title=sconcat("av[",i,"](x)"),
grid=true, yrange=[-0.1, 3.5], line_width=1.5, ylabel="Dens.",
color=red, key=sconcat("av(",i,")"), line_type=solid,
explicit(gav[i](x), x, -0.1, 1.1),
color=blue, key="Nor. Dens.", line_type=dots,
explicit(nord[i](x), x, -0.1, 1.1)],
ga[i] : funmake(gr2d, L)
),
glist : [gf[1],ga[1], gf[2],ga[2], gf[3],ga[3], gf[4],ga[4], gf[5],ga[5]],
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3dim2_uni2-av"),
columns=2, dimensions=[1000,1500]],
if viewmode then mk_draw(glist,dlist,'view)
else mk_draw(glist,dlist,'noview)
), /* end of plotmode */
/*** example end *********************************************/
remarray(f,g,h, gh,gf,ga,nord),
kill(f,g,h, gh,gf,ga,nord),
display2d:olddisplay2d,
return("---end of on3dim2_uni2 ---")
)$
/*### --- fsplit: on3dim2_exp2.mx --- ##################################*/
/* <on3dim2_exp2> : 指数分布の和の分布 2019.06.21 */
/*######################################################################*/
on3dim2_exp2([args]) := block([progn:"<on3dim2_exp2>",debug,out,ans,
plotmode:true,viewmode:false,olddisplay2d,
x,y,t,u,f,g,h, xmean,xvar,xsd,nord, gh,gf,ga,dlist,glist,L],
debug:ifargd(),
if member(noplot,args) then (
plotmode:false, print("---Run with NoPlot Mode---") ),
if member(view,args) then (
viewmode:true, print("---Run with View Mode---") ),
if member(noview,args) then (
viewmode:false, print("---Run with NoView Mode---") ),
printf(true," 指数分布 Ex(1)に従う独立確率変数の和の分布(密度関数)を求める~%"),
olddisplay2d:display2d, display2d:true,
local(f,g,h,gh,nord,gf),
/*** 1個の和の分布 ********************************************/
print("◆ 1個の和の分布"),
f[1](t) := %e^(-t)*on3(t,0,inf,co),
mshow(f[1](t)),
cmds : sconcat("( ",
"f[1](t)",
" )"),
ans : %e^(-t)*on3(t,0,inf,co),
chk1show(cmds,ans),
on3show(f[1](t)),
/*** 2個の和の分布 ********************************************/
print("◆ 2個の和の分布"),
g[2](x,y) := f[1](x)*f[1](y),
mshow(g[2](x,y)),
/* cshow("n=2",values),cshow(findstr(h)),*/
/* remarray(h), */
h[2](t,u) := on3chgv(g[2](x,y)), /* 同時分布 */
mshow(h[2](t,u)),
out : on3integ19(h[2](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
c1show(progn,out_outf),
out : out_outf, killvars(["out_"]),
c1show(progn,out),
define(f[2](t), out),
cmds : sconcat("( ",
"f[2](t)",
" )"),
ans : t*%e^(-t)*on3(t,0,inf,co),
chk1show(cmds,ans),
display2d:true, on3show(f[2](t)), display2d:false,
/*** 3個の和の分布 *********************************************/
print("◆ 3個の和の分布"),
g[3](x,y) := f[2](x)*f[1](y),
mshow(g[3](x,y)),
h[3](t,u) := on3chgv(g[3](x,y)), /* 同時分布 */
mshow(h[3](t,u)),
out : on3integ19(h[3](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
c1show(progn,out_outf),
out : out_outf, killvars(["out_"]),
c1show(progn,out),
define(f[3](t), out),
cmds : sconcat("( ",
"f[3](t)",
" )"),
ans : t^2/2*%e^(-t)*on3(t,0,inf,co),
display2d:false, chk1show(cmds,ans),
display2d:true, on3show(f[3](t)), display2d:false,
/*** 4個の和の分布 *********************************************/
print("◆ 4個の和の分布"),
g[4](x,y) := f[2](x)*f[2](y),
mshow(g[4](x,y)),
h[4](t,u) := on3chgv(g[4](x,y)), /* 同時分布 */
mshow(h[4](t,u)),
out : on3integ19(h[4](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
c1show(progn,out_outf),
out : out_outf, killvars(["out_"]),
c1show(progn,out),
define(f[4](t), out),
cmds : sconcat("( ",
"f[4](t)",
" )"),
ans : t^3/3!*%e^(-t)*on3(t,0,inf,co),
chk1show(cmds,ans),
display2d:true, on3show(f[4](t)), display2d:false,
/*** 5個の和の分布 *********************************************/
print("◆ 5個の和の分布"),
g[5](x,y) := f[3](x)*f[2](y),
h[5](t,u) := on3chgv(g[5](x,y)), /* 同時分布 */
mshow(h[5](t,u)),
if false then mshow(h[5](t,u)),
out : on3integ19(h[5](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
c1show(progn,out_outf),
out : out_outf, killvars(["out_"]),
c1show(progn,out),
define(f[5](t), out),
cmds : sconcat("( ",
"f[5](t)",
" )"),
ans : t^4/4!*%e^(-t)*on3(t,0,inf,co),
chk1show(cmds,ans),
display2d:true, on3show(f[5](t)), display2d:false,
/*** 結果の作図 ***/
if plotmode then (
gh[1] : gr2d(title="h(t) = f[1](t), t=x_1",
grid=true, yrange=[-0.1, 1.1], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[1](t), t,-1, 6), ylabel="Dens."),
gh[2] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[2](t,u), t = x_1, u = x_2",
xlabel="t", ylabel="u", zlabel="h[2](t,u)",
explicit(h[2](t,u), t,-1,6, u,-1,6)
),
gh[3] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[3](t,u), t = x_1 + x_2, u = x_3",
xlabel="t", ylabel="u", zlabel="h[3](t,u)",
explicit(h[3](t,u), t,-1,8, u,-1,8)
),
gh[4] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[4](t,u), t = x_1 + x_2, u = x_3 + x_4",
xlabel="t", ylabel="u", zlabel="h[4](t,u)",
explicit(h[4](t,u), t,-1,10, u,-1,10)
),
gh[5] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[5](t,u), t = x_1 + x_2 + x_3, u = x_4 + x_5",
xlabel="t", ylabel="u", zlabel="h[5](t,u)",
explicit(h[5](t,u), t,-1,12, u,-1,12)
),
gf[1] : gr2d(title="f[1](t)",
grid=true, yrange=[-0.1, 1.1], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[1](t), t,-1, 6), ylabel="Dens."),
gf[2] : gr2d(title="f[2](t)",
grid=true, yrange=[-0.1, 0.5], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[2](t), t,-1, 6), ylabel="Dens."),
gf[3] : gr2d(title="f[3](t)",
grid=true, yrange=[-0.1, 0.4], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[3](t), t,-1,8), ylabel="Dens."),
gf[4] : gr2d(title="f[4](t)",
grid=true, yrange=[-0.05, 0.3], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[4](t), t,-1, 10), ylabel="Dens."),
gf[5] : gr2d(title="f[5](t)",
grid=true, yrange=[-0.05, 0.25], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[5](t), t, -1, 12), ylabel="Dens."),
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3dim2_exp2-sum"),
columns=2, dimensions=[1000,1500]],
glist : [gh[1],gf[1], gh[2],gf[2], gh[3],gf[3], gh[4],gf[4], gh[5],gf[5]],
if viewmode then mk_draw(glist,dlist,'view)
else mk_draw(glist,dlist,'noview),
/* 和の分布から平均の分布(確率密度関数)への変換 */
kill(x),
gav[1](x) := ratsubst(x,t,f[1](t)),
for i:2 thru 5 do
gav[i](x) := ratsubst(i*x,t, f[i](t)) * i,
/* 指数分布Ex(1)の平均xmean=1,分散xvar=1 から
算術平均 AV=(X_1 + ,,, + x_n)/n の平均E(AV)=xmean, 分散V(AV)=xvar/n を求め,
正規分布N(E(AV),V(AV)) の確率密度関数 nord[n](x) を作成する. */
xmean : 1, xvar : 1,
for i:1 thru 5 do (
xsd : sqrt(xvar/i),
define(nord[i](x), 1/(sqrt(2*%pi)*xsd) * %e^(-((x-xmean)/xsd)^2/2)),
c1show(nord[i](x))
),
/* av[n](x) の確率密度関数 gav[n](x) と
正規分布N(E(AV),V(AV)) の確率密度関数 nord[n](x)の gr2dオブジェクト ga[n] */
for i:1 thru 5 do (
L : [title=sconcat("av[",i,"](x)"),
grid=true, yrange=[-0.1, 1.1], line_width=1.5, ylabel="Dens.",
color=red, key=sconcat("av(",i,")"), line_type=solid,
explicit(gav[i](x), x, -1, 6),
color=blue, key="Nor. Dens.", line_type=dots,
explicit(nord[i](x), x, -1, 6)],
ga[i] : funmake(gr2d, L)
),
glist : [gf[1],ga[1], gf[2],ga[2], gf[3],ga[3], gf[4],ga[4], gf[5],ga[5]],
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3dim2_exp2-av"),
columns=2, dimensions=[1000,1500]],
if viewmode then mk_draw(glist,dlist,'view)
else mk_draw(glist,dlist,'noview)
), /* end of plotmode */
/*** example end *********************************************/
remarray(f,g,h, gh,gf,ga,nord),
kill(f,g,h, gh,gf,ga,nord),
display2d:olddisplay2d,
return("---end of on3dim2_exp2 ---")
)$
/*--- fsplit: on3debug.mx ----------------------------------------------*/
/*######################################################################*/
/* <cashow>: 表示関数 (無修飾) */
/*######################################################################*/
cashow([lis])::=block([i,u,ans:[],n:length(lis),sp],
/* ans:append(ans,["Check in",progn,":"]), */
sp:"->",
ans:append(ans,[" "]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"->",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [""] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <c0show>: 表示関数 (無修飾) */
/*######################################################################*/
c0show([lis])::=block([i,u,ans:[],n:length(lis)],
/* ans:append(ans,["Check in",progn,":"]), */
ans:append(ans,[" "]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [""] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <cshow>: 表示関数 */
/*######################################################################*/
cshow([lis])::=block([i,u,ans:[],n:length(lis)],
/* ans:append(ans,["Check in",progn,":"]), */
ans:append(ans,["CS:"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <c1show>: チェック用表示関数(debug >= 1 のときに表示する) */
/*######################################################################*/
c1show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 1 then return(),
ans:append(ans,["C1:"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <c2show>: チェック用表示関数(debug >= 2 のときに表示する) */
/*######################################################################*/
c2show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 2 then return(),
ans:append(ans,["C2:"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <c3show>: チェック用表示関数(debug >= 3 のときに表示する) */
/*######################################################################*/
c3show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 3 then return(),
ans:append(ans,["C3:"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <d1show>: デバック用表示関数(debug >= 1 のときに表示する) */
/*######################################################################*/
d1show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 1 then return(),
ans:append(ans,["D1 in",progn,":"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <d2show>: デバック用表示関数(debug >= 2 のときに表示する) */
/*######################################################################*/
d2show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 2 then return(),
ans:append(ans,["D2 in",progn,":"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <d3show>: デバック用表示関数(debug >= 3 のときに表示する) */
/*######################################################################*/
d3show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 3 then return(),
ans:append(ans,["D3 in",progn,":"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*############################################################################*/
/*### logshow : 入力履歴(文字列)の一括評価 ######################################*/
/*############################################################################*/
logshow([args]) := block([progn:"<chkshow>",debug,cmds, cmdsL,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of logshow('help)--
機能: 入力履歴(文字列)の一括評価
文法: logshow(cmds,...)
例示: logshow(cmds)
--end of logshow('help')--
" ),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of logshow('ex)--"),
block([cmds,f,df,out],
cmds : sconcat("( /* Ex. of on3diff(f,x) */ ",
"f : x^3*on3(x,1,3,co), df : on3diff(f,x) ) "),
out : logshow(cmds),
c0show(out)
),
print("--end of logshow('ex)--"),
return("--end of logshow('ex)--"),
block_main, /* main ブロック ====================================*/
cmds : args[1],
cmdsL : split(cmds,"@"),
cmds : sremove("@",cmds),
for i thru length(cmdsL) do
if i=1 then print("★ ",cmdsL[1]) else print(" ",cmdsL[i]),
out : eval_string(cmds), /* 入力履歴(文字列)の一括評価 */
return(out)
)$ /* end of logshow() */
/*############################################################################*/
/*### chk1show : 入力履歴と結果の検証 #########################################*/
/*############################################################################*/
chk1show([args]) := block([progn:"<chkshow>",debug,cmds,ans, hlp,hlpL,
cmdsL,w_out,chk,chkm],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of chk1show('help)--
機能: 入力履歴と結果の検証
文法: chk1show(cmds,ans,...)
例示:
chk1show(\"/* Ex.0 of chk1show */ @ diff(sin(x),x)\" , cos(x))
cmds : sconcat(\"(\",
\"/* chk1showの使用例 */ @\",
\"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @\",
\"F : on3integ19(f,x), \",
\"F : on3decomp(F) \",
\")\"
),
Fans : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)
+2*f1*on3(x,3,4,co)+f1*(x-1)*on3(x,1,3,co),
chk1show(cmds,Fans),
chk1show(cmds,\"\"), /* (検証なしの場合) */
--end of chk1show('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of chk1show('ex)--"),
block([progn:"<chk1show_ex>",debug,cmds,Fans,f,f1,f2,F,out,a,b,assL],
chk1show("/* 例0. ダイレクト使用 */ @ diff(sin(x),x)" , cos(x)),
cmds : sconcat("(",
"/* 例1 chk1showの使用例 */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @",
"F : on3integ19(f,x), ",
"F : on3decomp21(F) ",
")"),
Fans : 2*(f2+f1)*on3(x,6,inf,co) + (f2*x-4*f2+2*f1)*on3(x,4,6,co)
+ 2*f1*on3(x,3,4,co) + f1*(x-1)*on3(x,1,3,co),
chk1show(cmds,Fans),
cmds : sconcat("(",
"/* 例2 chk1showの使用例(検証なしの例) */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @",
"F : on3integ19(f,x), ",
"F : on3decomp21(F) ",
")"),
chk1show(cmds,""),
cmds : sconcat("(",
"/* 例3 後処理が必要な場合:仮定の設定,ソート,仮定の解除 */ @",
"assL : [1<a, a<3, 3<b], apply('assume, assL), @",
"out : ecsort([1,3,a,b]), forget(assL), out @",
")"
),
chk1show(cmds,[1,a,3,b])
), /* end of block */
print("--end of chk1show('ex)--"),
return("--end of chk1show('ex)--"),
block_main, /* main ブロック ====================================*/
cmds : args[1], ans : args[2],
if stringp(cmds)=true then (
cmdsL : split(cmds,"@"),
cmds : sremove("@",cmds),
for i thru length(cmdsL) do
if i=1 then print("★ ",cmdsL[1]) else print(" ",cmdsL[i]),
w_out : eval_string(cmds) /* 入力履歴(文字列)の一括評価 */
) else w_out:cmds, /* cmds = out の場合 */
if ans="" then (print(" out = ",w_out),return(w_out)),
if stringp(ans)=true then ans : eval_string(ans),
if listp(w_out) and is(equal(w_out,ans))=true then (chk:true, chkm:"◎ ")
else (chk:false, chkm:"❌ ", chkerrsum : chkerrsum + 1),
if listp(w_out)=false then (
if numberp(w_out) and abs(w_out-ans) < 1.0E-8
then (chk:true, chkm:"◎ ")
else if is(equal(expand(w_out),expand(ans)))=true then (chk:true, chkm:"◎ ")
else (chk:false, chkm:"❌ ", chkerrsum : chkerrsum + 1)
),
if slength(sconcat(w_out)) < 500
then print(chkm,"out =",w_out)
else print(chkm,"reveal(w_out,6) =", reveal(w_out,6)),
if chk=false then print(" <- ans =",ans),
return(w_out)
)$ /* end of chkshow */
/*############################################################################*/
/*### chk2show : 入力履歴と結果の検証 #########################################*/
/*############################################################################*/
chk2show([args]) := block([progn:"<chk2show>",debug,cmds,ans, hlp,hlpL,
cmdsansL,cmdsL,w_out,outL, chk,chkm],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
block([cmds,Fans],
printf(true,"
--begin of chk2show('help)--
機能: 入力履歴と結果の検証
文法: chk2show(cmds,ans,...), chk2show([[cmds1,ans1]])
chk2show([[cmds1,ans1],[cmds2.ans2],...])
例示:
cmds : sconcat(\"(\",
\"/* chk2showの使用例 */ @\",
\"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @\",
\"F : on3integ19(f,x), \",
\"F : on3decomp(F) \",
\")\"
),
Fans : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)
+2*f1*on3(x,3,4,co)+f1*(x-1)*on3(x,1,3,co),
chk2show(cmds,Fans),
chk2show(cmds,\"\"), /* (検証なしの場合) */
--end of chk2show('help')--
"
)),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of chk2show('ex)--"),
block([progn:"<chk2show_ex>",debug,f,f1,f2,F,cmds1,Fans1,cmds2,Fans2,outL],
cmds1 : sconcat("(",
"/* chk2showの使用例1 */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @",
"F : on3integ19(f,x), ",
"F : on3decomp(F) ",
")"),
Fans1 : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)+2*f1*on3(x,3,4,co)
+f1*(x-1)*on3(x,1,3,co),
cmds2 : sconcat("(",
"/* chk2showの使用例2 */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,2,6,co), /* fの定義 */ @",
"F : on3integ19(f,x), ",
"F : on3decomp(F) ",
")"),
Fans2 : 2*(2*f2+f1)*on3(x,6,inf,co)+(f2*x-2*f2+2*f1)*on3(x,3,6,co)
+(f2*x+f1*x-2*f2-f1)*on3(x,2,3,co)+f1*(x-1)*on3(x,1,2,co),
chk2show(cmds1,Fans1),
c0show("===複数個の例の場合===="),
outL : chk2show([[cmds1,Fans1],[cmds2,Fans2]]),
cshow(outL),
for i:1 thru length(outL) do (
display2d:true, on3show(outL[i]), display2d:false
),
return("--end of chk2show_ex--")
),
print("--end of chk2show('ex)--"),
return("--end of chk2show('ex)--"),
block_main, /* main ブロック ====================================*/
/* cmdsansL : [[cmds1,ans1],[cmds2,ans2],...] */
if listp(args[1])=false then cmdsansL:[[args[1],args[2]]]
else if listp(args[1][1])=false then cmdsansL:[args[1]]
else cmdsansL:args[1],
c1show(progn,cmdsansL), outL : [],
for k:1 thru length(cmdsansL) do (
cmds : cmdsansL[k][1], ans : cmdsansL[k][2],
cmdsL : split(cmds,"@"),
cmds : sremove("@",cmds),
for i thru length(cmdsL) do
if i=1 then print("★ ",cmdsL[1]) else print(" ",cmdsL[i]),
w_out : eval_string(cmds), /* 入力履歴(文字列)の一括評価 */
if ans="" then (print(" out = ",w_out),return(w_out)),
if stringp(ans)=true then ans : eval_string(ans),
if listp(w_out) and is(equal(w_out,ans))=true then (chk:true, chkm:"◎ ")
else (chk:false, chkm:"❌ ", chkerrsum : chkerrsum + 1),
if listp(w_out)=false then (
if numberp(w_out) and abs(w_out-ans) < 1.0E-8
then (chk:true, chkm:"◎ ")
else if is(equal(expand(w_out),expand(ans)))=true then (chk:true, chkm:"◎ ")
else (chk:false, chkm:"❌ ", chkerrsum : chkerrsum + 1)
),
if slength(sconcat(w_out)) < 500
then print(chkm,"out =",w_out)
else print(chkm,"reveal(w_out,6) =", reveal(w_out,6)),
if chk=false then print(" <- ans =",ans),
outL : endcons(w_out, outL)
), /* end of for-k */
return(outL)
)$ /* end of chk2show */
/*######################################################################*/
/* <ifargd>: 親関数引数にdebug1,debug2,debug3があれば debug:1,2,3 を返す */
/*######################################################################*/
ifargd() ::= block([],
/* debug --- 0:none, 1:simple, 2:mid. , 3: detail */
/* print("args=",args), */
if member(debug1,args) then debug:1
else if member(debug2,args) then debug:2
else if member(debug3,args) then debug:3
else debug:0,
return(debug))$
/*------ debug_ex ----------------------------------------------------*/
debug_ex(x,[args]) := block([progn:"<debug_ex>",debug],
debug:ifargd(),
cshow(debug),
/* 本関数の呼び出し時に引数 debug1,2,3 があれば debug:1,2,3 が本関数内で設定される */
/* debug_ex(a,debug1) なら d1show() が反応し， debug_ex(a) なら反応しない */
d1show("d1show",x), d2show("d2show",x), d3show("d3show",x),
cshow(x),
debug_sub(x,debug1),
d1show("d1show-again",x),
return("--- end of debug_ex ---")
)$
debug_sub(y,[args]) := block([progn:"<debug_sub>",debug],
debug:ifargd(), cshow(debug),
d1show("d1show",y+1), d2show("d2show",y+1), d3show("d3show",y+1),
return(y+1)
)$
/*--- fsplit: on3etc.mx -----------------------------------------------*/
/*######################################################################*/
/* <on3iftrue>: 式にon3関数が含まれていればTRUEを返す
on3iftrue(f0+f1*on3(x,1,2,co))---> true, on3iftrue(f0+f1)--->false */
/*######################################################################*/
on3iftrue([args]) := block([progn:"<on3iftrue>",debug,expr, out:false],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3iftrue('help)--
機能: 式にon3関数が含まれていればTRUEを返す
文法: on3itrue(expr,...)
例示: ex : f1*on3(x,1,2,co)+f0$ on3ftrue(ex) -> true
ex : f1+f0$ on3ftrue(ex) -> false
--end of on3iftrue('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3iftrue('ex)--"),
/* on3factor_ex(), */
block([progn:"<on3ftrue_ex>",ex1,ex2,ex],
ex1 : f0+f1*on3(x,1,2,co),
ex2 : f0+f1,
c0show("on3関数の有無の検査"),
for ex in [ex1,ex2] do ( c0show(ex,",", on3ftrue(ex)) ),
return("--- end of on3ftrue('ex) ---")
), /* end of block */
print("--end of on3iftrue('ex)--"),
return("--end of on3iftrue('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
scanmap(lambda([u], if atom(u)=false and op(u)=on3
then return(out:true) else u), expr),
return(out)
)$
/*######################################################################*/
/* <lpup>: リストの指定要素を取り出す
L:[+,[*,f1,[on3,x,3,4,co]],[on3,x,1,2,co]], lpup(L,[2,2]) ---> f1 */
/*######################################################################*/
lpup([args]) := block([progn:"<lpup>",debug,lname,ind0, wind0,wind,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of lpup('help)--
機能: リストの指定要素を取り出す
文法: lpup(list,ind,...)
例示: L:[+,[*,f1,[on3,x,3,4,co]],[on3,x,1,2,co]], lpup(L,[2,2]) ---> f1
--end of lpup('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of lpup('ex)--"),
/* on3factor_ex(), */
block([progn:"<lpup_ex>",L1],
L1 : ["+",["*",f1,[on3,x,3,4,co]],[on3,x,1,2,co]],
show(L1),
show(lpup(L1,2)),
show(lpup(L1,[2,2])),
return("--- end of lpup ---")
), /* end of block */
print("--end of lpup('ex)--"),
return("--end of lpup('ex)--"),
block_main, /* main ブロック ====================================*/
lname : args[1], ind0 : args[2],
wind0:ev(ind0), d2show(wind0),
if listp(wind0) then wind : copylist(wind0) else wind:[wind0],
d2show(wind),
out:"", out:sconcat(out,lname),
for i thru length(wind) do out:sconcat(out,"[",wind[i],"]"),
d1show(string(out)),
eval_string(out)
)$
/*######################################################################*/
/* <loffuncs>: 式に含まれる演算子(関数を含む)からなるリストを返す */
/*######################################################################*/
loffuncs([args]) := block([progn:"<loffuncs>",debug,expr, out:[]],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of loffuncs('help)--
機能: 式に含まれる演算子(関数を含む)からなるリストを返す
文法: loffuncs(expr,...)
例示: ex : f1*on3(x,3,4,co)+on3(x,1,2,co)$ loffuncs(ex) -> [\"*\",\"+\",on3]
---> c.f. listofvars(ex2) = [x,f1]
--end of loffuncs('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of loffuncs('ex)--"),
/* ???_ex(), */
block([progn:"<loffuncs_ex>", ex1, ex2, ex],
print("---begin of loffuncs_ex---"),
ex1 : 1/(f1+f2+f3) + f4,
ex2 : on3(x,1,2,co) + f1*on3(x,3,4,co),
for ex in [ex1,ex2] do (
cshow(ex), cshow(loffuncs(ex)),
cshow("---> c.f.", listofvars(ex))
),
return("--- end of loffuncs_ex---")
), /* end of block */
print("--end of loffuncs('ex)--"),
return("--end of loffuncs('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
d2show(expr),
scanmap(lambda([u], if atom(u)=false
then (out:cons(op(u),out), retuen(u)) else u), expr),
out:unique(out),
d2show(out),
return(out)
)$ /* end of loffuncs() */
/*### --- fsplit: on3pw.mx --- ##########################################*/
/* on3 関数式のカプセル化 */
/*#######################################################################*/
on3ftrue([args]) := block([progn:"<ifon3>",debug,expr,out:false],
ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3ftrue('help)--
機能: 式にon3()が含まれるときTRUEを返す
文法: on3ftrue(expr,...)
例示: on3ftrue(f0+f1*on3(x,1,2,co)); -> true
on3ftrue(f0+f1*sin(x)); -> false
--end of on3ftrue('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3ftrue('ex)--"),
/* ???_ex(), */
block([progn:"<on3ftrue_ex>", ex1, ex2, ex],
print("---begin of on3ftrue_ex---"),
ex1 : f0+f1*on3(x,1,2,co),
ex2 : f0+f1*sin(x),
for ex in [ex1,ex2] do (
cshow(ex), cshow(on3ftrue(ex))
),
return("--- end of on3ftrue_ex---")
), /* end of block */
print("--end of on3ftrue('ex)--"),
return("--end of on3ftrue('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
d2show(expr),
scanmap(lambda([u], if atom(u)=false and op(u)=on3
then return(out:true) else u),
expr),
return(out)
)$ /* end of on3ftrue() */
/*######################### begin of on3pw main block #############################*/
if false then (
matchdeclare(pwf,on3ftrue,var,atom,k,integerp,var0,true,var1,true),
tellsimpafter('diff(on3pw(pwf),var,k), on3pwoff(on3diff(pwf,var,k))),
tellsimpafter('diff(on3pw(pwf),var), on3pwoff(on3diff(pwf,var,1))),
(
remove(integrate,outative),
matchdeclare(pwf,on3ftrue,var,atom),
tellsimpafter('integrate(on3pw(pwf),var), on3integ(pwf,var)),
declare(integrate,outative)
),
/************ 以下の定積分は現時点では機能しない
( remove(integrate,[outative,transfun]),
matchdeclare(pwf,on3ftrue,var,atom,var0,true,var1,true),
tellsimpafter(integrate(on3pw(pwf),var,var0,var1), on3integ(pwf,var,var0,var1)),
declare(integrate, outative),
delcare(integrate,transfun) ), *************************/
/*** カプセルを外して評価する ***/
defrule(on3pw_off_rule, on3pw(pwf), pwf),
on3pwoff(expr) := block([], apply1(expr,on3pw_off_rule))
)$
/*######################### end of on3pw main block #############################*/
/*#######################################################################*/
/*--- on3pw_ex ----------------------------------------------------------*/
/*#######################################################################*/
on3pw_ex() := block([x,f0,f1,f,df_direct,df,F_direct,F],
print("--- begin of on3pw_ex ---"),
print("◆ 準備:関数 F1(x),f0(x)の作成"),
cmds : sconcat("( @",
"f0(x) := sin(x), @",
"f1(x) := x^2*on3(x,minf,0,oo) + (1-x^2)/2 *on3(x,0,1,oo) @",
"+ (1-x)*on3(x,1,inf,oo), @",
"ldisplay(f0(x)), ldisplay(f1(x)) @",
" )"),
logshow(cmds),
print("◆ 使用例1:on3pw()を用いない場合"),
cmds : sconcat("( @",
"define(df_direct(x), on3diff(f1(x),x,1) + diff(f0(x),x,1)),@",
"ldisplay(df_direct(x)),@",
"ldisplay(df_direct(1)),@",
"define(F_direct(x), on3integ(f1(x),x) + integrate(f0(x),x)),@",
"ldisplay(F_direct(x)),@",
"mshow(F_direct(2) - F_direct(-1)) @",
"@ )"),
logshow(cmds),
print("◆ 使用例2:on3pw()を用いる場合"),
cmds : sconcat("( @",
"f(x) := on3pw(f1(x))+f0(x), /* on3関数f1(x)のカプセル化 */ @",
"define(df(x), diff(f(x),x)), /* 関数f(x)の微分関数 df(x)の定義 */ @",
"ldisplay(df(x)),@",
"ldisplay(df(1)),@",
"define(F(x), integrate(f(x),x)), /* 関数f(x)の不定積分 F(x)の定義 */ @",
"ldisplay(F(x)),@",
"mshow(F(2) - F(-1)) @",
" )"),
logshow(cmds),
print("◆ 使用例3:on3diff(),on3integ19()(2010年以降)を用いる場合"),
cmds : sconcat("( @",
"f(x) := f1(x)+f0(x), /* on3関数f1(x)のカプセル化 */ @",
"define(df(x), on3diff(f(x),x,1)), /* 関数f(x)の微分関数 df(x)の定義 */ @",
"ldisplay(df(x)),@",
"ldisplay(df(1)),@",
"define(F(x), on3integ19(f(x),x)), /* 関数f(x)の不定積分 F(x)の定義 */ @",
"ldisplay(F(x)),@",
"mshow(F(2) - F(-1)) @",
" )"),
logshow(cmds),
return("--- end of on3pw_ex ---")
)$
/*--- fsplit: on3test.mx -----------------------------------------------------*/
/*#######################################################################*/
/*--- on3test ----------------------------------------------------------------*/
/*#######################################################################*/
on3test([args]) := block([progn:"<on3test>",debug],
debug:ifargd(),
print("--- 1. on3simp('ex) ---------"), on3simp('ex),
print("--- 2. on3std_ex ----------"), on3std_ex(),
print("--- 3. on3decomp_ex -------"), on3decomp_ex(),
print("--- 4. on3ev_ex -----------"), on3ev_ex(),
print("--- 5. on3diff_ex ---------"), on3diff_ex(),
print("--- 6. on3integ_ex --------"), on3integ_ex(),
print("--- 7. on3solve_ex --------"), on3solve_ex(),
print("--- 8. on3dim2_uni2 -------"), on3dim2_uni2(noplot),
print("--- 9. on3dim2_exp2 -------"), on3dim2_exp2(noplot),
print("---10. on3pw_ex -----------"), on3pw_ex(),
return("--- end of on3test ---")
)$
/**********************************************************************************/
/* ### new parts ###2019.04.25 ###############################################*/
/*############################################################################*/
/*### on3edge : 関数内でtellsimpafterを設定し,他の関数内で規則を呼び出し使用する試み ###*/
/*############################################################################*/
on3edge([args]) := block([progn:"<on3edge",debug,myrule],
debug:ifargd(),
matchdeclare([on3var,on3varl,on3varr,on3lr],true),
myrule : [1,2,3,4,5,6,7,8],
myrule[1]: tellsimpafter(on3(on3a,on3a,on3b,oo),0),
myrule[2]: tellsimpafter(on3(on3a,on3a,on3b,oc),0),
myrule[3]: tellsimpafter(on3(on3a,on3a,on3b,co),1),
myrule[4]: tellsimpafter(on3(on3a,on3a,on3b,cc),1),
myrule[5]: tellsimpafter(on3(on3b,on3a,on3b,oo),0),
myrule[6]: tellsimpafter(on3(on3b,on3a,on3b,oc),1),
myrule[7]: tellsimpafter(on3(on3b,on3a,on3b,co),0),
myrule[8]: tellsimpafter(on3(on3b,on3a,on3b,cc),1),
c1show(myrule),
cshow(progn,"on3式の端点規則を(グローバル)設定した"),
return(myrule)
)$
/*### on3edge_ex ############################################################*/
on3edge_ex([args]) := block([progn:"<on3edge_ex",debug],
debug:ifargd(),
out : on3edge(), /* on3edge() を飛び出す */
print('on3(a, a, b, oo), " = ", on3(a, a, b, oo)),
print('on3(a, a, b, oc), " = ", on3(a, a, b, oc)),
print('on3(a, a, b, co), " = ", on3(a, a, b, co)),
print('on3(a, a, b, cc), " = ", on3(a, a, b, cc)),
print('on3(b, a, b, oo), " = ", on3(b, a, b, oo)),
print('on3(b, a, b, oc), " = ", on3(b, a, b, oc)),
print('on3(b, a, b, co), " = ", on3(b, a, b, co)),
print('on3(b, a, b, cc), " = ", on3(b, a, b, cc)),
cshow(out)
)$
/*#######################################################################*/
/*###on3evdef ### 2019.04.21 ######################################*/
/* on3(var,vl,vr,lr)に変数,文字定数が存在する場合の評価を行う */
/*#######################################################################*/
on3evdef([args]) := block([progn:"<on3evdef>",debug],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3evdef('help)--
機能: on3(var,vl,vr,lr)関数に変数,文字定数が存在する場合の評価を行う
文法: on3evdef(on3func,...)
例示: on3evdef(on3(x,a,a+2,co)) -> on3(x,a,a+2,co)
on3evdef(on3(a,a,a+2,co)) -> 1
--end of on3evdef('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3evdef('ex)--"),
on3evdef_ex(),
block([progn:"<on3evdef('ex)>",debug],
exs : ['on3(a+1,a,a+2,cc),'on3(x,a,a+2,cc),'on3(a,a,a+2,cc),
'on3(a,a,a+2,oc), 'on3(t-u,t-u-1,t-u,oc)],
for ex in exs do (
show(ex,"--> ",on3evdef(ev(ex,nouns)))
),
return("-- end of on3evdef('ex) --")
), /* end of block */
print("--end of on3evdef('ex)--"),
return("--end of on3evdef('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1],
c1show(on3typep(on3func), on3vars(on3func)),
L : f2l(on3func),
L : scanmap(lambda([u],
if listp(u) and u[1]=on3 then (
var:u[2], vl:u[3], vr:u[4], vlr:u[5],
/* is(vr >= vl) = false のときエラーとする? */
if vlr=cc and vr-vl>=0 and var-vl >=0 and vr-var>=0 then u:1
else if vlr=co and vr-vl>0 and var-vl >=0 and vr-var>0 then u:1
else if vlr=oc and vr-vl>0 and var-vl >0 and vr-var>=0 then u:1
else if vlr=oo and vr-vl>0 and var-vl >0 and vr-var>0 then u:1
else u
, u) else u), L),
c1show(L),
return(l2f(L))
)$ /* end of on3evdef() */
/*#########################################################################*/
/*### findstr : ユーザ定義の関数,マクロから指定文字列を含む関数(マクロ)名を検索する ###*/
/*#########################################################################*/
findstr([args]) := block([progn:"<findstr>",debug,listname,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
/* block_main */
block_main, /* メインブロック */
/* functions, macros : Maxima 予約リスト */
str : args[1],
declare(str,noun), str : string(str),
print(progn,"search string =",str),
chk(a) := if ssearch(str, string(a)) > 0 then true, /* sublist の判定関数 */
for listname in ['functions, 'macros] do (
out : sublist(ev(listname), chk), /* 判定関数chk()がTRUEのサブリストを返す */
print(progn,listname,"-->",out)
),
return("--- end of findstr ---"),
block_help, /* ヘルプブロック */
printf(true,"
--begin of findstr('help)--
機能: ユーザ定義の関数,マクロから指定文字列を含む関数(マクロ)名を検索する
文法: findstr(str)
例示: findstr('solve)
--end of findstr('help')--
"
),
return('normal_return),
block_ex, /* 例ブロック */
print("--begin of func1('ex)--"),
block([cmds,w1,w2,wout],
cmds : sconcat("( ",
"findstr('solve), /* 文字列solve を含む関数名,マクロ名を標示する */ @",
"findstr('decomp), /* 文字列decomp を含む関数名,マクロ名を標示する */ @",
"findstr('show) /* 文字列show を含む関数名,マクロ名を標示する */ @",
" )"),
chk1show(cmds,""),
return(wout)
), /* end of block */
/* find_key_ex(), */
print("--end of findstr('ex)--"),
return("--end of findstr('ex)--")
)$
/*+++ findstr_ex() ++++++++++++++++++++++++++++++++++++++++++++*/
findstr_ex([args]) := block([progn:"<findstr>"],
findstr('decomp),
findstr(decomp),
findstr(solve),
findstr(_ex),
findstr(show)
)$
/*#######################################################################*/
/*### exchk : 例題プログラムとその答えを作成する ##############################*/
/*#######################################################################*/
exmk(ex,[args]) := block([progn:"<exmk>",debug,ans,out,chk],
debug:ifargd(),
c1show(progn,ex),
if stringp(ex)=false then ex : string(ex),
c1show(ex),
out : eval_string(ev(ex,noeval)),
ans : string(out),
exans : [ex,ans],
return(exans)
)$
/*### exmk_ex ############################################################*/
exmk_ex([args]) := block([progn:"<exmk_ex>",debug],
debug:ifargd(),
exans : exmk("on3(2,1,3,co)"),
cshow(ex,exans),
exchk("", [exans]),
return("--end of exmk and exchk--")
)$
/*#######################################################################*/
/*### exchk : 例題プログラムの検査を行う ##############################*/
/* ex: exchk(null, [["on3(2,1,3,co)","1"]]);
exchk("on3simp", [["on3(x,1,3,co)*on3(x,2,4,co)","on3(x,2,3,co)"]]); */
/*#######################################################################*/
exchk(on3func_name,exansL,[args]) := block([progn:"<exchk>",debug,
exans, ex, exf, ans, out, chk, swshow:0, now, outcmt:""],
debug:ifargd(),
c1show(on3func_name),
c1show(exansL,length(exansL)),
for exans in exansL do (
c1show(exans,length(exans)),
outcmt:"",
if length(exans) = 3 then ( /* on3showオプション または 注釈 */
swshow : ssearch("on3show",exans[3]),
outcmt:"", if swshow=false then outcmt : exans[3]
), /* end of if 3 */
if length(exans) = 1 then (print("▼",exans[1]) ),
if length(exans) > 1 then (
ex : exans[1], ans : exans[2],
if is(ans # "") then ans : eval_string(ans),
c1show(ex,ans),
exf : ex,
if stringp(on3func_name) and slength(on3func_name)>1
then exf : sconcat(on3func_name,"(",ex,")"),
c1show(exf),
out : eval_string(exf),
c1show(out),
if is(equal(out,ans)) then chk:"◎ " else chk:"◆ 不一致 ◆",
if chk="◎ " then (
if slength(exf) < 45 then print("★",chk, exf,"=",out, outcmt)
else ( print("★", chk, exf), print(" =",out, outcmt))
),
if chk="◆ 不一致 ◆" then (
print("★", chk, exf), print(" =",out),
print(" <- ans =",ans)),
if swshow > 0 then (
now:display2d, display2d:true, on3show(out), display2d:now
)
) /* end of if > 1 */
), /* end of for */
return("--end of exchk---")
)$
/*### exchk_ex ##########################################################*/
exchk_ex([args]) := block([progn:"<exchk_ex>",debug],
exansL : [["第1引数が区間の左端点に一致する場合"],
["on3(a, a, b, oo)","0"], ["on3(a, a, b, oc)","0"],
["on3(a, a, b, co)","1"], ["on3(a, a, b, cc)","1"]],
exchk("",exansL),
exansL : [["第1引数が区間の右端点に一致する場合"],
["on3(b, a, b, oo)", "0"], ["on3(b, a, b, oc)", "1"],
["on3(b, a, b, co)", "0"], ["on3(b, a, b, cc)", "1"]],
exchk("",exansL),
exansL : [["区間の端点が一致する場合"],
["on3(a, inf, inf, oo)","0"],["on3(a, minf, minf, oo)","0"]],
exchk("",exansL),
exansL : [["第1引数がminf,infの場合:特例"],
["on3(inf, a, inf, co)","1"],["on3(minf, minf, b, oc)","1"]],
exchk("",exansL),
return("--end of exchk--")
)$ /* end of exchk */
/*#############################################################################*/
/* end of on3lib20.mx */
/*#############################################################################*/
/*### --- fsplit: on3ineq.mx --- ##########################################*/
/*===全体構成 ==============================================================
on3ineq (2009.09.29, 2009.10.20, 2010.03.04, 2010.10.01,
2011.01.19, 2011.09.28, 2017.02.13, 2019.07.26 改訂)
|---S1 on3ineq_backsolve: (use: msort, elimalg1, va_unique)
| 変数消去に基づき等式解 va, 特異点 vsing 及び 端点リスト vlist を得る
|---S2 on3ineq_fwd: (use: realp, msort)
| 分割されたセル領域の不等式仮判定と解候補生成
|---S3 on3ineq_shrink: 縮退領域の追加と貼り付け (use: shrink, msort, flrlimit)
|---S4 on3ineq_acnode: 孤立点の追加，補正 (use: salgall, sqrt2d)
|---S5 on3dplot2: 解領域の探索的表示, on3gr2: 解領域の関数表示
|-x--S5 on3ineq_reduce: on3多項式の簡素化
| on3ineq_reduce_sub, (on3lrl, f2l, l2f, ...)
| on3ineq_reduce_add, wscan, wscan_sub, reduce2 (clr,flr)
|-x--S5 on3ineq_check: 端点検査 outerl
|-x--S6 on3ineq_decomp: on3多項式の同等性を調べる
==========================================================================*/
/*### on3ineq ##############################################################*/
/* <on3ineq> : m変数不等式 on3ineq([[f,fl,fr,flr],...],'varl=[x,y,...]) の求解 */
/*############################################################################*/
on3ineq([args]) := block([progn:"<on3ineq>",debug,varlt,vlist,vmdiv:3,Exs,
/* vnoend:0,varl:[],on3f:0,acnode:[], */
outlineonly,resultonly,on3floatnump,plotmode:true,fL,outl,outs,restlr,
gkey,glist,dkey,dlist,gdlist,swview],
/* 共通変数: FL, vnoend, varl, on3f, outsum, LL, V, acnode */
vnoend:0, varl:[], on3f:0, acnode:[], /* 共通変数の初期化 */
debug:ifargd(), c1show(debug),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='detail then go(block_detail),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3ineq('help)--
機能: m変数多項式不等式 on3ineq([[f,fl,fr,flr],...],'varl=[x,y,...]) の求解
文法: on3ineq([f,fl,fr,flr],...) or on3ineq([[f,fl,fr,flr]],...)
on3ineq([[f1,f1l,f1r,f1lr],[f2,f2l,f2r,f2lr],...],'varl=[x,y,...])
例示: on3ineq([x^2+y^2,1,9,co],'view)
on3ineq([x^2+y^2,1,9,co],'resultonly,'view)
メモ: on3(log(x),1,2,co,eval) による解法
--end of on3ineq('help')--
"
),
return('normal_return),
block_detail, /* detail ブロック ====================================*/
printf(true,"
--on3ineq('detail)--
[使用例]
fl <= f(x,y,z) < fr ---> on3ineq([[f(x,y,z),fl,fr,co]]) (注:関数fは多項式に限定)
fl <= f(x,y,z) ---> on3ineq([[f(x,y,z),fl,inf,co]])
f(x,y,z) < fr ---> on3ineq([[f(x,y,z),minf,fr,oo]])
下限 fl, 上限 fr は関数であっても可, co は閉(c)開(o)を表す．
連立不等式 ---> on3ineq([[f1,f1l,f1r,lr1],[f2,f2l,f2r,lr2],...])
on3ineq(on3(f(x,y),fl,fr,co)) ---> on3ineq([[f(x,y),fl,fr,co]]) として解く
[変数メモ]
varl : [x,y_1,...,y_m,z] : 変数リスト (varl=[y,x]の様に指定可)
va : [ansx,ansy_1,...,ansy_m,ansz] : 等式解のリスト
=[[[x1,c],[x2,o],...], [[y1,o],[y2,c],...],...,[[z1,o],[z2,o],...]]
vsing : [xs,ys_1,...,ys_m,zs], : 特異点のリスト
=[[[x1,s],[x2,s],...], [[y1,s,],...],...,[[z1,s],[z2,s],...] ]
acnode : [[x = x1,y = y1],[x = x2,y = y2],...] : 孤立点
vmdiv : 中間点の指定 vmid : vl + (vr-vl)/vmdiv
FL : 入力不等式のリスト
[[f(x,y,z),fl,fr,co]]， [[f1,f1l,f1r,lr1],[f2,f2l,f2r,lr2],...]
LL : 不等式解のリスト表現
-- begin of example fL = [on3,y^2+x^2,1,9,oc] --
LL =
[[['V[1][1],'V[1][2],co],['V[2][3],'V[2][4],cc]],
[['V[1][2],'V[1][3],cc],['V[2][3],'V[2][1],co]],
[['V[1][2],'V[1][3],cc],['V[2][2],'V[2][4],oc]],
[['V[1][3],'V[1][4],oc],['V[2][3],'V[2][4],cc]]]
, where
V[ 1 ]= [-3, -1, 1, 3, minf, inf]
V[ 2 ]= [-sqrt(1-x^2), sqrt(1-x^2), -sqrt(9-x^2), sqrt(9-x^2), minf, inf]
-- end of example --
V : 解の左右境界(値，線，．．．)の数式表現リスト
制限: 多変数多項式 (algsys が等式解を返せる関数，第1変数以外は4次まで可)
on3f : 入力不等式のon3表現
outsum : 不等式解の関数表現
共通変数: on3ineqOutL = ['FL=FL, 'on3f=on3f, 'varl=varl, 'LL=LL, 'V=V, 'vsing=vsing,
'acnode=acnode, 'outsum=outsum] (本ルーチンの外で参照可能)
debug : null, debug1, debug2, debug3 (デバッグレベル)
on3floatnump : {true,false}:algsysの結果:近似解(true),厳密解(false)を返す
restlr: {[minf,inf]*,[xl,xr]}:第1変数解の範囲を制限したいときに指定する
outlineonly: {true,false*}:開閉処理をしないときtrueとする
flimitmode: {true*,false}:左右極限値評価を浮動小数モードで行うときtrueとする
resultonly: (true,false*):最終結果outsumのみを表示したいときtrueとする
{'view,'noview} : 不等式解のグラフ表示の有無
{'nooutsum} : 最終結果outsumの非表示
-------------------------------------------------------------------
--end of on3ineq('detail)--
"
),
return("end of on3ineq('detail)"),
block_ex, /* example ブロック ===================================*/
print("--begin of on3ineq('ex)--"),
/*on3ineq_ex(), */
block([progn:"<on3ineq('ex)>",debug,cmds,ans1,ans3,figfile],
printf(true,"
--on3('ex)--
on3ineq([x^2+y^2,1,9,co],'view)
on3ineq([x^2+y^2,1,9,co],'resultonly,'view)
--end of on3('ex)--
"
),
figfile : sconcat(figs_dir,"/","on3ineq-ex1"),
cmds : sconcat("( ",
" /* 例1. */ @",
"on3ineq([x^2+y^2,1,9,co], 'resultonly, @",
"'file_name=",figfile, ", ", swview, ") @ ",
" )"),
ans1 : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co),
chk1show(cmds,ans1),
figfile : sconcat(figs_dir,"/","on3ineq-ex2"),
cmds : sconcat("( ",
" /* 例2. */ @",
"on3ineq([x^2+y^2,1,9,oc], 'resultonly, @",
"'file_name=",figfile, ", ", swview, ") @ ",
" )"),
chk1show(cmds,""),
cmds : sconcat("( ",
" /* 例3. */ @",
"on3ineq([x^2+y^2+z^2,1,9,co], 'resultonly, 'noview )",
" )"),
ans3 : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
*on3(z,-sqrt((-y^2)-x^2+9),sqrt((-y^2)-x^2+9),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
*on3(z,-sqrt((-y^2)-x^2+9),sqrt((-y^2)-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
*on3(z,-sqrt((-y^2)-x^2+9),sqrt((-y^2)-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co)
*on3(z,-sqrt((-y^2)-x^2+9),sqrt((-y^2)-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),oo)
*on3(z,-sqrt((-y^2)-x^2+9),-sqrt((-y^2)-x^2+1),oc)
+on3(x,-1,1,oo)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),oo)
*on3(z,sqrt((-y^2)-x^2+1),sqrt((-y^2)-x^2+9),co),
chk1show(cmds,ans3),
return("end of on3ineq('ex)-block")
), /* end of block */
print("--end of on3ineq('ex)--"),
return("--end of on3ineq('ex)--"),
block_main, /* main ブロック ====================================*/
/* rat 関係の浮動小数･有理数の標示抑制 */
ratprint:false, keepfloat:true,
if length(args) >= 1 and listp(args[1]) then (
FL : copylist(args[1]), c1show(FL)),
outlineonly:false,
if member('resultonly,args) then resultonly:true else resultonly:false,
if member('noplot, args) then (plotmode:false, args:delete('noplot,args)),
/*
c1show(progn,args),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3ineq-regionview"),
columns=2, dimensions=[1000,500]],
dkeyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,dkeyL),
cshow(progn,dlist),
*/
/* ex1: on3ineq([(x-y)/((x-1)*(y-2)), 1/(x-1), 1/(y-2),co])
ex2: C2 C2:funmake(on3ineq,[[x^2+y^3+2*x*y,1,9,co]]),
ex3: H1a H1a:funmake(on3ineq,[[x^2-y^2-(x^2+y^2)^2,-1,0,oc]]),
ex4: H2:funmake(on3ineq,
[[(93392896/15625)*y^6
+((94359552/625)*x^2+(91521024/625)*x +(-249088)/125)*y^4
+((1032192/25)*x^4-36864*x^3+((-7732224)/25)*x^2
+(-207360)*x+770048/25)*y^2
+65536*x^6+49152*x^5+(-135168)*x^4
+(-72704)*x^3+101376*x^2+27648*x-27648, 0,0,cc]]),
ex5: S1:funmake(on3ineq,[[(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co]]),
ex6: A1:funmake(on3ineq,
[[[y,(x-1)*(x-5)+5,(-(x-1))*(x-5)+5,co],[y,(-(x-2))+3,(x-2)+3,co]]]),
ex7: q3(file_name="/tmp/lang/tmp-q3",'noview)$
ex8: q4(file_name="/tmp/lang/tmp-q4",'noview)$
*/
/*
Exs :
"=== Examples in on3ineqlib ==============================:
realp_ex(), elimalg11_ex(), msort_ex(), mkfloat_ex(),
floatfix_ex(), flrlimit_ex(), salgall_ex(), sqrt2d_ex(),
on3ineq_ex(c1,c2oo,c2oc,c2co,c2cc,c3oo,c3oc,c3co,c3cc,
c4oo,c4oc,c4co,c4cc,
A1,A2,S0,S1,S2,S3,K1,K2,H1,H1a,H2),
q3(), q4(), chk1g(), chk2g(), chk3g(),
grv_ex(), on3gr_ex()
============================================================",
*/
if atom(FL)=true then (print(Exs),return()),
c1show(FL),
if listp(FL) = false
then ( FL : f2l_one(FL), FL : delete(on3,FL,1), FL : [FL])
else if listp(FL[1])=false then FL:[FL],
c1show(progn, FL),
/* 入力不等式の2重リストFLのon3関数式表現 */
on3f:1, for i thru length(FL) do
on3f:on3f*funmake(on3,[FL[i][1],FL[i][2],FL[i][3],FL[i][4]]),
/* 変数リストの設定(無指定の場合は自動生成) */
for i thru length(args) do if lhs(args[i])='varl then varl:rhs(args[i]),
varlt : listofvars(on3f),
for i thru length(varlt) do if member(varlt[i],[oo,oc,co,cc]) then varlt[i]:null,
varlt:sort(delete(null,varlt)),
if varl=[] then varl:copylist(varlt)
else if length(varl) # length(varlt) then
(cshow("指定された変数リストと式中に現れる変数の個数が不一致"),
cshow("->",varl), cshow("->",varlt),return("Error in ",progn)),
vnoend:length(varl),
c1show("==on3ineq==",vnoend,varl),
va : makelist([],i,1,vnoend),
vsing : makelist([],i,1,vnoend),
vlist : makelist([],i,1,vnoend), /* vlist[2] は vlist[1]の端点に依存する */
/*=== S1: 変数消去により等式解 va, 特異リスト vsing を求める ==============*/
c1show("=== on3ineq begin ===",varl),
[va,vsing] : on3ineq_backsolve(FL,debug0),
c1show("result of backsolve:",varl,vlist,va,vsing),
LL:[],
c1show("== start on3ineq_fwd ==="),
/*=== S2: セル領域(派生する境界面(線,点)を含む)の不等式仮判定と解候補生成(重要) ========*/
LL : on3ineq_fwd(varl,va,vlist,vsing,debug0),
c1show(progn,"--end of on3ineq_fwd--"),
if outlineonly # true then (
c1show(progn,"pre-shrinkr:",LL),
LL:on3ineq_shrink(debug0),
c1show(progn,"post-srhrinkr:",LL)
),
[outsum,varl,LL,V] : ll2on3(varl,va,LL,resultonly), /* 解の整理と表示 */
on3ineq_OutL : ['FL=FL,'on3f=on3f, 'varl=varl,
'LL=LL,'V=V,'vsing=vsing,'acnode=acnode,'outsum=outsum],
c1show(progn,on3ineq_OutL),
if false then (display2d:true, on3show(outsum)),
outsum:ev(outsum,nouns),
if resultonly=false then (
if slength(sconcat(outsum)) < 300 then cshow(progn,outsum),
print("--[Result display]--"),
print("varl =",varl),print("LL =",LL), print(", where"),
for vno thru vnoend do (
if slength(sconcat(V[vno])) > 300
then print("V[",vno,"]=",reveal(V[vno],6))
else print("V[",vno,"]=",V[vno]) ),
c1show(outsum),
print("---end---"), display2d:false, /*display2d_old, */
cshow("参照可能変数: varl,V,LL,vsing,on3f,fL,on3floatnump,acnode")
),
/*=== S3: 孤立点検証に基づく補正 ==============================================*/
c1show(progn,outlineonly),
if outlineonly=true then (outs:0) else
([acnode,outl,outs] : on3ineq_acnode(FL),
c1show("--->",outl),c1show("--->",outs), outsum:outsum+outs ),
/*xxx S4: 不等式解の構成 ==============================================*/
if false then outsum : on3ineq_build(outsum,noreduce,correct),
/*xxx S5:合併(結合)処理 ====================================================*/
if false then (outsum : on3ineq_reduce(outsum)),
/*xxx S6: 孤立点検証 =========================================================*/
if false then on3ineq_check(varl,va,vsing,on3f,outsum),
/* return([outsum,varl,LL,V]) */
/*=== begin view =======================================================*/
if plotmode then (
glist : ['title="on3ineq-regionview", 'xrange=[-5,5], 'yrange=[-5,5]],
gkey : ['title, 'xrange, 'yrange],
glist : mergeL(glist,args,gkey), /* glist をargs で更新 */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3ineq-regionview"),
columns=2, dimensions=[1000,500] ],
dkey : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,dkey), /* dlist をargs で更新 */
c1show(progn,args),
c1show(progn,dlist),
gdlist : append(glist,dlist),
c1show(gdlist),
on3regionview(FL,outsum,'argsL=gdlist,swview) /* グラフ表示 */
),
c1show(progn,FL), c1show(progn,gdlist),
if member('nooutsum, args)
then (c1show(progn,"outsum : 省略"), return("--end of on3ineq()--"))
else (c1show(progn,outsum), return(outsum))
)$ /* end of on3ineq() */
/*#################################################################################*/
/*# ll2on3: varl, va から V を作成し，varl, LL, V を表示する (in on3ineq(), 内部使用) #*/
/*#################################################################################*/
ll2on3(varl,va,LL,[args]) := block([progn:"<ll2on3>",debug,display2d_old,
LLs,vvv,tmp],
debug:ifargd(),
display2d_old:display2d, display2d:false,
c1show(progn,length(va),va),
LLs : sconcat(LL), LLs:ssubst("'V","'va",LLs),LL:eval_string(LLs),c1show(LL),
V:copylist(va),
V:scanmap(lambda([u],if listp(u) and listp(u[1])=false
and (u[2]=o or u[2]=c or u[2]=s) then u:u[1] else u ),V),
c1show(V), outsum:0, vnoend:length(varl),
for i thru length(LL) do ( vvv :1,
for vno thru vnoend do (
tmp : funmake(on3,cons(varl[vno],LL[i][vno])),
c1show(tmp,ev(tmp,nouns)),
vvv:vvv*ev(tmp,nouns)
), /* end of for-vno */ vvv:ev(vvv,nouns,infeval), c1show(vvv),
outsum:outsum+vvv
), /* end of for-i*/
outsum : ev(outsum,nouns,infeval),
return([outsum,varl,LL,V])
)$
/*############################################################################*/
/*### on3regionview : 廃止予定 on3ineq()の入力FLと結果outsumから結果の解領域を図示する ###*/
/*############################################################################*/
on3regionview([args]) := block([progn:"<on3regionview>",debug,
plotmode:true, viewmode:true, /* , outsum, dlist,*/ keyL,on3func,
xrange,yrange,argsc,argsL,rxrange,ryrange,keyv,
dxlr,xl,xr,nx,dylr,yl,yr,ny, gd,gout,dlist3,glist,swview],
debug : ifargd(),
if member('noview,args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3regionview('help)--
機能: on3ineq()の入力FLと結果outsumから結果の解領域を図示する
文法: on3regionview(FL,outsum,...)
例示: on3ineq('ex); /* on3ineq()関数の共通変数FL,outsum,vsingを参照する */
on3regionview([[y^2+x^2,1,9,co]],outsum);
メモ: 未完成,廃止予定
--end of on3regionview('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3regionview('ex)--"),
block([progn:"<on3regionview('ex)>",varl,FL,outsum,argsL]),
on3ineq([x^2+y^2,1,9,co],'resultonly,'noview),
/* on3ineq() の共通変数: varl, FL, outsum, LL, V, vsing */
varl : [x,y],
FL : [[y^2+x^2,1,9,co]],
outsum : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co),
argsL : [title = "on3regionview",xrange = [-5,5],yrange = [-5,5],terminal = png,
file_name = sconcat(figs_dir,"/","on3regionview"),
columns = 2,dimensions = [1000,500]],
c0show(progn,varl),
c0show(progn,FL),
c0show(progn,outsum),
c0show(progn,argsL),
on3regionview(FL,outsum,'argsL=argsL,swview),
return("block of on3regionview('ex)"),
print("--end of on3regionview('ex)--"),
return("--end of on3regionview('ex)--"),
block_main, /* main ブロック ====================================*/
c1show(progn,length(args),args),
argsc : args,
argsL : rhs(find_key(argsc,'argsL)),
c1show(progn,length(argsL),argsL),
args : args_flat(argsc),
c1show(progn,"S1",length(args),args),
if length(args) >=2 then ( /* 実質的必須の引数 */
FL : copylist(args[1]), /* on3ineq の入力不等式たち(2重リスト形式) */
outsum:args[2] ), /* on3ineq の結果(関数表現) */
c1show(progn,varl,FL,outsum),
/* 描画範囲と検査点数の初期値 */
rxrange : xrange=[-2,2], ryrange : yrange=[-2,2], nx:50, ny:50,
/* 引数から rxrange=[rxl,rxr], ryrange=[ryl,ryr] を設定する */
keyv : find_key(args,'xrange),
if keyv # false then ( rxrange : keyv, c1show(progn,rxrange) ),
keyv : find_key(args,'yrange),
if keyv # false then ( ryrange : keyv, c1show(progn,ryrange) ),
[xl, xr] : rhs(rxrange), [yl,yr] : rhs(ryrange),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3regionview-2d"),
columns=2, dimensions=[1000,500]],
keyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,argsL,keyL),
c1show(dlist),
c1show(progn,plotmode,viewmode),c1show(outsum),c1show(FL),
if outsum=0 then (cshow(progn,outsum,"---stop"),return()), /* ??? */
on3func:1, /* on3ineq の入力不等式たち(2重リスト形式) FL のon3関数化 */
for i thru length(FL) do
on3func:on3func*funmake(on3,[FL[i][1],FL[i][2],FL[i][3],FL[i][4]]),
c1show(on3func,listofvars(on3func)),
c1show(progn,on3func),
if plotmode=true then (
if length(listofvars(on3func))=2 then (
cshow(progn,"==2変数関数=="),
c1show(progn,dlist),
c1show(progn,argsL),
gd : on3dplot2(on3func,'argsL=argsL,'noview), /* 解領域を点で示す */
gout : on3gr2(outsum,'argsL=argsL,'noview), /* 解析解領域を関数で示す */
/* 注意: gd, gout は文字列で返される ー> eval_string */
c1show(gd), c1show(gout),
if true then (
/* dlist : draw() 関数の引数のリスト */
if stringp(gd) then gd:eval_string(gd),
if stringp(gout) then gout:eval_string(gout),
glist : [gd,gout],
c1show(progn,"call mk_draw:",dlist),
mk_draw(glist,dlist,swview) /* mk_draw 関数の呼び出し */
)
), /* end of if-then 2*/
if length(listofvars(on3func))=3 then (
/* gout : on3gr(out,xrange=[xl,xr],yrange=[yl,yr]), */
c1show(progn,"==3変数関数=="),
gout : on3gr(outsum),
c1show(gout),
if true then (
/* dlist : draw() 関数の引数のリスト */
glist:[gout],
dlist3 : [terminal='png, file_name=sconcat(figs_dir,"/","on3regionview-3d"),
columns=2, dimensions=[1000,1400]],
mk_draw(glist,dlist3,swview) /* mk_draw 関数の呼び出し */
)
) /* end of if-then 3 */
) /* end of if-plotmode */
)$ /* end of on3regionview */
/*#################################################################################*/
/*### va_unique : 内部使用 in on3ineq_backsolve() #####################################*/
/*#################################################################################*/
va_unique([args]) := block([progn:"<va_unique>",debug,L],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of va_unique('help)--
機能: 端点リストvaの要素実数に [x0,o],[x0,c],[x0,s] が存在するとき[x0,s]にする
文法: va_unique(va[i],...)
例示: va[1] :
[[0,o],[1,c],[1,o],[1,s],[2,o],[-sqrt(2),o],[sqrt(2),o],
[-(sqrt(5)-1)/2,o],[(sqrt(5)+1)/2,o]]
---> [1,c], [1,o] が除かれる by va[1]:va_unique(va[1])
va[1] =
[[0,o],[1,s],[2,o],[-sqrt(2),o],[sqrt(2),o],[-(sqrt(5)-1)/2,o],[(sqrt(5)+1)/2,o]]
メモ:
--end of realp('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of va_unique('ex)--"),
block([progn:"<va_unique_ex>",debug,va],
debug:ifargd(),
va[1] : [[0,o],[1,c],[1,o],[1,s],[2,o],[-sqrt(2),o],[sqrt(2),o],
[-(sqrt(5)-1)/2,o],[(sqrt(5)+1)/2,o]],
c0show(progn),c0show(va[1]),
cashow(va_unique(va[1])),
return("---end of va_unique_ex---")
), /* end of block */
print("--end of va_unique('ex) block--"),
return("--end of va_unique('ex)--"),
block_main, /* main ブロック ====================================*/
L : args[1],
if length(L) > 1 then for i thru length(L)-1 do (
for j:i+1 thru length(L) do (
if L[i][1]=L[j][1] then
if L[i][2]=s then L[j]:null
else if L[j][2]=s then (L[i][2]:s, L[j]:null)
else L[j]:null
) /* end of for-j */ ), /* end of for-i */
L: delete(null,L),
return(L)
)$
/*#################################################################################*/
/*### realp #######################################################################*/
/*#################################################################################*/
realp([args]) := block([progn:"<realp>",debug,expr, realonly_old,EPS:1.0E-7,in,tmp,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of realp('help)--
機能: exprが実数のときTRUEを返し,複素数のときFALSEを,
変数を含むときunknownを返す. 虚数部の絶対値が微小のときは実数とみなす.
文法: realp(expr,...)
例示: realp(expr) -> true
メモ:
--end of realp('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of realp('ex)--"),
block([progn:"<realp_ex>",debug],
debug:ifargd(),
c0show(realp(1.0)),
c0show(realp(1.0+1.0E-10*%i), "/* 微小虚数を含む場合 */"),
c0show(realp(1.0+1.0E-6*%i), "/* 微小虚数を含む場合 */"),
c0show(realp(2*x+%i)),
c0show(realp([1.0,1.0+1.0E-10*%i,1.0+1.0E-6*%i,2*x+%i])),
c0show(freeof(unknown,false,realp([1.0,1.0+1.0E-10*%i]))),
c0show(freeof(unknown,false,realp([1.0,1.0+1.0E-6*%i,2*x+%i]))),
return("---end of realp_ex---")
), /* end of block */
print("--end of realp('ex)--"),
return("--end of realp('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
realonly_old:realonly, realonly:false, /* keepfloat:false, */
if listp(expr)=false then in:[expr] else in:expr, out:makelist(null,i,1,length(in)),
for i thru length(in) do (
if listofvars(in[i]) # [] then out[i]:'unknown
else (
tmp:in[i], tmp:ev(tmp,expand,infeval), tmp:float(tmp), tmp:rectform(tmp),
if freeof(%i,tmp) then out[i]:true
else if abs(imagpart(tmp))/cabs(tmp) < EPS then out[i]:true
else out[i]:false ) /* end of else */
), /* end of for-i */
realonly:realonly_old,
if listp(expr)=false then return(out[1]) else return(out)
)$
/*### on3ineq_backsolve ######################################################*/
/* <on3ineq_backsolve: 変数消去により等式解 va, 特異リスト vsing を求める(内部使用) */
/*############################################################################*/
/* maxima/5.17.1/share/contrib/solve_rat_ineq.mac を参照した */
on3ineq_backsolve(LF,[args]) := block([progn:"<on3ineq_backsolve>",debug,
kend,varlt:[],f,fl,fr,flr, z,y,ansz,zs,vnoend, swl,swr,wlr, tvars,tmp,
z0,z1,z2,z0num,z0den,z1num,z1den,z2num,z2den,
eqs,eqsend,weq,wweq,eqlr,eql,eqr,eqsing,c0,c1,c2,w,ans,
anslr,ansl,ansr,ansy,ds,ys,dl,dr,rnumlist],
debug:ifargd(),
kend:length(LF), weq:[],
swl:makelist(null,k,1,kend), swr:makelist(null,k,1,kend),
eql:makelist(null,k,1,kend),eqr:makelist(null,k,1,kend),
eqsing:makelist(null,k,1,kend),
for k thru length(LF) do (
f:LF[k][1],fl:LF[k][2],fr:LF[k][3], flr:LF[k][4],
varlt : endcons([listofvars(f),listofvars(fl),listofvars(fr)],varlt),
z0 : fullratsimp(f), z0den : denom(z0), z0num : num(z0),
z1 : fullratsimp(fl), z1den : denom(z1), z1num : num(z1),
z2 : fullratsimp(fr), z2den : denom(z2), z2num : num(z2),
eql[k] : z0num*z1den-z1num*z0den, /* 左境界面・線・点 */
eqr[k] : z0num*z2den-z2num*z0den, /* 右境界面・線・点 */
eqsing[k] : z0den*z1den*z2den, /* 特異面・線・点を一気に解く */
if fl=minf then eql[k]:null, if fr=inf then eqr[k]:null,
if flr=cc then (swl[k]:c, swr[k]:c)
else if flr=co then (swl[k]:c, swr[k]:o)
else if flr=oc then (swl[k]:o, swr[k]:c)
else if flr=oo then (swl[k]:o, swr[k]:o)
),
c1show(progn,"=== START on3bsolM ===",varl),
if atom(varl) then varl:unique(flatten(varlt)), vnoend:length(varl),
va : makelist([],i,1,vnoend), vsing:makelist([],i,1,vnoend),
vlist : makelist([],i,1,vnoend),
c1show(eql),c1show(eqr),c1show(eqsing), c1show(varl,vnoend),
/*** vsing : 特異面・線・点を一気に解く ***************************************/
c1show(eqsing),
for k thru kend do (
zs : flatten(algsys([eqsing[k]],[varl[vnoend]])), /* 特異線 */
zs : map('rhs,zs),
for i thru length(zs) do
if member(zs[i],%rnum_list) then zs[i]:null else zs[i]:[zs[i],s],
zs:delete(null,zs), zs : unique(zs),
zs : sublist(zs, 'lambda([u], freeof(minf,inf,u))), /* 除外 */
c2show("z(x,y) と 特異面"), c1show(k,zs),
vsing[vnoend]:append(vsing[vnoend],zs)
),
/* 第1変数まで繰り返し処理 */
if vnoend > 1 then for vno:vnoend-1 step -1 thru 1 do (
c1show("=== 繰り返し",vno,"==="),
if vno=1 then realonly:true else realonly:false,
/* z : varl[vno+1], y : varl[vno], */
for k thru kend do (
c1show("===",eqsing),
if [eqsing[k]]=[] or freeof(ev(y),eqsing[k]) then ys:[]
else ( /* 特異面，線，点の関数を求める */
c1show(eqsing[k]),
tvars:[], for i:vno thru vnoend do tvars:endcons(varl[i],tvars),
c1show(tvars),
tmp: algsys([eqsing[k]],tvars),c1show(tmp), /* call algsys */
tmp:flatten(tmp),
ys:[],
for i thru length(tmp) do
if lhs(tmp[i])=ev(varl[vno]) and constantp(rhs(tmp[i]))
and freeof(%i,rhs(tmp[i])) then ys:endcons(rhs(tmp[i]),ys),
for i thru length(ys) do ys[i]:[ys[i],s]
), c1show(ys),
if vno=1 and length(ys) > 1 then ansy:msort(ys,1), /* call msort */
vsing[vno]:append(vsing[vno],ys)
) /* end of for-k */
), /* end of for-vno ----------------------------------------*/
c1show(vsing),
/*** end of vsing *****************************************************/
eqs:[],
for k thru kend do eqs:append(eqs,[[eql[k],swl[k]],[eqr[k],swr[k]]]), /* 方程式の合併 */
eqsend:length(eqs), c1show("===",eqsend,reveal(eqs,10)),
/* 最終変数 z について解く */
if vnoend=1 then realonly:true else realonly:false,
for k thru eqsend do (
if eqs[k][1]=null then ans:[] else ( /* call algsys */
if errcatch( ans:algsys([eqs[k][1]],[varl[vnoend]]), return)=[]
then ( cshow("== Error in backsolve =="),
cshow("参考:",polydeg(eqs[k][1])), quit() )
else ans ,
ans : flatten(ans), c1show(k,ans), ans : map('rhs,ans),
for i thru length(ans) do
if member(ans[i],%rnum_list) then ans[i]:null else ans[i]:[ans[i],eqs[k][2]],
ans:delete(null,ans)
),c1show(varl[vnoend],ans),
va[vnoend]:append(va[vnoend],ans)
), /* end of for-k */
c1show("Z-",va[vnoend]),
/*========================================================================*/
/* 第1変数まで繰り返し処理 (for vno) */
if vnoend > 1 then for vno:vnoend-1 step -1 thru 1 do ( /* begin for-vno */
c1show("=== 繰り返し",vno,"==="),
if vno=1 then realonly:true else realonly:false,
/* 交点 */
weq : copylist(eqs),
for k thru length(weq) do
if freeof(minf,inf,weq[k][1])=false or weq[k][1]=null then weq[k]:null,
weq:delete(null,weq), eqsend:length(weq),
c1show(weq),
if length(weq) > 1 then for k1 thru length(weq)-1 do ( /* begin for-k1 */
for k2:k1+1 thru length(weq) do ( /* begin of for-k2 */
c1show(weq[k1],weq[k2],varl[vno+1]),
[ans,wweq]:elimalg1([weq[k1][1],weq[k2][1]],varl[vno+1],varl[vno]), /* elimalg1 */
c1show(k1,k2,ans),c1show(wweq),
if weq[k1][2]=c and weq[k2][2]=c then wlr:c else wlr:o,
ans : map('rhs,ans), c1show(ans),
for i thru length(ans) do if member(ans[i],%rnum_list)
then ans[i]:null else ans[i]:[ans[i],wlr],
ans:delete(null,ans),
va[vno]:append(va[vno],ans)
) /* end of for-k2 */
), /* end of for-k1 */
c1show("k1,k2-end ",eqs,z),
/* 零点 */
for k thru eqsend do ( /* 不等式の個数 */
c1show("S--",vno,k,eqs[k]),
[ans,weq]:elimalg1([eqs[k][1]],varl[vno+1],varl[vno]), /* call elimalg1 */
c1show(k,ans),c1show(weq),
ans : map('rhs,ans), c1show(ans),
for i thru length(ans) do if member(ans[i],%rnum_list)
then ans[i]:null else ans[i]:[ans[i],eqs[k][2]],
ans:delete(null,ans),
eqs[k]:flatten([weq,[eqs[k][2]]]),
va[vno]:append(va[vno],ans)
), /* end of for-k */
c1show(vno,va)
), /* end of for-vno ----------------------------------------*/
realonly:false, c1show(va),
/*=== 後処理 ====================================*/
for vno thru vnoend do
(va[vno]:append(va[vno],vsing[vno]), va[vno]:unique(va[vno]) ),
c1show(progn,"===end of on3bsolM ==="),
on3floatnump:false,
for i thru length(va[1]) do if floatnump(va[1][i][1]) then on3floatnump:true,
c1show(on3floatnump),
if on3floatnump=true then for i thru length(va[1]) do va[1][i][2]:o,
/* 重複処理 va_unique */
/* va[1] =
[[0,o],[1,c],[1,o],[1,s],[2,o],[-sqrt(2),o],[sqrt(2),o],
[-(sqrt(5)-1)/2,o],[(sqrt(5)+1)/2,o]]
---> [1,c], [1,o] が除かれる
va[1] =
[[0,o],[1,s],[2,o],[-sqrt(2),o],[sqrt(2),o],[-(sqrt(5)-1)/2,o],[(sqrt(5)+1)/2,o]]
*/
if true then for vno thru vnoend do va[vno]:va_unique(va[vno]), /* call va_unique */
for vno thru vnoend do (
for i thru length(va[vno]) do
if member(va[vno][i][1],[minf,inf]) then va[vno][i]:null,
va[vno]:delete(null,va[vno]) ), /* end of for-vno */
/*** add 2010-08-15 ***/
for i thru length(va[1]) do
if constantp(va[1][i][1]) = false or realp(va[1][i][1])=false then va[1][i]:null,
va[1]:delete(null,va[1]),
c1show(va),c1show(vsing),
/* add 2010-09-09 */
c1show("P3:y=%i*(x-x0)+y0 - > [x=x0,y=y0] の処理 <--"),
for i:1 thru vnoend do (
c1show(i,va[i]),
for j thru length(va[i]) do (
w:va[i][j][1], c0:listofvars(w), c1:length(c0),
if c1 > 0 then c2:hipow(w,c0[1]) else c2:-1,
c1show(c0,c1,c2),
if freeof(%i,w)=false and polynomialp(w,c0) and c1=1 and hipow(w,c0[1])=1
then (
c1show("---complex---",w),
ansi:algsys([imagpart(w)],c0)[1][1],
ansr:realpart(w), c1show("--->",ansi,ansr),
if lhs(ansi)=varl[i-1] then va[i-1]:endcons([rhs(ansi),va[i][j][2]],va[i-1]),
va[i][j]:[ansr,va[i][j][2]]
) /* end of then */
) /* end of for-j */
), /* end of for-i */
for i thru vnoend do va[i]:unique(va[i]),
/* add 2010-11-06 */
for vno thru vnoend do (
for i thru length(va[vno]) do if realp(va[vno][i][1])=false then va[vno][i]:null,
va[vno]:delete(null,va[vno])
),
c1show("R-",reveal(va,10)), c1show("R-",vsing), c1show(va[1]), c1show(float(va[1])),
return([va,vsing])
)$ /* end of on3ineq_backsolve() */
/*#################################################################################*/
/*### elimalg1: eqs から変数evarを消去し変数aval についての解ansと消去式eqsを返す ####*/
/*#################################################################################*/
elimalg1([args]) := block([progn:"<elimalg1>",debug,
eqs,evar,avar, weq,weq1,dd,wgcd,add,ans],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of elimalg1('help)--
機能: eqs から変数evarを消去し変数aval についての解ansと消去式eqsを返す
文法: elimalg1(eqs,evar,avar,...)
例示:
メモ:
--end of elimalg1('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of elimalg1('ex)--"),
elimalg1_ex(),
/*
block([progn:"<elimalg1_ex>",debug],
return("---end of elimalg1_ex---")
), /* end of block */
*/
print("--end of elimalg1('ex)--"),
return("--end of elimalg1('ex)--"),
block_main, /* main ブロック ====================================*/
eqs : args[1], evar : args[2], avar : args[3],
c1show("In elimalg1:",eqs,evar,avar),
if listp(eqs)=false then weq:[eqs] else weq:copylist(eqs),
c1show(length(weq),weq),
if length(weq)=1 then ( dd:diff(weq[1],evar), weq:flatten([weq[1],dd]) ),
c1show("-elimalg1-",weq),
wgcd:gcd(weq[1],weq[2]),
if wgcd # 1 and length(listofvars(wgcd)) > 0 then (
c1show("=elmalg1:case of wgcd # 1="),
weq:fullratsimp(weq/wgcd), c1show("-elimalg1-",wgcd,weq),
weq1:eliminate(weq,[evar]), c1show(weq1),
if errcatch( ans:algsys(weq1,[avar]), return )=[]
then (cshow("== Error in algsys ipolydegn elimalg1 -> return ans:[] =="), ans:[])
else ans,
if member(evar,listofvars(wgcd))=false then (
if errcatch( add:algsys([wgcd],[avar]), return )=[]
then (cshow("== Error in algsys(add) in elmalg1 -> reurn add:[] =="),add:[],
cshow(wgcd,evar) )
else add,
ans:append(ans,add)
) /* end of if-member-false */
) /* end of wgcd # 1 */
else (
weq1:eliminate(weq,[evar]),
if errcatch( ans:algsys(weq1,[avar]), return )=[]
then ( cshow("== Error in algsys in elimalg1 (wgcd=1) -> return ans:[] =="),ans:[])
else ans
), /* end of else */
ans:flatten(ans), c1show("-elimalg1-",ans,weq1),
return([ans,weq1])
)$
/*--- elimalg1_ex ------------------------------------------------------------------*/
elimalg1_ex([args]) := block([progn:"<elimalg1_ex>",debug,eR30,Lex,eq,
ansz,ansy,eqy,ansx,eqx],
debug:ifargd(),
eR30 : ((x-1)^2+(y-2)^2+(z-3)^2)*(x^2+y^2+z^2-1),
Lex : [eR30],
for eq in Lex do (
print("---例--- eq :",eq),
cshow(eq:expand(eq)),
display(polydeg(eq)),
print("ansz:algsys([eq],[z] ->"),
ansz:algsys([eq],[z]),
display(ansz),
print("[ansy,eqy]:elimalg1(eq,z,y) ->"),
display([ansy,eqy]:elimalg1(eq,z,y)),
print("[ansx,eqx]:elimalg1(eqy,y,x) ->"),
display([ansx,eqx]:elimalg1(eqy,y,x))
),
return("---end of elimalg1_ex---")
)$
/*#############################################################################*/
/*### chk2D : exp内の sqrt(f(x))部において f(x)<0 の判定を行う ##################*/
/*#############################################################################*/
chk2D([args]) := block([progn:"<chk2D>",debug,expr, out:[],st,stw,varl,c,D,neg],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of chk2D('help)--
機能: exp内の sqrt(f(x))部において f(x)<0 の判定を行う
文法: chk2D(expr,...)
例示:
メモ:
--end of chk2D('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of chk2D('ex)--"),
/* chk2D_ex(), */
block([progn:"<chk2D_ex>",debug],
c0show(chk2D(x+sqrt(-x^2+4*x-8))),
c0show(chk2D(x+sqrt(-x^2+4*x-8) + sqrt(t-2))),
c0show(chk2D(x+sqrt(-x^2))),
return("---end of chk2D_ex---")
), /* end of block */
print("--end of chk2D('ex)--"),
return("--end of chk2D('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
out:scanmap(lambda([u], if atom(u) = false then u:cons(op(u),args(u)) else u),expr),
c1show("S1:完全リスト:",out),
out:scanmap(lambda([u],
if listp(u) and first(u)=sqrt and listp(u[2]) then [u[1],l2f(u[2])] else u),out),
c1show("S2:",out),
st:[],
scanmap(lambda([u], if listp(u) and u[1]=sqrt and length(listofvars(u[2]))=1
and polynomialp(u[2],listofvars(u[2])) and hipow(u[2],listofvars(u[2])[1])=2
then (st:endcons(u[2],st)) else u ), out),
c1show("S3:",st),
if length(st)=0 then (neg:false, return(neg)),
for i thru length(st) do (
stw:st[i], varl:listofvars(stw), varnoend:length(varl),
c:[], for j:0 thru 2 do c:endcons(coeff(stw,varl[1],j),c), D:c[2]^2-4*c[1]*c[3],
if c[3] < 0 and D < 0 then neg:true else neg:false,
c1show(neg)
), /* end of for-i */
return(neg)
)$
/*** ex : x+sqrt(-x^2+4*x-8); ex : ex + sqrt(t-2); chk2D(ex); ***/
/*############################################################################*/
/*### polydeg 多変数多項式の変数毎の次数リストを返す ###########################*/
/*############################################################################*/
polydeg([args]) := block([progn:"<polydeg>",debug,expr, f,varl,vnoend,vorder,volist],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of polydeg('help)--
機能: 多変数多項式の変数毎の次数リストを返す
文法: polydeg(expr,...)
例示: polydeg(x^2+4*x-8)); -> [[x],[[2,1]]]
polydeg(expand((x^2+4*x-8)*(y-1)^3)); -> [[x,y],[[2,1],[3,2,1]]]
メモ:
--end of polydeg('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of polydeg('ex)--"),
/* polydeg_ex(), */
block([progn:"<polydeg_ex>",debug],
c0show(polydeg(x^2+4*x-8)),
c0show(polydeg(expand((x^2+4*x-8)*(y-1)^3))),
return("---end of polydeg_ex---")
), /* end of block */
print("--end of polydeg('ex)--"),
return("--end of polydeg('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
f:expand(expr), varl:listofvars(f), vnoend:length(varl),
vorder:makelist(null,vno,1,vnoend),
if polynomialp(f,varl)= false then (cshow("Not Polynomial Expression"),return([])),
for vno thru vnoend do vorder[vno]:hipow(f,varl[vno]), c1show(varl,vorder),
volist:makelist([],vno,1,vnoend),
for vno thru vnoend do (
if vorder[vno] > 0 then for j:vorder[vno] step -1 thru 1 do (
if coeff(f,ev(varl[vno])^j) # 0 then volist[vno]:endcons(j,volist[vno])
) /* end of for-j */
), /* end of for-vno */
c1show(volist),
return([varl,volist])
)$
/*### on3ineq_fwd ##########################################################*/
/* <on3ineq_fwd>: 結果のon3式を構成する */
/*############################################################################*/
on3ineq_fwd(varl,va,vlist,vsing,[args]) := block([progn:"<on3ineq_fwd>",
debug, ff,fl,fr,flr, tmp,tmp1,sind,soind,cind,vl,vr,vm, vno,pno,
fvlist, fvm,svm, tlist,tlist1,tv,tvlist,tvrlist,tvf,tvflist, tind1,
swl,swr,swlr,vlr,lr, bind, sno,snop1, swlr0,LLS],
/* 共通変数: varl, vnoend, va */
/*** Memo ***************************************************************
cind : [[1],[2],[3]] -> [[1,1],[1,2],[1,3],[2],[3]]
-> [[1,1,1],[1,1,2],[1,2],[1,3],[2],[3]]
-> [[1,1,2],[1,2],[1,3],[2],[3]] ->...-> []
cind の初期リストは第１変数 x の端点番号リストを用いる (<- xlist より)
cind[i][j]=[1,3] : 第1変数の端点番号が1，第2変数の端点番号が3であることを示す
length(cind[1]) : 変数番号( [1,3] のとき第2変数を示す)
restlr : [rxl,rxr] : 第１変数制限値
va : [[x1,x2,...,x5],[y1(x),...y6(x)],[z1(x,y),...,z4(x,y)]]
-> [[x1,..,x5,rxl,rxr],[y1(x),..,y6(x),ryl,ryr],[z1(x,y),...,z4(x,y),rzl,rzr]]
vxlist[1] : [rxl,x3,x4,rxr], <- x1<x2<rxl<x3<x4<rxr<x5
vxlist[2] : [ryl,y5(xm),y2(xm),ryr] <-- 制限値，複素数値を除いてソート(xmは中間値)
soind : [[6,3,4,7],[7,5,2,8]] <- vlist の va での位置番号を記憶する
(2,1)要素値 7 は値ryl はvans[2]での第7関数であることを示し，
(2,2)要素値 5 は値y5(xm)はvans[2]での第5関数であることを示す．
cind[1]=[2,3] のとき 領域 [[x3,x4],[y5(xm),ryl]] を示す
vl:[xl,yl,zl], vr:[xr,yr,zr], vm[xm,ym,zm]
: 端点リスト vlist に基づく区間の下限，上限，中間点の値
vlr:[xlr,ylr,zlr] : 端点での開閉
************************************************************************** */
debug:ifargd(), LLS:[],
c1show("on3ineq_fwd: 素領域の生成(時間がかかる)"),
/* floateval:true,*/
fL:f2l_one(on3f), c1show(fL), /* ff:fL[2], fl:fL[3], fr:fL[4], flr:fL[5],*/
/**** DEBUG:領域制限(第１変数のみ有効) *****/
vmdiv:2, /* [-4,-3] or [-2,-8/10], */
if listp(restlr)=false then restlr:[minf,inf],
va[1]:endcons([restlr[1],o],va[1]), va[1]:endcons([restlr[2],o],va[1]),
if vnoend > 1 then for vno:2 thru vnoend do (
va[vno]:endcons([minf,o],va[vno]), va[vno]:endcons([inf,o],va[vno])
),
vlist:makelist([],i,1,length(va)), vlist[1]:copylist(va[1]),
/* vlist[1] の生成とソート */
tmp : copylist(vlist[1]), c1show(tmp),
for i thru length(tmp) do
if (tmp[i][1]<restlr[1]) or (tmp[i][1]>restlr[2]) then tmp[i][1]:inf+1,
sind:msort(tmp,1), c2show(sind),
tmp1 : makelist(null,i,1,length(sind)),
for i thru length(sind) do tmp1[i]:tmp[sind[i]],
c1show(tmp1),
vlist[1]:tmp1,
c1show("領域制限:",vlist[1]), /* ??? */
soind : makelist([],i,1,vnoend),
soind[1]:copylist(sind), c2show(soind),
cind : makelist([i],i,1,length(vlist[1])), /*第１変数 x の端点番号リストを初期値とする*/
vl : makelist(null,i,1,vnoend), vr : copylist(vl), vm : copylist(vl),
c1show(soind), c2show(cind),
tlist:[],
c1show("===before loop===",vlist),
block(loop, /*======= begin of block-loop ==========================*/
c1show("--- S2-1: begin loop : 端点リストの構成---"),
vno : length(cind[1]), /* 変数番号 */
pno : cind[1][vno], /* 端点位置番号 */
/*--- 第1変数の端点リスト tlist=vlist[1] から各区間の中間点を求め，各中間点における
第2変数の端点リスト tlist1=vlist[2] を生成する．
ここで，vlist[2] は 第１変数の区間 [vlist[1][p],vlist[1][p+1]] に依存する．
これを制御添字リスト first(cind) に [p,1] として追加する．
[p,1] : 第1変数に関して第p区間，第2変数に関して第1区間を表す．
上記の操作を最終変数に到るまで繰り返す．
---*/
c1show("S2-1a:",vno,pno),
tlist : copylist(vlist[vno]), c2show(vlist),
if pno = length(tlist) then (c1show(va,outsum), return(outsum)), /* block から抜ける */
d2show(cind,vno,pno,va,tlist),
vl[vno] : tlist[pno][1], vr[vno] : tlist[pno+1][1], vm[vno] : tlist[pno][1],
vm[vno] : vl[vno]+(vr[vno]-vl[vno])/vmdiv, /* 中間点 */
if vl[vno]=minf and vr[vno]=inf then vm[vno]:1/3
else if vl[vno]=minf then vm[vno]:vr[vno]-1
else if vr[vno]=inf then vm[vno]:vl[vno]+1,
/*** if floateval=true then vm:float(vm) else vm:fullratsimp(vm), ***/
if vno=vnoend then (c1show(vm),c1show(vl),c1show(vr),c2show(vlist) ),
if vno < vnoend then (
tvrlist : [], tvflist:[],
for j thru length(va[vno+1]) do (
c2show("---pre-s:",vlist),
tv:va[vno+1][j][1], c2show("fwd:",tv),
/* vlist[1]からvlst[vno]より中間点を求め関数vans[vno+1]の中間点での値評価 */
/* tvf, tvflist : Float型, tv, tvlist : 非Float型 */
for k thru vno do tv:ev(tv,varl[k]=ev(vm[k]),expand,infeval), /* caution ******/
c2show(j,float(tv)),
/* va[vno+1] から複素数値 および 制限値を越える関数を除く */
if realp(tv) then (tvf:realpart(float(tv)) ) else tvf:false,
if tvf # false then
( tvflist:endcons([tvf,va[vno+1][j][2]],tvflist),
tvrlist:endcons([tv,va[vno+1][j][2]],tvrlist),
c1show("---inc",vno,"->",vno+1,j,tvf)
) else (tvflist:endcons([inf+1,va[vno+1][j][2]],tvflist),
tvrlist:endcons([inf+1,va[vno+1][j][2]],tvrlist) )
), /* end of for-j */
c2show(tvflist),
sind:msort(tvflist,1), /* call msort */
tlist1:makelist([],i,1,length(sind)),
for k1 thru length(sind) do tlist1[k1]:tvrlist[sind[k1]],
c2show(tlist1),c1show("昇順関数番号(va[vno+1]):",sind),
soind[vno+1]:sind,
c1show(soind), c2show(tlist1),
c2show("---pre1---",vlist),
vlist[vno+1]:copylist(tlist1),
c2show(vlist,"<- S2-1:更新vlist"),
tind1 : makelist(append(first(cind),[i]),i,1,length(tlist1)-1),
d2show(tind1),
cind : append(tind1,rest(cind,1))
), /* end of vno-then */
if vno < vnoend then (c2show("repeat"),go(loop)), /* ラベル loop に戻る */
/*=== cind に基づき領域構成を行う ==================================*/
fvlist:realpart(float(vlist)),
c1show(cind,"<- S2-1:cind,vlistの更新結果"),c1show("->",fvlist),
for kk:1 thru length(sind)-1 do (
c1show("===",kk,"==="),
swl : makelist(null,vno,1,vnoend), swr : makelist(null,vno,1,vnoend),
swlr : makelist(null,vno,1,vnoend), vlr : makelist(null,vno,1,vnoend),
lr : makelist(null,vno,1,vnoend),
for vno thru vnoend do (
pno:cind[1][vno], sno:soind[vno][pno], snop1:soind[vno][pno+1],
c2show(pno,sno,snop1),
swl[vno]:va[vno][sno][2], lr[vno]:swl[vno],
swr[vno]:va[vno][snop1][2],
c2show("--->",swl[vno],swr[vno],swlr[vno]),
if member(swl[vno],[o,s]) and member(swr[vno],[o,s]) then swlr[vno]:oo
else if member(swl[vno],[o,s]) and swr[vno]=c then swlr[vno]:oc
else if swl[vno]=c and member(swr[vno],[o,s]) then swlr[vno]:co
else if swl[vno]=c and swr[vno]=c then swlr[vno]:cc,
swlr0:copylist(swlr),
if vno < vnoend then swlr0[vno]:oo, /******************* CHANGE *********/
vlr[vno]:['va[vno][sno], 'va[vno][snop1],swlr0[vno]]
), /* end of for-vno */
c1show(vlr),
/* 中間点の値を求める */
vm:makelist(null,vno,1,vnoend), vl:makelist(null,vno,1,vnoend),
vr:makelist(null,vno,1,vnoend),
for vno thru vnoend do ( /* minf inf の処理 ? */
pno:cind[1][vno],
vl[vno] : vlist[vno][pno][1],
vr[vno] : vlist[vno][pno+1][1],
vm[vno] : vl[vno]+(vr[vno]-vl[vno])/vmdiv, /* 中間点 */
if vl[vno]=minf and vr[vno]=inf then vm[vno]:1/3
else if vl[vno]=minf then vm[vno]:vr[vno]-1
else if vr[vno]=inf then vm[vno]:vl[vno]+1
), /* end of for-vno */
/* if floateval=true then vm:float(vm) else vm:fullratsimp(vm), /* 重要 RAT */ */
if member(false,map(realp,vm))=true then (c1show(vm),quit()),
fvm:map(mkfloat,vm),
c1show(fvm),c2show(vm,fvm,on3f),
pno:cind[1][vnoend],c2show(fvlist[vnoend][pno],fvlist[vnoend][pno+1]),
c1show("before svm",on3f),
svm:on3f, for vno thru vnoend do fvm[vno]:varl[vno]=float(fvm[vno]),
c1show(svm,fvm),c1show(ev(svm,fvm)),
/* ERROR in this point in
on3ineq([(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co],debug2);*/
svm : ev(svm,fvm), if svm < 1.e-3 then svm:0 else svm:1,
c1show("中間点評価 --->",svm),
if svm=1 then /* 中間点での評価で解領域の輪郭を得る -> LL に追加する */
( LL:endcons(vlr,LL), c1show("***",length(LL),"->",last(LL)),
c1show(LL) ), /* end of svm=1 */
if svm=0 and swl[vnoend]=c then ( /* fl <= f(x,y) <= fl への対応 */
vlr[vnoend]:['va[vnoend][sno], 'va[vnoend][sno],cc],
LLS : endcons(vlr,LLS) ),
cind : rest(cind,1), c1show(cind) /* cindの更新 */
), /* end of for-kk ========================================= */
if length(cind[1]) < vnoend then go(loop),
c2show(LL), c2show(va), c2show("end of block")
), /*====== end of block loop ==========================================*/
if length(LL)=0 then LL:copylist(LLS), /* fl <= f(x,y) <= fl への対応 */
c1show("S2 の結果 ->"), c1show(LL), c1show(LLS),
return(LL)
)$
/*############################################################################*/
/*### msort : データ位置(昇順順位位置)を返す ###################################*/
/*############################################################################*/
msort([args]):=block([progn:"<msort>",debug,M, rows,cols,col,w,ws,sw,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of msort('help)--
機能: データ位置(昇順順位位置)を返す
文法: msort(M,{col},...)
例示:
v : [30,inf,10,-sqrt(2),1+2*%i,10,1,minf],
M : [[30,c],[inf,o],[10,c],[-sqrt(2),o],[2*%i+1,o],[10,o],[1,o],[minf,o]],
M2: [[x,c],[x-sqrt(2),o],[x+sqrt(2),c],[x-1,c]],
msort(v) = [8,4,7,3,6,1,2],
msort(M,1) = [8,4,7,3,6,1,2],
msort(M2,1) = [2,4,1,3],
メモ:
--end of msort('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of msort('ex)--"),
msort_ex(),
/*
block([progn:"<msort_ex>",debug],
c0show(msort(x^2+4*x-8)),
c0show(msort(expand((x^2+4*x-8)*(y-1)^3))),
return("---end of msort_ex---")
), /* end of block */
*/
print("--end of msort('ex)--"),
return("--end of msort('ex)--"),
block_main, /* main ブロック ====================================*/
M : args[1],
if length(M) = 0 then return(M),
for i thru length(args) do if numberp(args[i]) then col:args[i],
rows:length(M),if listp(M[1]) then cols:length(M[1]),
w:makelist(null,i,1,rows),
if listp(M[1]) then (for i thru rows do w[i]:M[i][col])
else (for i thru rows do w[i]:M[i]),
for i thru length(w) do if freeof(%i,null,w[i]) = false then w[i]:1+inf,
c1show(w),
ws:sort(w,"<"),ws:delete(1+inf,ws),
c1show(ws),out:makelist(null,i,1,length(ws)),
for i thru length(ws) do
(sw:0,
for j thru length(w) do
if ws[i] = w[j] and sw = 0 then (out[i]:j,w[j]:null,sw:1),
c2show(i,wout)),c2show("昇順位位置:",out),
c2show("注:非数(null)，複素数は除外し，inf+1 とする"),
return(out)
)$ /* end of msort() */
/*====== msort_ex() =========================================================*/
msort_ex() := block([progn:"<msort_ex>",v,M,M1,ansv,ansM,ansM2,out],
v : [30,inf,10,-sqrt(2),1+2*%i,10,1,minf],
M : [[30,c],[inf,o],[10,c],[-sqrt(2),o],[2*%i+1,o],[10,o],[1,o],[minf,o]],
M2: [[x,c],[x-sqrt(2),o],[x+sqrt(2),c],[x-1,c]],
ansv : [8,4,7,3,6,1,2],
ansM : [8,4,7,3,6,1,2],
ansM2 : [2,4,1,3],
print("msort_ex: データ位置(昇順順位位置)を返す"),
print(" 例1 : msort(v) "), print(" データ v： ", v), out : msort(v),
chk1show("msort(v)",ansv),
print(" 例2 : msort(M,1)"), print("データ M: ",M), out : msort(M,1),
chk1show("msort(M,1)",ansM),
print(" 例3 : msort(M2,1)"), print("データ M2: ",M2), out : msort(M2,1),
chk1show("msort(M2,1)",ansM2),
return("---end of msort_ex---")
)$ /* end of msort_ex() */
/*############################################################################*/
/*### gcd2l: L=[f1(x),f2(x),...] から Lout:[GCD,[f1/GCD,f2/GCD]] を返す ########*/
/*############################################################################*/
gcd2l([args]) := block([progn:"<gcd2l>",debug,L, wgcd,Lout],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of gcl2L('help)--
機能: リスト L=[f1(x),f2(x),...] から Lout:[GCD,[f1/GCD,f2/GCD]] を返す
文法: gcl2L(L,...)
例示: gcd2l([a*b*c,b*c*d,c*a*b]); -> [b*c,[a,d,a]]
メモ:
--end of gcl2L('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of gcl2L('ex)--"),
/* gcl2L_ex(), */
block([progn:"<gcl2L_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of gcl2L_ex---")
), /* end of block */
print("--end of gcl2L('ex)--"),
return("--end of gcl2L('ex)--"),
block_main, /* main ブロック ====================================*/
L : args[1],
if listp(L)=false or length(L) = 1 then return(Lout:[0,[0]]),
wgcd:L[1], for i:2 thru length(L) do wgcd:gcd(wgcd,L[i]),
Lout:[wgcd,L/wgcd],
return(Lout)
)$ /* end of gcd2l() */
/*### on3ineq_shrink #########################################################*/
/* <on3ineq_shrink> : 解領域の輪郭の開閉を処理する (in on3ineq()) */
/*############################################################################*/
on3ineq_shrink([args]) := block([progn:"<on3ineq_shrink>",debug,
outlineforce:false, vno,vnom1,ix, LXL,LYH,LXmid,LYLR0,LYLR,LTAB,xmid,tmp],
debug:ifargd(),
/* LERR:[], */
if vnoend=1 then (
tmp:flatten(LL), d2show(tmp),
for i thru length(va[1]) do
if va[1][i][2]=c and member('va[1][i],tmp)=false then (
add : ['va[1][i],'va[1][i],cc],
LL : endcons([add],LL),
c1show("--->孤立点追加",add) ), /* end of if-then */
return(LL)
),
outlineforce:false,
c1show("=== Start shrink:",outlineforce),
for vno:vnoend step -1 thru 2 do (
if outlineforce # true then (
vnom1:vno-1,
c1show("###########################################"),
c1show("### 開閉処理: 変数",vno,"--->",vnom1),
c1show("###########################################"),
/* LYLR0 = [ [[i,'R],LL[i][vno]], ... ] <- 検索点:",'va[vnom1][ix] をもつLLの項 */
/* LXL = [ ['V[1],'V[2],...,'V[vnom1-1]], ['V[1],'V[2],...,'V[vnom1-1]],... ]
'V[i] = [[vl,llr], [vr,rlr]]
<- 検索点:",'va[vnom1][ix] をもつLLの項の 第(vnom1-1)変数までの領域 */
/* LYH も必要?-> 必要無し!! ***********************************/
for ix thru length(va[vnom1]) do (
if outlineforce # true and va[vnom1][ix][2] # 's then (
c1show("===start=== 検索点:",'va[vnom1][ix]),c1show(va[vnom1][ix]),
/* 1次解から端点 x[ix] を含むyの領域に現れる端点y[j]を見出す */
LXL:[],LYH:[],LYLR0:[],
for i thru length(LL) do (
if LL[i][vnom1][1]='va[vnom1][ix] or LL[i][vnom1][2]='va[vnom1][ix] then (
LXL:endcons(rest(LL[i],-(vnoend-vnom1+1)), LXL),
LYH:endcons(rest(LL[i],vno), LYH) ),
if LL[i][vnom1][1]='va[vnom1][ix]
then LYLR0:endcons([[i,'R],LL[i][vno]],LYLR0),
if LL[i][vnom1][2]='va[vnom1][ix]
then LYLR0:endcons([[i,'L],LL[i][vno]],LYLR0)
), /* end of for-i */
if length(LYLR0) # 0 and freeof(minf,inf,va[vnom1][ix][1])=true
and outlineforce # true then (
LXL : unique(LXL), LYH : unique(LYH),
c1show(LYLR0), c1show(LXL,length(LXL)),
if LXL # [[]] then for i thru length(LXL) do (
LXmid:[], c2show(LXL[i]),
for j thru length(LXL[i]) do (
xl : ev(LXL[i][j][1],nouns)[1], xr:ev(LXL[i][j][2],nouns)[1],
if xl=minf and xr=inf then xmid:0
else if xl=minf then xmid : xr-1
else if xr=inf then xmid:xl+1 else xmid:(xl+xr)/2,
if j > 1 then xmid:ev(xmid, LXmid), c2show("->",LXmid),
if numberp(xmid)=false then xmid:float(xmid), /*************/
LXmid : endcons(varl[j]=xmid, LXmid)
), /* end of for-j */
c1show("-->",LXmid),
LYLR:copylist(LYLR0),
for k thru length(LYLR0) do (
c2show(rest(LL[LYLR0[j][1][1]],-(vnoend-vnom1+1)),LXL[i]),
if rest(LL[LYLR0[k][1][1]],-(vnoend-vnom1+1)) # LXL[i]
then LYLR[k]:null
),
LYLR:delete(null,LYLR),
c1show(i,LXL[i]),c1show("->",LXmid),c1show("->",LYLR),
shrink10(LYLR,'debug0) /*** call shrink ***/
), /* end of for-i */
if LXL = [[]] then (
c2show("case of LXL=[[]]"),
LXmid:[[]], LYLR:copylist(LYLR0),
c2show(LXL),c1show("->",LXmid),c1show("->",LYLR),
shrink10(LYLR,'debug0) /*** call shrink ***/
),
if outlineforce # true then c2show("更新",LL)
) /* end of if */
) /* end of outlineforce # true <2> */
), /* end of for-ix */
c2show(vno,LL)
) /* end of outlineforce # true <1> */
), /* end of for-vno */
return(LL)
)$ /* end of on3ineq_shrink() */
/*### shrink10 ########################################################################*/
/* y(x) から x=x_i での開閉を決める */
/*#####################################################################################*/
shrink10(LYLR,[args]) := block([progn:"<shrink10>",debug, ratprint:false, xvnoreal,
xeps,xv,xvm,xvp, yeps,yv,yvm,yvp,pointerror,lyepsk,yepsk,
LY,yvalue,S,SS,pend,Pco,LTAB,ii,sp,js,je],
/* use: flrlimit, floatfix, mkfloat, realp */
debug:ifargd(),
if outlineonly=true then return([]),
c1show("== Start shrink10 =="),
/**** LY:[['va[2][4],[y(x-),Pno,lr],[y(x+),Pno,lr]],...] の作成 ***/
LY:[],
for i thru length(LYLR) do (LY:endcons(LYLR[i][2][1],LY),LY:endcons(LYLR[i][2][2],LY) ),
LY:unique(LY), c2show(LY),
/* xv=va[vnom1][ix][1] におけるy(x)の左極限値,右極限値を調べる */
lyepsk:[],
for i thru length(LY) do (
yv:ev(LY[i],nouns)[1], xv:va[vnom1][ix][1], c2show(i,xv,yv),
if LXmid # [[]] then (xv:ev(xv,LXmid),yv:ev(yv,LXmid)),
xvnoreal:false,
if realp(xv)=false then (
cshow("E0: 検索点xの評価に失敗した"),
cshow(" ",va[vnom1][ix][1]),
cshow(" -> xvnoreal:true として処理を続行する"),
xvnoreal:true,
return(LTAB)
),
c2show(i,xv,yv,varl[vnom1]), /********/
[yvm,yvp,yepsk] : flrlimit(yv,ev(varl[vnom1]),xv), /*** call flrlimit 左右極限値 ***/
lyepsk:endcons(yepsk,lyepsk), c2show(xv,yvm,yvp),
if yv=minf or yv=inf then (yvm:yv,yvp:yv),
c1show("->",i,mkfloat(xv),yvm,yvp,yepsk),
LY[i]:[LY[i],[float(yvm)],[float(yvp)]]
), /* end of for-i */
if xvnoreal=true then return(LTAB),
lyepsk:delete(null,lyepsk),
if lyepsk=[] then yepsk:1.0E-5 else yepsk:last(sort(lyepsk,"<")),
if false then yepsk:yepsk*100,
c1show(lyepsk,"->",yepsk),
c2show("S1:",LY),
S:[], for i thru length(LY) do (S:endcons(LY[i][2][1],S), S:endcons(LY[i][3][1],S)),
c2show(S), c1show("S2:",S),
S:delete('null,S),
/* if member('null,S) then (cshow("===NULL==="),return(LTAB)), ********************/
S : sort(S,"<"), c2show("--sorted--",S),
if length(S)>1 and length(listofvars(S))=0 then for i thru length(S)-1 do (
if member(S[i],[minf,inf,null])=false then (
if abs(S[i+1]-S[i])<yepsk then S[i+1]:S[i]
)
), /* end of for-i */
c2show(S),c2show(unique(S)),
SS : sort(unique(S),"<"),
if length(SS)=0 then return(LTAB), /****************************************/
c1show(SS),
pend : length(SS),
if length(listofvars(SS))=0 then for i thru length(LY) do
for j thru length(SS) do (
if abs(float(LY[i][2][1])-SS[j])<=yepsk then LY[i][2]:endcons(j,LY[i][2]),
if abs(float(LY[i][3][1])-SS[j])<=yepsk then LY[i][3]:endcons(j,LY[i][3])
)
else (
cshow("E1: 検索点xにおける関数値y(x)の評価に失敗した"),
cshow(" ",va[vnom1][ix][1]),cshow(" ",SS),cshow(" ",LY),
cshow(" -> outlineonly:true として処理を続行する"),
/* outlineonly:true, */
return(LTAB)
), /* outlineonly:true */
for k thru length(LY) do (
if LY[k][2]=[null] then LY[k][2]:[null,0],
if LY[k][3]=[null] then LY[k][3]:[null,0]
),
c1show("S3:",LY),
pointerror:false,
for k thru length(LY) do (
if length(LY[k][2]) # 2 then (pointerror:true, cshow("Error:",k,LY[k]) ),
if length(LY[k][3]) # 2 then (pointerror:true, cshow("Error:",k,LY[k]) )
),
if pointerror=true then (cshow("Error at Point in shrink10:",xepsk,yepsk), quit()),
/* 端点番号とその開閉を調べる(閉線,開線の交点に注意) */
Pco : makelist(c,i,1,pend),
for p thru pend do
for i thru length(LY) do (
if LY[i][2][2]=p and ev(LY[i][1][2],nouns)=o then Pco[p]:o,
if LY[i][3][2]=p and ev(LY[i][1][2],nouns)=o then Pco[p]:o
), /* end of for-i */
c1show(Pco),
for i thru length(LY) do (
if LY[i][2]=[null,0] then LY[i][2]:[null,0,x] else
LY[i][2]: endcons(Pco[LY[i][2][2]], LY[i][2]),
if LY[i][3]=[null,0] then LY[i][3]:[null,0,x] else
LY[i][3]: endcons(Pco[LY[i][3][2]], LY[i][3])
), /* end of for-i */
c1show("S4:",yepsk),c1show(LY),
/* LTAB = [[[LLno,'L],['va[2][1],'va[2][3],lr],[P1,lr],[P2,lr],"R2"],...] */
LTAB : copylist(LYLR), /* LYLR の複写 */
for i thru length(LTAB) do (LTAB[i]:endcons([],LTAB[i]),LTAB[i]:endcons([],LTAB[i])),
for i thru length(LTAB) do (
for j thru length(LY) do if LTAB[i][2][1]=LY[j][1] then
if LTAB[i][1][2]='L then LTAB[i][3]:[LY[j][2][2],LY[j][2][3]]
else LTAB[i][3]:[LY[j][3][2],LY[j][3][3]],
for j thru length(LY) do if LTAB[i][2][2]=LY[j][1] then
if LTAB[i][1][2]='L then LTAB[i][4]:[LY[j][2][2],LY[j][2][3]]
else LTAB[i][4]:[LY[j][3][2],LY[j][3][3]]
), /* end of for-i */
for i thru length(LTAB) do c2show(i,LTAB[i]),
/*
for i thru length(LTAB) do if LTAB[i][3][1] > LTAB[i][4][1]
then LERR:endcons(LTAB[i][1][1],LERR),
*/
for i thru length(LTAB) do if LTAB[i][3][1] > LTAB[i][4][1] then LTAB[i]:null,
LTAB:delete(null,LTAB),
/* R1: 飛び越し, R2: 2点接続, R3: 1点接続 */
/* ----------- memo -------------------------------------------------------------------
[[ly1,o],[ly2,c]] -> [[P1,o],[P2,o]] R2 -> x
[[ly3,c],[ly4,o]] -> [[P2,o],[P2,o]] R3o -> x
[[ly5,c],[ly6,c]] -> [[P3,c],[P3,c]] R3 -> include
[[ry1,o],[ry2,o]] -> [[P1,o],[P2,o]] R2 -> include
[[ry4,c],[ry5,c]] -> [[P3,c],[P3,c]] R3c -> x
R1: 飛び越しの有無(P1,P4のときP2,P3が飛び越された点とする)
R11 飛び越された点にo点があれば飛び越し区間を不採用とする.
R12 飛び越された点がすべてc点のときは合併の可能性を調べる
R2: 異なる2点区間 [[Pi,lri],[Pj,lrj]] (Pi # Pj) では,lrバターンが一致する
[[yi,lr1],[yj,lrj]] があれば採用し,不一致のものは不採用とする.
R3: R3o:1点区間 [[Pi,o],[Pi,o]] は無処理,
R3c:1点区間 [[Pi,c],[Pi,c]] は一ヶ所のみ合併処理をおこなう.
---------------------------------------------------------------------------------- */
for i thru length(LTAB) do
if LTAB[i][4][1]-LTAB[i][3][1] > 1 then LTAB[i]:endcons("R1?",LTAB[i])
else if abs(LTAB[i][4][1]-LTAB[i][3][1])=1 then LTAB[i]:endcons("R2?",LTAB[i])
else if LTAB[i][4][1]-LTAB[i][3][1]=0 then LTAB[i]:endcons("R3?",LTAB[i])
else LTAB[i]:endcons("Rx?",LTAB[i]),
c2show("予備判定"),c2show(LTAB),
for i thru length(LTAB) do
if LTAB[i][5]="R2?" then (
if ev(LTAB[i][2][1][2],nouns)=LTAB[i][3][2] and
ev(LTAB[i][2][2][2],nouns)=LTAB[i][4][2]
then (
LTAB[i][5]:"R2",
if i < length(LTAB) then for j:i+1 thru length(LTAB) do
if LTAB[j][3]=LTAB[i][3] and LTAB[j][4]=LTAB[i][4] then LTAB[j][5]:"R2x"
)
else LTAB[i][5]:"R2x" ),
c2show("R2:2点接続"),c2show(LTAB),
for i thru length(LTAB) do
if LTAB[i][5]="R3?" then (
if LTAB[i][3][2]=c and LTAB[i][4][2]=c
/* and LTAB[i][2][3]=cc */
and ev(LTAB[i][2][1][2],nouns)=c and ev(LTAB[i][2][2][2],nouns)=c
then (
LTAB[i][5]:"R3",
if i < length(LTAB) then for j:i+1 thru length(LTAB) do
if LTAB[j][3]=LTAB[i][3] and LTAB[j][4]=LTAB[i][4] then LTAB[j][5]:"R3x"
)
else LTAB[i][5]:"R3x"
),
c2show("R3:1点接続"),c2show(LTAB),
for i thru length(LTAB) do
if LTAB[i][5]="R1?" and LTAB[i][4][1]-LTAB[i][3][1]=2 then (
sp:LTAB[i][3][1]+1, /* P1,P3 のとき P2 */
if Pco[sp]=o then LTAB[i][5]:"R1x",
if Pco[sp]=c then (
for j thru length(LTAB) do (
if j # i and LTAB[j][3][1]>=sp-1
and LTAB[j][4][1]<=sp+1
and not (LTAB[j][3][1]=sp-1 and LTAB[j][4][1]=sp+1)
then LTAB[j][5]:"R1-included" ),
LTAB[i][5]:"R1"
) /* end of if-Pco[sp]=c */
), /* end of 1点飛び越し */
c2show("R1:飛び越し"),c2show(LTAB),
c1show("R-判定結果"), for i thru length(LTAB) do c1show(i,LTAB[i]),
/* 変更箇所検出と開閉変更 ********************/
/* LTAB = [[[LLno,'L],['va[2][1],'va[2][3],lr],[P1,lr],[P2,lr],"R2"],...] */
for i thru length(LTAB) do (
if member(LTAB[i][5],["R1","R2","R3"]) then (
ii:LTAB[i][1][1],
if LTAB[i][1][2]='L then (
if LL[ii][vnom1][3]=oo then LL[ii][vnom1][3]:oc
else if LL[ii][vnom1][3]=co then LL[ii][vnom1][3]:cc ),
if LTAB[i][1][2]='R then (
if LL[ii][vnom1][3]=oo then LL[ii][vnom1][3]:co
else if LL[ii][vnom1][3]=oc then LL[ii][vnom1][3]:cc )
) /* end of if-then */ ), /* end of for-i */
/*epsk:null, */
return(LTAB)
)$
/*############################################################################*/
/*### mkfloat 虚数%iを含む数値を判定し実数であれば実数値を返す ########################*/
/*############################################################################*/
mkfloat([args]) := block([progn:"<mkfloat>",debug,expr, tmp,realonly_old,EPS:1.0E-7,in,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of mkfloat('help)--
機能: 虚数%iを含む数値を判定し実数であれば実数値を返す
文法: mkfloat(expr,...)
例示:
CS: mkfloat(1.0) = 1.0
CS: mkfloat(1.0E-10*%i+1.0) = 1.0
CS: mkfloat(1.0E-6*%i+1.0) = null
CS: mkfloat(2*x+%i) = unknown
CS: mkfloat([1.0]) = [1.0]
CS: mkfloat([1.0,1.0E-10*%i+1.0,1.0E-6*%i+1.0,2*x+%i]) = [1.0,1.0,null,unknown]
CS: freeof(unknown,null,mkfloat([1.0,1.0E-10*%i+1.0])) = true
CS: freeof(unknown,null,mkfloat([1.0,1.0E-10*%i+1.0,1.0E-6*%i+1.0,2*x+%i])) = false
メモ:
--end of mkfloat('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of mkfloat('ex)--"),
mkfloat_ex(),
/*
block([progn:"<mkfloat_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of mkfloat_ex---")
), /* end of block */
*/
print("--end of mkfloat('ex)--"),
return("--end of mkfloat('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
realonly_old:realonly, realonly:false,
if listp(expr)=false then in:[expr] else in:expr, out:makelist(null,i,1,length(in)),
for i thru length(in) do (
if listofvars(in[i]) # [] or in[i]=infinity then out[i]:'unknown
else (
tmp:in[i], tmp:ev(tmp,expand,infeval), tmp:float(tmp), tmp:rectform(tmp), /*重要*/
if cabs(tmp) < 1.0E-14 then tmp:0
else if abs(imagpart(tmp))/cabs(tmp) < EPS then tmp:realpart(tmp) else tmp:'null,
out[i]:float(tmp) ) /* end of else */
), /* end of for-i */
realonly:realonly_old,
if listp(expr)=false then return(out[1]) else return(out)
)$
/*--- mkfloat_ex -------------------------------------------------------------------*/
mkfloat_ex([args]) := block([progn:"<mkfloat_ex>",debug],
debug:ifargd(),
cshow(mkfloat(1.0)),
cshow(mkfloat(1.0+1.0E-10*%i)),
cshow(mkfloat(1.0+1.0E-6*%i)),
cshow(mkfloat(2*x+%i)),
cshow(mkfloat([1.0])),
cshow(mkfloat([1.0,1.0+1.0E-10*%i,1.0+1.0E-6*%i,2*x+%i])),
cshow(freeof(unknown,null,mkfloat([1.0,1.0+1.0E-10*%i]))),
cshow(freeof(unknown,null,mkfloat([1.0,1.0+1.0E-10*%i,1.0+1.0E-6*%i,2*x+%i]))),
return("---end of mkfloat_ex---")
)$ /* end of mkfloat() */
/*############################################################################*/
/*### floatfix: 数値 expr をk桁に丸めた結果を返す ##################################*/
/*############################################################################*/
floatfix([args]) := block([progn:"<floatfix>",debug,expr, keta, k,s,in,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of floatfix('help)--
機能: 数値 expr をk桁に丸めた結果を返す
文法: floatfix(expr,...)
例示:
CS: floatfix(1.234567,4) = 1.235
CS: floatfix([1.234567],4) = [1.235]
CS: floatfix([1.234567,123456.7,1.234567E-10],3) = [1.23,123000.0,1.23E-10]
CS: freeof(null,floatfix([1.234567,x+1.234567],4)) = false
メモ:
--end of floatfix('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of floatfix('ex)--"),
floatfix_ex(),
/*
block([progn:"<floatfix_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of floatfix_ex---")
), /* end of block */
*/
print("--end of floatfix('ex)--"),
return("--end of floatfix('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1], keta : args[2],
if listp(expr)=false then in:[expr] else in:expr, out:makelist(null,i,1,length(in)),
c2show(expr,in,keta),
for i thru length(in) do (
if numberp(in[i])=false then out[i]:'null
else if cabs(in[i]) < 1.0E-15 then out[i]:0
else (
k : keta - fix(log(cabs(in[i]))/log(10)) -1,
s:sign(in[i]), if s=pos then s:1 else if s=neg then s:-1 else s:0,
out[i] : s*float(fix(cabs(in[i])*10^k+0.5)/(10^k))
) /* end of else */ ), /* end of for-i */
if listp(expr)=false then return(out[1]) else return(out)
)$ /* end of floatfix() */
/*--- floatfix_ex -------------------------------------------------------------------*/
floatfix_ex([args]) := block([progn:"<floatfix_ex>",debug],
debug:ifargd(),
cshow(floatfix(1.234567,4)),
cshow(floatfix([1.234567],4)),
cshow(floatfix([1.234567,1.234567E5,1.234567E-10],3)),
cshow(freeof(null,floatfix([1.234567,x+1.234567],4))),
return("---end of floatfix_ex---")
)$ /* end of floatfix_ex() */
/*############################################################################*/
/*### flrlimit: x0:浮動小数での関数f(x)の左右極限値を評価する #######################*/
/*############################################################################*/
flrlimit([args]) := block([progn:"<flrlimit>",debug, func,var,x0,
f,df,dfm,dfp,xepsk,yepsk,xeps,yeps,ym,yp,wym,wyp,ky],
/* use: mfloat, floatfix */
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of flrlimit('help)--
機能: x0:浮動小数での関数f(x)の左右極限値を評価する
文法: flrlimit(func,var,x0,...)
例示:
CS: v21 =
(sqrt(27*x^4+32*x^3-486*x^2+2187)/(2*3^(3/2))-(x^2-9)/2)^(1/3)
-(2*x)/(3*(sqrt(27*x^4+32*x^3-486*x^2+2187)/(2*3^(3/2))-(x^2-9)/2)^(1/3))
CS: flrlimit(v21,x,x0) = [2.4595186,2.4595186,0]
CS: v24 =
(sqrt(27*x^4+32*x^3-54*x^2+27)/(2*3^(3/2))-(x^2-1)/2)^(1/3)
-(2*x)/(3*(sqrt(27*x^4+32*x^3-54*x^2+27)/(2*3^(3/2))-(x^2-1)/2)^(1/3))
CS: flrlimit(v24,x,x0) = [1.1681861,1.1681861,0]
CS: h1 = -sqrt(sqrt(8*x^2+1)-2*x^2-1)/sqrt(2) , x0 = 0
CS: flrlimit(h1,x,x0) = [0.0,0.0,0]
メモ:
--end of flrlimit('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of flrlimit('ex)--"),
flrlimit_ex(),
/*
block([progn:"<flrlimit_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of flrlimit_ex---")
), /* end of block */
*/
print("--end of flrlimit('ex)--"),
return("--end of flrlimit('ex)--"),
block_main, /* main ブロック ====================================*/
func : args[1], var : args[2], x0 : args[3],
c2show(progn,x0,func,flotnump(x0),mkfloat(x0)),
if floatnump(x0)=false and flimitmode#true then (
ym:limit(func,var,x0,minus), ym:mkfloat(ym),
yp:limit(func,var,x0,plus), yp:mkfloat(yp),
yepsk:0,
c1show("flrlimit:正確評価",x0,ym,yp),
return([ym,yp,yepsk])
),
x0:mkfloat(x0), c2show(x0,func),if x0='null then return([null,null,0]),
xepsk:1.0E-7,
if cabs(x0) < 1.0E-15 then xeps:1.0E-10 else xeps:floatfix(cabs(x0)*xepsk,1),
define(f(var), func), define(df(var),diff(f(var),var)),
dfm:mkfloat(df(x0-xeps)), dfp:mkfloat(df(x0+xeps)),
if dfm='null then dfm:0, if dfp='null then dfp:0,
yeps:max(abs(dfm),abs(dfp))*xeps*4,
ym:mkfloat(limit(f(var),var,x0-xeps,minus))+dfm*xeps,
yp:mkfloat(limit(f(var),var,x0+xeps,plus))-dfp*xeps,
c2show(progn,"-<0>",dfm,dfp,ym,yp,yeps,floatfix(yeps,1)),
if cabs(yp-ym) < yeps then yp:ym,
ky:4, /* 結果の有効桁数の指定 */
ym:floatfix(ym,ky),
yp:floatfix(yp,ky),
if ym='null then wym:0 else wym:cabs(ym),
if yp='null then wyp:0 else wyp:cabs(yp),
if ym='null and yp='null then return([null,null,0]),
if ym=0 and yp=0 then return([0,0,0]),
yepsk: floatfix( 10^(fix(log(max(wym,wyp))/log(10))-ky+1), 1) * 5,
yepsk: max(floatfix(yeps,1),yepsk), /****************************/
c2show(progn,ym,yp,yepsk),
return([ym,yp,yepsk])
)$ /* end of flrlimit() */
/*--- flrlimit_ex -----------------------------------------------------------------*/
flrlimit_ex([args]) := block([progn:"<flrlimit_ex>",debug,x0,v24,v21,h1],
debug:ifargd(),
v24:(sqrt(27*x^4+32*x^3-54*x^2+27)/(2*3^(3/2))-(x^2-1)/2)^(1/3)
-2*x/(3*(sqrt(27*x^4+32*x^3-54*x^2+27)/(2*3^(3/2))-(x^2-1)/2)^(1/3)),
v21:(sqrt(27*x^4+32*x^3-486*x^2+2187)/(2*3^(3/2))-(x^2-9)/2)^(1/3)
-2*x/(3*(sqrt(27*x^4+32*x^3-486*x^2+2187)/(2*3^(3/2))-(x^2-9)/2)^(1/3)),
x0:-3695/1806, /*-2.046*/
cshow(v21),cshow(flrlimit(v21,x,x0)),
cshow(v24),cshow(flrlimit(v24,x,x0)),
h1:-sqrt(sqrt(8*x^2+1)-2*x^2-1)/sqrt(2),
x0:0,
cshow(h1,x0),cshow(flrlimit(h1,x,x0)),
return("---end of flrlimit_ex---")
)$
/*############################################################################*/
/*### salgall 多連立多変数代数方程式の同時解を求める ###########################*/
/* [f1(x,y,z),f2(x,y,z)] -> [f1,f2,f1x,f2x,f1y,f2y,f1z,f2z] -> [f1,f2,f1x,f2x,f1y,f2y,f1z]
- ... -> [f1,f2] を順次 [x,y,z] について解く */
/*############################################################################*/
salgall([args]) := block([progn:"<salgall>",debug,eqs,varl,
realonly_old,vnoend,kend,dd:[],weqs:[],rnumv,ans],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of salgall('help)--
機能: 多連立多変数代数方程式の同時解を求める
文法: salgall(eqs,varl,...)
例示:
salgall([y-x^2+6*x-10, y+x^2-6*x],[x,y])
-> [[x = 1,y = 5],[x = 5,y = 5]]
salgall(y^3+2*x*y+x^2-1, [x,y])
-> [[x = -2.0459579,y = 1.1678921],[x = -0.65266742,y = -0.65962984]]
salgall((x-8)^2*((y-7)^2+(x-6)^2)*((z-5)^2+(y-4)^2+(x-3)^2)*(z^2+y^2+x^2-1),[x,y,z])
-> [[x = 3,y = 4,z = 5],[x = 6,y = 7,z = z],[x = 8,y = y,z = z],
[x = x,y = y,z = -sqrt((-y^2)-x^2+1)],
[x = x,y = y,z = sqrt((-y^2)-x^2+1)]]
メモ:
--end of salgall('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of salgall('ex)--"),
block([progn:"<salgall_ex>",debug,cmds,out,ans],
debug : ifargd(),
cmds : sconcat("(",
"/* 例1 2変数方程式の同時解 */ @",
"salgall([y-x^2+6*x-10, y+x^2-6*x], [x,y]) ",
")"),
ans : [[x = 1,y = 5],[x = 5,y = 5]],
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例2 2変数方程式の同時解(丸め誤差による不一致) */ @",
"out : salgall(y^3+2*x*y+x^2-1,[x,y]), @",
"out : scanmap(lambda([u],if floatnump(u) then floatfix(u,7) else u),out), @",
"out ",
")"),
ans : [[x = -2.045958,y = 1.167892],[x = -0.6526674,y = -0.6596298]],
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例3 3変数方程式の同時解 */ @",
"salgall((x-8)^2*((y-7)^2+(x-6)^2)*",
"((z-5)^2+(y-4)^2+(x-3)^2)*(z^2+y^2+x^2-1),[x,y,z]) ",
")"),
ans : [[x = 3,y = 4,z = 5],[x = 6,y = 7,z = z],[x = 8,y = y,z = z],
[x = x,y = y,z = -sqrt((-y^2)-x^2+1)],
[x = x,y = y,z = sqrt((-y^2)-x^2+1)]],
chk2show(cmds,ans),
return("---end of salgall_ex---")
), /* end of block */
print("--end of salgall('ex)--"),
return("--end of salgall('ex)--"),
block_main, /* main ブロック ====================================*/
eqs : args[1], varl : args[2],
vnoend:length(varl),
if listp(eqs)=false then eqs:[eqs], kend:length(eqs),
for vno thru vnoend do for k thru kend do dd:append(dd,[diff(eqs[k],varl[vno])]),
c1show("=== Enter salgall ==="),
realonly_old:realonly, realonly:false,
/* begin of block --------------------------*/
block([v,err],v:1, loop,
weqs:append(eqs,rest(dd,v)), /* v:0, rest(dd,-v) ****************/
if errcatch( ans:algsys(weqs,varl), return )=[] then (ans:[]),
c2show(v,weqs,ans),
if ans=[] and v < vnoend*kend then (v:v+1,go(loop)) else return(ans)
), /* end of block */
if ans=[] then c1show(progn, map(polydeg,eqs)),
c1show(length(weqs)),c1show("->",reveal(ans,10)),c1show(%rnum_list),
/* 複素数処理 */
for i thru length(ans) do for vno thru vnoend do
if realp(rhs(ans[i][vno]))=false then ans[i]:null,
ans:delete(null,ans),
/* 補助変数処理 */ rnumv:[],
for j thru length(ans) do ( for k thru length(ans[j]) do (
if member(rhs(ans[j][k]),%rnum_list) and atom(rhs(ans[j][k])) then
rnumv:endcons([rhs(ans[j][k]),lhs(ans[j][k])],rnumv)
) /* end of for-k */ ), /* end of for-j */ c1show(rnumv),
for k thru length(rnumv) do ans: subst(rnumv[k][2], rnumv[k][1], ans),
c1show("P3:y=%i*(x-x0)+y0 - > [x=x0,y=y0] の処理 <--",length(ans)),
block([w,c0,c1,c2,ansi,ansr,ansir],
for i thru length(ans) do (
c1show(i,ans[i]),
if vnoend > 0 then for j:2 thru vnoend do (
w:ans[i][j],c1show(ans[i][j]),
c0:listofvars(rhs(w)), c1:length(c0),
if c1 > 0 then c2:hipow(rhs(w),c0[1]) else c2:-1,
c1show(c0,c1,c2),
if lhs(w)=varl[j] and
freeof(%i,rhs(w))=false and polynomialp(rhs(w),c0)
and c1=1 and hipow(rhs(w),c0[1])=1
then (
c1show("---complex---",w),
ansi:algsys([imagpart(rhs(w))],c0)[1][1],
ansr:realpart(w),
c1show("--->",ansi,ansr),
if lhs(ansi)=varl[j-1] then ans[i][j-1]:ansi,
if lhs(ansr)=varl[j] then ans[i][j]:ansr,
ansir:[ansi,ansr],
if j < vnoend then
for jj:j+1 thru vnoend
do ans[i][jj]:lhs(ans[i][jj])=ev(rhs(ans[i][jj]),ansir)
) /* end of then */
) /* end of for-j */
), /* end of for-i */
ans:unique(ans),return(ans)), /* end of block ----------------------*/
for i thru length(ans) do ans[i]:sqrt2d(ans[i]), ans : unique(ans), /* add */
realonly:realonly_old,
c1show(ans),
return(ans)
)$ /* end of salgall() */
/*--- salgall_ex ----------------------------------------------------------------------*/
salgall_ex([args]) := block([progn:"<algall_ex>",debug,
Lex,ex,vl,out, ex1,C2,C2a,A1,A2,R30,R30b,R40],
debug : ifargd(),
Lex : [ex1,C2,C2a,/* hyx(x,y),*/ A1,A2,R30,R30b,R40],
/*
if length(args) > 0 and member(args[1],Lex) then Lex : [args[1]],
*/
ex1 : (x-8)^2*((y-7)^2+(x-6)^2)*((z-5)^2+(y-4)^2+(x-3)^2)*(z^2+y^2+x^2-1),
C2 : x^2+y^3+2*x*y-1,
C2a : expand(C2*(y-3*x)^3),
A1 : [y-x^2+6*x-10,y+x^2-6*x],
A2 : [(y-2)*(x^2+y^2+z^2-4),z-x^2-y^2-1],
R30 : ((x-1)^2+(y-2)^2+(z-3)^2)*(x^2+y^2+z^2-1),
R30b:(x-5)*((x-4)^2+(y-5)^2)*((z-3)^2+(y-2)^2+(x-1)^2)*(z^2+y^2+x^2-1),
R40 : ((t-4)^2+(z-3)^2+(y-2)^2+(x-1)^2)*(t^2+z^2+y^2+x^2-1),
for ex in Lex do (
print("--- 実行例 ---",ex), ex:ev(ex,nouns),
vl : listofvars(ex),
disp('salgall(ex,vl)),
out : salgall(ex,vl),
ldisplay(out)
),
return("---end of algall_ex---")
)$ /* end of salgall_ex() */
/*#############################################################################*/
/*### sqrt2d : [x=x, y=y, z = z0 + sqrt(c1*x^2+c2*x+c3*y^2+c4*y+c5)
= z0 + sqrt(c1*(x-a)^2+c2*(y-b)^2), c1 <0, c2 <0
-> [x=a,y=b,z=z0] ##################*/
/*#############################################################################*/
sqrt2d([args]) := block([progn:"<sqrt2d>",debug, ans0,
vnoend,varl,lastv,expr,out:[],rem,st,f,vl,vend,c2,j1,vv,f2,d,const,eqs,ans],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of sqrt2d('help)--
機能: z = z0 + sqrt(z1) z1 < 0 のとき z=z0 とする処理
文法: sqrt2d(ans0,...)
例示:
sqrt2d([x = x,y = y,z = sqrt((-y^2)+4*y-x^2+2*x-5)+3])
-> [x = 1,y = 2,z = 3]
sqrt2d([x = x,y = y,z = -sqrt((-y^2)-x^2+1)])
-> [x = x,y = y,z = -sqrt((-y^2)-x^2+1)]
メモ:
--end of sqrt2d('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of sqrt2d('ex)--"),
sqrt2d_ex(),
/*
block([progn:"<sqrt2d_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of sqrt2d_ex---")
), /* end of block */
*/
print("--end of sqrt2d('ex)--"),
return("--end of sqrt2d('ex)--"),
block_main, /* main ブロック ====================================*/
ans0 : args[1],
c1show("<<sqrt2d>> in ---",ans0),
vnoend : length(ans0), varl : map(lhs,ans0), lastv:last(varl), expr:rhs(last(ans0)),
c1show(progn,lastv,expr),
out:scanmap(lambda([u], if atom(u) = false then u:cons(op(u),args(u)) else u),expr),
c2show("S1:完全リスト:",out),
out:scanmap(lambda([u],
if listp(u) and first(u)=sqrt and listp(u[2])
then [u[1],l2f(u[2])] else u),out),
c1show("S2:",out),
if listp(out)=false then return(ans0),
rem : copylist(out),
rem:scanmap(lambda([u],
if listp(u) and first(u)=sqrt then u[2]:0 else u),rem), rem:l2f(rem),
c1show(rem,out),
if listp(out) = false then return(ans0),
st:[],
scanmap(lambda([u], if listp(u) and u[1]=sqrt and length(listofvars(u[2])) > 0
and hipow(u[2],listofvars(u[2])[1])=2
then (st:endcons(u[2],st)) else u ), out),
c1show("S3:",st),
if length(st)=0 then return(ans0),
/* 計算 */
f:st[1], vl:listofvars(f), vend:length(vl), c2:[], j1:true,
for v thru vend do (
c2:endcons(coeff(f,vl[v],2),c2), if c2[v] >= 0 then j1:false ), c1show(c2),
if j1=fase then return(ams0),
vv : [x0,y0,z0,t0,u0], vv:rest(vv,5-vend),
f2:0, for v thru vend do f2:f2+c2[v]*(vl[v]-vv[v])^2, f2:f2+c0,
c1show(f2,vv),
d : expand(f-f2),
c1show(d),const:d,
eqs:[], for v thru vend do
(eqs:endcons(coeff(d,vl[v],1),eqs), const:coeff(const,vl[v],0),
c2show(v,const) ),
eqs:endcons(const,eqs), c1show(eqs),
vv:endcons(c0,vv),
ans : algsys(eqs,vv), ans:ans[1],
c1show(ans),
if rhs(last(ans))=0 then (
c1show("完全2次形式"),
for v thru vnoend-1 do ans[v]: varl[v]=rhs(ans[v]), ans[vnoend]: lastv=rem,
c1show(ans0),c1show("--->",ans)
) else (c1show("---xx---"), ans:copylist(ans0) ),
return(ans)
)$
/*--- sqrt2d_ex -------------------------------------------------------------*/
sqrt2d_ex([args]) := block([progn:"<sqrt2d_ex>",debug, ans0,ans1, Lex,ex,out],
debug:ifargd(),
ans0 : [x=x,y=y,z = 3 + sqrt(-y^2+4*y-x^2+2*x-5)],
ans1 : [x=x,y=y,z = -sqrt(-y^2-x^2+1)],
Lex : [ans0,ans1],
for ex in Lex do (
print("---例---",ex),
disp('sqrt2d(ex)), out:sqrt2d(ex), ldisplay(out)
),
return("---end of sqrt2d_ex---")
)$ /* end of sqrt2d_ex() */
/*######################################################################*/
/* <acnode_join>: (内部使用) : 孤立点間の合併
on3(x,minf,inf,oo)*on3(y,y0,y0,cc)*{on3(z,z1(x),z1(x),cc)+on3(z,z2(x),z2(x),cc)}
-> on3(x,minf,inf,oo)*on3(y,y0,y0,cc)*on3(z,z1(x),z2(x),cc)
tvar, on3f は外部プログラムから参照する */
/*######################################################################*/
acnode_join(LWT0,[args]) := block([progn:"<acnode_join>",debug,
LWT:LWT0,out,ton3j:[],ton3k:[],gtj,gtk,wgtj,wgtk,wtl:[],vmid,won3f,tl,tr],
debug:ifargd(),
c1show("acnode_join start",LWT),
if not LWT[1] = "+" then (c1show("not reducedac",LWT), return([LWT,false])),
for j:2 thru length(LWT)-1 do (
if LWT[1]="*" then return([LWT,true]),
gtj:l2f(LWT[j]), c1show(gtj),
scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then ton3j:u else u), LWT[j]),
wgtj:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then u:1 else u), LWT[j]),
c1show(ton3j,wgtj,l2f(wgtj)),
if length(LWT) > 1 and LWT[1]="+" then for k:j+1 thru length(LWT) do (
gtk:l2f(LWT[k]),
scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then ton3k:u else u),LWT[k]),
wgtk:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then u:1 else u), LWT[k]),
c1show(ton3k,wgtk),
wtl:sort(unique([ton3j[3],ton3j[4],ton3k[3],ton3k[4]])), /* 条件 */
c1show(gtj,gtk,wtl,wgtj,wgtk),
if length(wtl)=2 and wgtj=wgtk and length(listofvars(wtl)) > 0
then (
vmid:makelist(null,vno,1,vnoend),
for vno thru vnoend do (
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=varl[vno]
then ( if u[3]=minf and u[4]=inf then vmid[vno]:u[2]
else vmid[vno]:(u[3]+u[4])/2, u)
else u), wgtj),
if varl[vno]=tvar then vmid[vno]:(ton3j[3]+ton3k[3])/2
), /* end of for vno */
c2show(vmid,on3f),
for vno thru vnoend do vmid[vno]:varl[vno]=expand(vmid[vno]),
won3f:on3f,
won3f:ev(won3f,vmid,infeval), c2show(won3f), /* 判別 */
if is( ton3j[3] < ton3k[3] ) then (tl:ton3j[3], tr:ton3k[3]),
if is( ton3j[3] >= ton3k[3] ) then (tl:ton3k[3], tr:ton3j[3]),
c2show(progn,ton3j[3],ton3k[3],is( ton3j[3] < ton3k[3] ),tl,tr),
if is( ton3j[3] < ton3k[3] ) # unknown then (
out:l2f(wgtj)*on3(tvar,tl,tr,cc),
cshow("reduced:",gtj),cshow(" and ",gtk),cshow("->",out),
LWT[j]:f2l(out),
LWT:delete(LWT[k],LWT,1) ), /* end of not 'umknown */
if length(LWT)=2 and LWT[1]="+" then LWT:LWT[2],
c1show(LWT),c1show(length(LWT)),
return([LWT,true])
) /* end of then */
) /* end of for-k */
), /* end of for-j */
return([LWT,false])
)$ /* end of acnode_join() */
/*### on3ineq_acnode ######################################################*/
/* <on3ineq_acnode: 孤立点処理 */
/*############################################################################*/
on3ineq_acnode(LF,[args]) := block([progn:"<on3ineq_acnode>",debug,
kend,f,fl,fr,flr, varlt:[], vnoend, swl,swr,swlr,Lout,tmp,display2d_old,
z0,z1,z2,z0num,z0den,z1num,z1den,z2num,z2den, eql,eqr,noreal,ans,tvar,
eqac:[],diffvar,weq,wgcd,rnumlist,ansac,won3f,won3fL,acnode,w0,w1,tt,outs:0,outl:0],
debug:ifargd(),
display2d_old:display2d, display2d:false,
if length(varl) = 1 then return(outs:0),
kend:length(LF),
c1show("===on3ineq_acnode start==="),
c1show(LF),
swl:makelist(null,k,1,kend), swr:makelist(null,k,1,kend),
swlr:makelist(null,k,1,kend),
eql:makelist(null,k,1,kend),eqr:makelist(null,k,1,kend),
for k thru length(LF) do (
f:LF[k][1],fl:LF[k][2],fr:LF[k][3], flr:LF[k][4],
varlt : endcons([listofvars(f),listofvars(fl),listofvars(fr)],varlt),
z0 : fullratsimp(f), z0den : denom(z0), z0num : num(z0),
z1 : fullratsimp(fl), z1den : denom(z1), z1num : num(z1),
z2 : fullratsimp(fr), z2den : denom(z2), z2num : num(z2),
eql[k] : z0num*z1den-z1num*z0den, /* 左境界面・線・点 */
eqr[k] : z0num*z2den-z2num*z0den, /* 右境界面・線・点 */
if fl=minf then eql[k]:null, if fr=inf then eqr[k]:null,
if flr=cc then (swl[k]:c, swr[k]:c, swlr[k]:c)
else if flr=co then (swl[k]:c, swr[k]:o, swlr[k]:o)
else if flr=oc then (swl[k]:o, swr[k]:c, swlr[k]:o)
else if flr=oo then (swl[k]:o, swr[k]:o, swlr[k]:o)
),
c1show("=== START on3ineq_acnode ==="),
varlt:unique(flatten(varlt)),
if atom(varl)=true then (varl:copylist(varlt),cshow(progn,"変数リスト自動生成:",varl)),
vnoend:length(varl),
c1show(eql),c1show(eqr),c1show(eqsing), c1show(varl,vnoend),
/* 追加すべき孤立点候補を得る */
eqac:[], diffvar : makelist(null,vno,1,vnoend),
for k thru kend do (
if swl[k]=c then eqac:endcons(eql[k],eqac),
if swr[k]=c then eqac:endcons(eqr[k],eqac)
),
eqac:unique(eqac), c1show(length(eqac)),c1show(eqac),
acnode:[], rnumlist:[],
for i thru length(eqac) do ( /*** CALL salgall ----------------------------***/
ansac:salgall([eqac[i]],varl), c1show("--",i,varl,ansac),
acnode : append(acnode,ansac)
), /* end of for-i*/
acnode:sort(unique(acnode)),
c1show(acnode),
/* add 2010-08-17 A2:use R30b: time over *****************************/
if true then (
c1show("A1: 交差面・線・点を求める"),
weq : [],
if length(eqac)>1 then for k1 thru length(eqac)-1 do
for k2:k1+1 thru length(eqac) do (
weq:[eqac[k1],eqac[k2]],
c1show(length(weq)), c1show(weq),
wgcd:gcd(weq[1],weq[2]),weq:weq/wgcd,
ans : salgall(weq,varl), /***** Call algall ********/
c1show(ans), acnode:append(acnode,ans),
if wgcd # 1 then ans:salgall(wgcd,varl),
c1show("wgcd",ans), acnode:append(acnode,ans)
),
acnode:sort(unique(acnode))
), /* end of if-false */
/* for i thru length(acnode) do acnode[i]:map('rhs,acnode[i]), */
/* acnode から特異点・線 vsing を除く */
for i thru length(acnode) do (
for vno thru vnoend do
if member(rhs(acnode[i][vno]), flatten(vsing[vno])) then acnode[i]:null
), /* end of for-i */
acnode:delete(null,acnode),
c1show("孤立点・線候補:",acnode),
/* 孤立線の検出 (z=z(x), z=z(y) は処理済み), y=y0 の3種類 */
if false then (
c1show(va), outl:0, won3f:on3f,
for vno:2 thru vnoend-1 do (
for i thru length(va[vno]) do
if length(listofvars(va[vno][i][1])) < vno-1 /* 変数の個数に基づく判定 */
and va[vno][i][2]=c then (
c1show(varl[vno],va[vno][i][1]),
won3f:ev(won3f,ev(varl[vno])=ev(va[vno][i][1]))
) /* end of fit */
),
c1show("---add---"),c1show(won3f),won3fL:f2l(won3f),c1show(won3fL),
if false then outl:funmake(on3ineq, [[won3fL[2],won3fL[3],won3fL[4],won3fL[5]]]),
c1show("--->",outl),
if true then outsum:outsum+outl
), /* end of if-false */
/* 孤立点 acnode が解領域on3f，既存の解領域outsumに含まれるか否かを判定 */
c1show(%rnum_list,rnumlist),
c1show(on3f),c1show(reveal(outsum,8)), outs:0,
for i thru length(acnode) do (
w0:on3f, w1:outsum,
for vno:vnoend step -1 thru 1 do (
if errcatch(w0:ev(w0,ev(varl[vno])=rhs(acnode[i][vno]),infeval), return)=[]
then w0:0,
if errcatch(w1:ev(w1,ev(varl[vno])=rhs(acnode[i][vno]),infeval), return)=[]
then w1:0
), /* end of for-vno */
c1show(i,acnode[i],w0,w1,float(w0),float(w1)),
if constantp(w1) then c1show(i,acnode[i],w0,w1),
tt:1,
for j thru length(acnode[i]) do (
if lhs(acnode[i][j])=rhs(acnode[i][j]) or member(rhs(acnode[i][j]),rnumlist)
then tt:tt*funmake(on3,[lhs(acnode[i][j]),minf,inf,oo])
else tt:tt*funmake(on3,
[lhs(acnode[i][j]),rhs(acnode[i][j]),rhs(acnode[i][j]),cc])
), /* end of for-j */
if constantp(w0) and w0=1 then (c1show(i,acnode[i],w0),c1show("->",tt)),
if w0=1 and constantp(w1) then outs : outs + w0*(w0-w1)*tt,
if w0=1 and constantp(w1)=false then (
c1show("acnode:",float(w1)), outs:outs+tt )
), /* end of for-i */
c1show(reveal(outs,10)),
/* 孤立点の合併 see A2 */
if outs # 0 then
( tvar:varl[vnoend], [Lout,tmp] : acnode_join(f2l(outs)), outs:l2f(Lout) ),
/*========================================================================*/
display2d:display2d_old,
return([acnode,outl,outs])
)$ /* end of on3ineq_acnode() */
/*### on3dplot2 ##############################################################*/
/* <on3dplot2: on3f:on3(fl,f(x,y),fr,flr) の解領域を表示する */
/*############################################################################*/
on3dplot2([args]) := block([progn:"<on3dplot2>",debug,plotmode:false,
argsL0,keyv,keyvx,keyvy,rxrange,ryrange,fo,xsing,ysing,xl,xr,nx,yl,yr,ny,
x,y,xp,yp,g,L:[],fL:[],vys:[],gtitle,gst,xyrange,wL,dlist,swview],
/* 共通変数: vsing=[xsing,ysing] */
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3dplot2('help)--
機能: on3f:on3(f(x,y),fl,fr,flr) の解領域を表示する
文法: on3dplot2([args])
例示:
c0show(\"例0. on3ineq()の結果を用いた実行例\")$
on3ineq([(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co],
’resultonly,'nooutsum,'noview)$
on3dplot2(on3((x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co),
'xrange=[-4,4],'yrange=[0,8],
'title=\"on3dplot2-ex0\",
'file_name=\"on3dplot2-ex0\",
''view)$
メモ: 共通変数: vsing=[xsing,ysing]
--end of on3dplot2('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3dplot2('ex)--"),
/* on3dplot2_ex(), */
block([progn:"<on3dplot2_ex>",debug,argsL,on3func,varl0,vsing0],
c0show("例0. on3ineq()の結果を用いた実行例"),
on3ineq([(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co],
’resultonly,'nooutsum,'noview),
on3dplot2(on3((x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co),
'xrange=[-4,4],'yrange=[0,8],
'title="on3dplot2-ex0",'file_name=sconcat(figs_dir,"/","on3dplot2-ex0"),
swview),
c0show("例1."),
argsL : [title = "on3dplot2",xrange = [-4,4],yrange = [0,8]],
on3func : on3((x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co), /* S1 */
vsing0 : [[[1,s]],[[2,s]]], /* 特異点リスト: on3ineq()で作成され共通変数として参照可 */
on3dplot2(on3func,'argsL=argsL,vsing0,
'title="on3dplot2-ex1",'file_name=sconcat(figs_dir,"/","on3dplot2-ex1"),
swview),
c0show("例2."),
on3dplot2(on3func,'xrange=[-4,4],'yrange=[0,8],vsing0,
'title="on3dplot2-ex2",'file_name=sconcat(figs_dir,"/","on3dplot2-ex2"),
swview),
return("---end of on3dplot2_ex---")
), /* end of block */
print("--end of on3dplot2('ex)--"),
return("--end of on3dplot2('ex)--"),
block_main, /* main ブロック ====================================*/
if member('plot, args) then plotmode:true,
if length(args)>0 then on3func : args[1],
if listp(varl)=false then varl:listofvars(on3func),
c1show(progn,args),
c1show(progn,argsL),
c1show(progn,varl),
c1show(progn,"特異点リスト:",vsing),
if listp(vsing)=false then return("Error: vsing が存在しない"),
/* 描画範囲と検査点数の初期値 */
rxrange : xrange=[-5,5], ryrange : yrange=[-5,5], nx:50, ny:50,
/* 引数から rxrange=[rxl,rxr], ryrange=[ryl,ryr] を設定する */
argsL0 : find_key(args,'argsL), if argsL0 # false then argsL0 : rhs(argsL0),
c1show(progn,argsL0),
if argsL0 # false then (
c1show(progn,"argsL が存在する場合",argsL0),
keyvx : find_key(argsL0,'xrange),
if keyvx # false then ( rxrange : keyvx, c1show(progn,rxrange) ),
keyvy : find_key(argsL0,'yrange),
if keyvy # false then ( ryrange : keyvy, c1show(progn,ryrange) ),
[xl, xr] : rhs(rxrange), [yl,yr] : rhs(ryrange)
),
if argsL0=false or keyvx=false or keyvy=false then (
c1show(progn,"argsL が存在しない場合:args内を検索"),
keyvx : find_key(args,'xrange),
if keyvx # false then ( rxrange : keyvx, c1show(progn,rxrange) ),
keyvy : find_key(args,'yrange),
if keyvy # false then ( ryrange : keyvy, c1show(progn,ryrange) ),
[xl, xr] : rhs(rxrange), [yl,yr] : rhs(ryrange)
), /* end of if-keyvx,keyvy */
/* 解領域の探索と結果リスト L の生成 */
define(fo(x,y),on3func),
xsing:copylist(vsing[1]), for i thru length(xsing) do xsing[i]:xsing[i][1],
ysing:copylist(vsing[2]), for i thru length(ysing) do ysing[i]:ysing[i][1],
for i:0 thru nx do (
xp : xl + (xr-xl)*i/nx,
vys : copylist(ysing),
c1show(vys),
for j thru length(vys) do vys[j]:ev(vys[j],x=xp),
for j:0 thru ny do (
yp : yl + (yr-yl)*j/ny,
if member(xp,xsing)=false and member(yp, vys)=false
and fo(xp,yp)=1 then L:endcons([xp,yp],L)
)), /* end of for-i */
c1show("on3dplot2:",L,length(L)),
gtitle:title="on3plot2d",
keyv : find_key(args,'title),
if keyv # false then ( gtitle : keyv, c1show(gtitle) ),
gst:sconcat("line_width=2.5, grid=true,",gtitle,", yrange=[",yl,",",yr,"]," ),
if length(L) > 0
then gst:sconcat("gr2d(points(",L,"),",gst)
else gst:sconcat("gr2d( ",gst),
c1show(gst),
/* 輪郭線描画 */
fL:f2l_one(on3func), c1show("===on3dplot2===",fL),
xyrange:sconcat(varl[1],",",xl,",",xr,",",varl[2],",",yl,",",yr),
if fL[1]="*" then ( c1show("on3dplot2:連立不等式の場合"),
for k:2 thru length(fL) do (
wL:f2l_one(fL[k]), c1show(wL),
gst:sconcat(gst,"color=blue,implicit(",wL[2]-wL[3],",",xyrange,"),"),
gst:sconcat(gst,"color=red, implicit(",wL[2]-wL[4],",",xyrange,"),")
),gst:strimr(",",gst) ) /* end of 連立不等式 */
else ( c1show("on3dplot2:単一不等式の場合"),
gst:sconcat(gst,"color=blue,implicit(",fL[2]-fL[3],",",xyrange,"),"),
gst:sconcat(gst,"color=red, implicit(",fL[2]-fL[4],",",xyrange,")")
),
gst:sconcat(gst,")"),c1show(gst),
gst : eval_string(gst),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3dplot2-2"),
columns=1, dimensions=[500,500]],
dlist : mergeL(dlist,args,['terminal,'file_name,'columns,'dimensions]),
c1show(progn,dlist),
mk_draw([gst], dlist, swview),
return(gst)
)$
/* ### on3gr2 : on3関数で記述された領域(2変数，孤立点も可)の作図 ################*/
/* outsum = Σ on3(x,xl,xr,lx)*on3(y,yl(x),yr(x),ly) の描画 */
/* 使用例 : on3gr2(outsum), on3gr2(outsum,xrange=[0,3],yrange=[0,3]) */
/*############################################################################*/
on3gr2([args]) := block([progn:"<on3gr2>",debug,
plotmode:true, viewmode:false, swview, dlist,
expr, argsL0,keyvx,keyvy,rxrange,ryrange, nx,ny, svarl, xvar,lastvar,vend,
rxl,rxr,ryl,ryr, gtitle,flw,Lxp,is,iend,
L,fl,fr,flr,xl,xr,xlr,fltype,frtype,xrng,D,FD,Fl,Fr,gst],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3gr2('help)--
機能: on3関数で記述された領域(2変数，孤立点も可)の作図
文法: on3gr2(outsum,...)
例示: on3gr2(outsum)$
on3gr2(outsum,'xrange=[0,3],'yrange=[0,3],'view)$
メモ: 共通変数: vsing=[xsing,ysing]
--end of on3gr2('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3gr2('ex)--"),
/* on3gr2_ex(), */
/*
block([progn:"<on3gr2_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of on3gr2_ex---")
), /* end of block */
*/
print("--end of on3gr2('ex)--"),
return("--end of on3gr2('ex)--"),
block_main, /* main ブロック ====================================*/
if member('view,args) then viewmode:true,
if length(args)>0 then expr : args[1], /* 必須の引数 */
c1show(progn,length(args),args),
/* 描画範囲と検査点数の初期値 */
rxrange : xrange=[-2,2], ryrange : yrange=[-2,2], nx:50, ny:50,
/* 引数から rxrange=[rxl,rxr], ryrange=[ryl,ryr] を設定する */
argsL0 : find_key(args,'argsL), if argsL0 # false then argsL0 : rhs(argsL0),
c1show(progn,argsL0),
if argsL0 # false then (
c1show(progn,"argsL が存在する場合",argsL0),
keyvx : find_key(argsL0,'xrange),
if keyvx # false then ( rxrange : keyvx, c1show(progn,rxrange) ),
keyvy : find_key(argsL0,'yrange),
if keyvy # false then ( ryrange : keyvy, c1show(progn,ryrange) ),
[rxl, rxr] : rhs(rxrange), [ryl,ryr] : rhs(ryrange)
),
if argsL0=false or keyvx=false or keyvy=false then (
c1show(progn,"argsL が存在しない場合:args内を検索"),
keyvx : find_key(args,'xrange),
if keyvx # false then ( rxrange : keyvx, c1show(progn,rxrange) ),
keyvy : find_key(args,'yrange),
if keyvy # false then ( ryrange : keyvy, c1show(progn,ryrange) ),
[rxl, rxr] : rhs(rxrange), [ryl,ryr] : rhs(ryrange)
), /* end of if-keyvx,keyvy */
c1show("on3gr2:",expr),
if listp(varl)=true then svarl:sort(varl) else svarl:sort(listofvars(expr)),
c1show(svarl),
if (length(svarl) # 2) then
(cshow(progn,"---> 2変数でないので作図処理を中止する"),return()),
c1show(progn,"変数リスト自動生成:",svarl),
xvar:first(svarl), lastvar:last(svarl), vend:length(svarl),
c1show("on3gr2:",xvar,lastvar,vend),
L : f2l(expr), Fl:[], Fr:[], Lxp:[], FD:[], c1show(L),
if L[1]="*" then (is:1, iend:1, L:[L]) else (is:2,iend:length(L)),
for i:is thru iend do (
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=lastvar then
(fl:u[3], fr:u[4], flr:u[5]) else u ), L[i]),
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=xvar then
(xl:u[3], xr:u[4], xlr:u[5]) else u ), L[i]),
xl:realpart(float(xl)), xr:realpart(float(xr)),
Lxp:append([xl,xr],Lxp),
D:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=lastvar then
u:1 else u ), L[i]),
D : l2f(D), if vend = 3 then (fl:fl*D, fr:fr*D),
if floatnump(xl) or floatnump(xr)
then flw:"line_width=3" else flw:"line_width=5",
if flr=oo then (fltype:"line_type=dots", frtype:"line_type=dots")
else if flr=oc then (fltype:"line_type=dots", frtype:"line_type=solid")
else if flr=co then (fltype:"line_type=solid", frtype:"line_type=dots")
else if flr=cc then (fltype:"line_type=solid", frtype:"line_type=solid"),
if freeof(minf,xl)=false then xl:rxl, if freeof(inf,xr)=false then xr:rxr,
xl:xl+0.00001, xr:xr-0.00001, /**** CAUTION *****/
if freeof(minf,fl)=false then fl:ryl, if freeof(inf,fr)=false then fr:ryr,
xrng:sconcat(xvar,",",xl,",",xr), c1show(xrng),c1show(fl),c1show(fr),
if abs(xr-xl) < 1.0e-3 and length(listofvars(fl))=0
then FD:endcons([xl,fl],FD), /* 立点 */
if abs(xr-xl) > 1.0e-3 then Fl:endcons([fl,fltype,xrng],Fl),
if abs(xr-xl) > 1.0e-3 then Fr:endcons([fr,frtype,xrng],Fr)
), /* end of for-i */
c1show("on3gr2:孤立点:",FD),
for i thru length(Lxp) do (
if Lxp[i]=minf then Lxp[i]:rxl, if Lxp[i]=inf then Lxp[i]:rxr ),
Lxp:unique(Lxp), Lxp:sort(Lxp,"<"),
for i thru length(Lxp) do Lxp[i]:[Lxp[i],ryl], c1show(Lxp),
c1show("on3gr2:X軸上の点:",Lxp),
Lxp : float(Lxp),
c1show(Fl),c1show(Fr), c1show(rxrange,ryrange),
if length(svarl)= 2 then ( /* 2次元プロット */
gtitle:title="Build on3 Func.",
gst : sconcat("gr2d( grid=true, line_width=3, ",gtitle) ,
if rxrange # "" then gst : sconcat(gst, ",",rxrange),
if ryrange # "" then gst : sconcat(gst, ",",ryrange),
c1show(gst),
gst : sconcat(gst,", point_size=1.5, point_type=7, points(",Lxp,")"),
if length(FD)>0 then
gst : sconcat(gst,
", point_size=1.0, point_type=7, color=darkgreen, points(",FD,")"),
c1show(gst),
for i:1 thru length(Fl) do (
gst: sconcat(gst,",color=blue,",flw,",",
Fl[i][2],", explicit(",Fl[i][1],",",Fl[i][3],") "),
gst: sconcat(gst,",color=red,",flw,",",
Fr[i][2],", explicit(",Fr[i][1],",",Fr[i][3],") ")
),
gst : sconcat(gst, ")"),c1show(plotmode),
c1show(gst),
/*
if viewmode then grv(gst,dimensions=[1800,1400])
*/
gst : eval_string(gst),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","tmp-on3gr2"),
columns=1, dimensions=[600,500]],
mk_draw([gst], dlist, swview )
), /* end of plot-2D */
return(gst)
)$ /* end of on3gr2() */
/*############################################################################*/
/*------on3ineq_ex---------------------------------------------------------*/
/*############################################################################*/
on3ineq_ex([args]) := block([progn:"<on3ineq_ex>",
debug,plotmode:true,viewmode:true,swview,ex,excase,
keyL, key, dlist,
display2d_old, /* ex, out, fL, on3func,*/
fL2,dxlr, xl,xr,nx, dylr,yl,yr,ny,gd,gout,
ex12,c2oo,c2oc,c2co,c2cc, c3oo,c3oc,c3co,c3cc, c4oo,c4oc,c4co,c4cc,
A1,A2,R30,R30b,R30c,R31,R32,C1,C2,L3,c4,S0,S1,S2,S3,K1,K2,H1,H1a,H2],
debug:ifargd(),
declare([ex12,c2oo,c2oc,c2co,c2cc, c3oo,c3oc,c3co,c3cc,
c4oo,c4oc,c4co,c4cc,A1,A2,R30,R30b,R30c,R31,R32,
C1,C2,L3,c4,S0,S1,S2,S3,K1,K2,H1,H1a,H2],constant),
c1show("=== Enter ",progn, "==="),
if length(args)>0 then excase : args[1],
if member('noview, args) then swview:'noview else swview:'view,
if member('noplot, args) then (plotmode:false, args:delete('noplot,args)),
if member('view, args) then (viewmode:true, args:delete('view,args)),
if member('noview, args) then viewmode:false,
if length(args) = 0 then ( printf(true,"
[Usage of <'on3ineq_ex([args])>]:~%
Exs: ex12,c1,c2oo,c2oc,c2co,c2cc, c3oo,c3oc,c3co,c3cc,
c4oo,c4oc,c4co,c4cc,A1,A2,R30,R30b,R30c,R31,R32,
c1,C1,C2,L3,c4,S0,S1,S2,S3,K1,K2,H1,H1a,H2 ~%
Ex : on3ineq(c2co,debug1,'view)$
out : 'on3ineq_ex(c3co,'view,file_name=\"tmp-c3co\")$
on3gr(out,view)$ ~%
Ex : ineqex({C1|C2|A1|S1|H1a|H2},file_name=\"tmp-S1\",'view)$ ~%"
),
return("--- args = [] ---") /* end of printf */
) /* end of if-then */
else (excase : args[1], args : rest(args,1)),
/* args で指定できる draw オプション dlist */
if true then (
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3ineq_ex"),
columns=2, dimensions=[1000,500]],
keyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,keyL),
c1show(progn,dlist)
), /* end of if-false */
/* end of args dlist */
c1show(progn,excase),
c1show(progn,args),
c1show(progn,dlist),
if member(excase,[A2]) then plotmode:false,
display2d_old:display2d,
display2d:false,
/*
exL : [[x^3-6*x^2+9*x-2,2,inf,co]],
exL : append(exL,dlist,[swview])
ex : funmake(on3ineq,exL)
*/
ex12 : [ [[x^3-6*x^2+9*x-2,2,inf,co]] ],
/* c1:[ [[x^2-3*x+2,0,9,co]] ], */
c2oo:[ [[x^2+y^2,1,9,oo]] ],
c2oc:[ [[x^2+y^2,1,9,oc]] ],
c2co:[ [[x^2+y^2,1,9,co]] ],
c2cc:[ [[x^2+y^2,1,9,cc]] ],
C1:[ [[x^3 + y^2 + x*y,1,9,co]], 'xrange=[-4,4],'yrange=[-4,4] ],
C2:[ [[x^2+y^3+2*x*y,1,9,co]], 'xrange=[-5,5],'yrange=[-5,5] ],
/* reveal(out2,6); */
c3oo:[ [[x^2+y^2+z^2,1,9,oo]] ],
c3oc:[ [[x^2+y^2+z^2,1,9,oc]] ],
c3co:[ [[x^2+y^2+z^2,1,9,co]] ],
c3cc:[ [[x^2+y^2+z^2,1,9,cc]] ],
c4oo:[ [[t^2+x^2+y^2+z^2,1,9,oo]] ],
c4oc:[ [[t^2+x^2+y^2+z^2,1,9,oc]] ],
c4co:[ [[t^2+x^2+y^2+z^2,1,9,co]] ],
c4cc:[ [[t^2+x^2+y^2+z^2,1,9,cc]] ],
L3:[ [[x^4+y^3+2*x*y+z^2,1,9,co]] ],
c4:[ [[x^4+y^3,1,9,co]] ],
A1:[ [[y,(x-1)*(x-5)+5,-(x-1)*(x-5)+5,co], [y,-(x-2)+3,(x-2)+3,co]],
'xrange=[0,6],'yrange=[0,10] ],
/*
A2:[ [[(x^2+y^2+z^2)*(y-2),4*(y-2),(y-2),cc],[z-x^2-y^2,1,2,cc]] ],
*/
/*
R30:[ [[((x-1)^2+(y-2)^2+(z-3)^2)*(x^2+y^2+z^2),
minf,((x-1)^2+(y-2)^2+(z-3)^2),oc]] ],
R30b:[ [[(x-8)^2*((x-6)^2+(y-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2)*(x^2+y^2+z^2),
(x-8)^2*((x-6)^2+(y-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2),
4*(x-8)^2*((x-6)^2+(y-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2),cc]] ],
R30c:[ [[(x-8)^2*((y-6)^2+(z-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2)*(x^2+y^2+z^2),
(x-8)^2*((x-6)^2+(y-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2),
4*(x-8)^2*((x-6)^2+(y-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2),cc]] ],
R31:[ [[((y-2)^2+(z-3)^2)*(x^2+y^2+z^2),
minf,((y-2)^2+(z-3)^2),oc]] ],
R32:[ [[((y-2)^2)*(x^2+y^2+z^2), minf,((y-2)^2),oc]] ],
*/
S0:[ [[(x-y)/((x-1)*(y-2)), 1/(x-1), 1/(y-2),co]],'xrange=[-3,5],'yrange=[-2,5] ],
S1:[ [[(x^2-y)/((x-1)*(y-2)), 1/(x-1), 1/(y-2),co]],'xrange=[-4,4],'yrange=[0,5] ],
S2:[ [[(x^5-x*y-y)/((x^4-2)*(y-2)), 1/(x-1), 1/(y-2),co]],
'xrange=[-2,2],'yrange=[0,4] ],
S3:[ [[(x^5-x*y-y)/((x^4-2)*(y-2*x)), 1/(x-1), 1/(y-2),co]],
'xrange=[-4,3],'yrange=[0,5] ],
K1:[ [[(-1+z^2+y^2+x^2)*((y-3)^2+(x-2)^2),0,0,cc]] ],
K2:[ [[(-1+z^2+y^2+x^2)*(y-2),0,0,cc]] ],
H1:[ [[x^2-y^2-(x^2+y^2)^2,0,0,cc]],'xrange=[-1.5,1.5],'yrange=[-1,1] ],
H1a:[ [[x^2-y^2-(x^2+y^2)^2,-1,0,oc]], 'xrange=[-1.5,1.5],'yrange=[-1.5,1.5] ],
H2:[ [[93392896/15625*y^6
+(94359552/625*x^2+91521024/625*x-249088/125)*y^4
+(1032192/25*x^4-36864*x^3-7732224/25*x^2-207360*x+770048/25)*y^2
+65536*x^6+49152*x^5-135168*x^4-72704*x^3+101376*x^2+27648*x-27648,
0,0,cc]],'xrange=[-1.5,1.5],'yrange=[-1.5,1.5] ],
c1show(progn,"---",excase),
ex:ev(excase),
ex : funmake(on3ineq, append(ex,dlist,[swview])),
cshow("=== ■ ■ ■ ",progn, " ■ ■ ■ ==="),cshow(excase),cshow(ev(excase)),
outsum : ev(ex,infeval), /* on3ineq の評価 */
c1show(progn,vsing,V),
return("--end of on3ineq_ex--")
)$ /* end of on3ineq_ex() */
/*############################################################################*/
/*### on3romberg: 1変数on3式のRomberg積分 2020.07.07 ###########################*/
/*############################################################################*/
on3romberg([args]) := block([progn:"<on3romberg>",debug,on3func,
v,vl,vr,eps,w,wsum],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3romberg('help)--
機能: 1変数on3式のRomberg数値定積分
文法: on3romberg(on3func,...)
例示: on3romberg(x*on3(x,1,3,co))
メモ:
--end of on3romberg('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3romberg('ex)--"),
/* on3romberg_ex(), */
block([progn:"<on3romberg_ex>",debug],
c0show(on3romberg(x*on3(x,1,3,co))),
return("---end of on3romberg_ex---")
), /* end of block */
print("--end of on3romberg('ex)--"),
return("--end of on3romberg('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : expand(args[1]),
outLev(on3info(on3func,x),"w_"),
wsum : 0,
for i:1 thru length(w_Lon3coef) do (
v : w_Lon3[i][2], vl:w_Lon3[i][3],vr:w_Lon3[i][4],
w : romberg(w_Lon3coef[i],v,vl,vr),
if constantp(w)=false then (
eps : (vr-vl)*1e-6,
vl : vl + eps, vr : vr - eps,
w : romberg(w_Lon3coef[i],v,vl,vr)
),
wsum : wsum + w,
c1show(i,w_Lon3[i][3],w_Lon3[i][4],w)
),
c1show(wsum),
killvars(["w_"]),
return(wsum)
)$ /* end of on3romberg() */
/*############################################################################*/
/*### on3integ10: on3多項式の数式積分 #########################################*/
/*############################################################################*/
on3integ10([args]) := block([progn:"<on3integ10>",debug,on3func,var,
L,vl,vr,F,sum],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3integ10('help)--
機能: on3多項式の数式積分
文法: on3integ10(on3func,...)
例示: on3integ10(x*on3(x,1,3,co),x)
メモ:
--end of on3integ10('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3integ10('ex)--"),
/* on3integ10_ex(), */
block([progn:"<on3integ10_ex>",debug],
c0show(on3integ10(x*on3(x,1,3,co), x)),
return("---end of on3integ10_ex---")
), /* end of block */
print("--end of on3integ10('ex)--"),
return("--end of on3integ10('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1], var : args[2],
L:f2l(on3std(on3func)), c1show(L), /* change 2012.01.25 */
if L[1]="+" then L:delete(L[1],L) else if L[1]="*" then L:[L], c1show("chk:",L),
sum :0, for i thru length(L) do (
c1show(L[i]),
L[i]:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var
then (vl:u[3],vr:u[4], u:null) else u),L[i]),
L[i]:delete(null,L[i]),c1show(L[i]),
c1show(vl,vr), ratprint:false,
F : integrate(L[i][2],var), /* 不定積分から */
L[i][2] : ev(F,ev(var)=vr) - ev(F,ev(var)=vl),
c1show(L[i][2]),
sum : l2f(L[i]) + sum
), /* end of for-i */
c1show(sum),
return(sum)
)$ /* end of on3integ10() */
/*############################################################################*/
/*### nor2d : 2変量正規分布の密度関数 ##########################################*/
/*############################################################################*/
nor2d([args]) := block([progn:"<nor2d>",debug,x,y,mx,my,sx,sy,r,
c1,c2,zx,zy,out,swview,figfile],
debug:ifargd(),
if member('noview,args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of nor2d('help)--
機能: 2変量正規分布の密度関数
文法: nor2d(x,y,mx,my,sx,sy,r,...)
例示: nor2d(x,y,0,0,1,1,0.7)
--end of nor2d('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of nor2d('ex)--"),
/* nor2d_ex(), */
block([cmds,f],
figfile : sconcat(figs_dir,"/","nor2d"),
cmds : sconcat("( ",
"f : nor2d(x,y,0,0,1,1,0.7), /* 2次元正規分布の密度関数置数 */ @",
"gr3v([explicit(f,x,-4,4,y,-4,4)],'title=\"plot of nor2d\",@",
"'file_name=",figfile,", ", swview, "), /* fの描画 */ @",
"c0show(f) /* f の標示 */",
" )"),
chk1show(cmds,""),
return(f)
), /* end of block */
print("--end of nor2d('ex)--"),
return("--end of nor2d('ex)--"),
block_main, /* main ブロック ====================================*/
x:args[1], y:args[2], mx:args[3], my:args[4], sx:args[5], sy:args[6], r:args[7],
c1:1/(2*%pi*sx*sy*sqrt(1-r^2)),
zx:(x-mx)/sx, zy:(y-my)/sy,
c2:-1/(2*(1-r^2))*(zx^2 -2*r*zx*zy+zy^2),
out: c1 * exp(c2), c1show(out),
return(out)
)$ /* end of nor2d() */
/*############################################################################*/
/*### q3 : 2変量正規分布の領域確率 ############################################*/
/*############################################################################*/
q3([args]) := block([progn:"<q3>",debug,swview,plotmode:true,viewmode:true,cmds,
D0,x,y,f,Fxy0,Fx0,F0,F0ans,fdens,D,Fxy,Fx,P,Pans,dlist, keyL, key, g0,g],
debug:ifargd(),
if member('noview,args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of q3('help)--
機能: 2変量正規分布の領域[[x+y,2,inf,co],[x,-4,1,cc],[y,-4,4,cc]]の確率を求め図示する
文法: q3({'help|'ex|'go},...)
例示: q3('go, 'file_name=\"sconcat(figs_dir,'/','q3')\", 'columns=2, 'dimensions=[1000,500])
--end of q3('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of q3('ex)--"),
print(" --> q3('go))"),
/* q3_ex(), */
print("--end of q3('ex)--"),
return("--end of q3('ex)--"),
block_main, /* main ブロック ====================================*/
/* args で指定できる draw オプション dlist */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","q3"),
columns=2, dimensions=[1000,500]],
keyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,keyL),
cshow(progn,dlist),
if member('noplot,args) then plotmode:false,
if member('noview,args) then viewmode:false,
cmds : sconcat("( ",
"/* 領域D0の設定, 相関のある2変量標準正規分布の確率密度関数 f の設定 */ @",
"D0:on3ineq([[x,-4,4,cc],[y,-4,4,cc]],'resultonly,'noview), @",
"f:nor2d(x,y, 0,0, 1,1, 0.7), /* 相関のある2変量標準正規分布の確率密度関数 */ @",
"Fxy0:expand(f*D0), Fx0:on3integ19(Fxy0,y,minf,inf), F0:on3romberg(Fx0),",
"cshow(F0) @",
" )"),
F0ans : 0.99987821,
chk1show(cmds,F0ans),
cmds : sconcat("( ",
"fdens:f/F0, /* 打ち切り領域 D0 上の確率密度関数 */ @",
"c0show(f,F0,fdens), @",
"D:on3ineq([[x+y,2,inf,co],[x,-4,1,cc],[y,-4,4,cc]],'resultonly,'noplot,'noview), @",
"c0show(D),Fxy:expand(fdens*D), Fx:on3integ19(Fxy,y,minf,inf), P : on3romberg(Fx)",
" )"),
Pans : 0.027532472,
chk1show(cmds,Pans),
if plotmode then (
g0:gr3d(title="fdens",line_width=1,xu_grid=60,yv_grid=60,
enhanced3d=false, zrange=[0,0.25],
explicit(fdens,x,-4,4,y,-4,4)),
g:gr3d(title="fdens on D", line_width=1,xu_grid=60,yv_grid=60,
enhanced3d=false, zrange=[0,0.25],
explicit(Fxy,x,-4,4,y,-4,4)),
mk_draw([g0, g], dlist, swview)
),
return(P)
)$ /* end of q3() */
/*############################################################################*/
/*### q4 : 2変量正規分布の領域確率2 ############################################*/
/*############################################################################*/
q4([args]) := block([progn:"<q4>",debug, plotmode:true, viewmode:true, swview,
dlist, keyL, key, cmds, Pans,
D,x,y,f,Fxy,Fx,P,g2,g],
debug:ifargd(),
if member('noview,args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of q4('help)--
機能: 2変量正規分布の領域[[x^3+x*y+y^2,1,9,co],[y,-4,4,co]]の確率を求め図示する
文法: q4({'help|'ex|'go},...)
例示: q4('go, 'file_name=\"q4\", 'columns=2, 'dimensions=[1000,500])
--end of q4('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of q4('ex)--"),
print(" --> q4('go))"),
/* q4_ex(), */
print("--end of q4('ex)--"),
return("--end of q4('ex)--"),
block_main, /* main ブロック ====================================*/
c1show(args),
/* args で指定できる draw オプション dlist */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","q4"),
columns=2, dimensions=[1000,500]],
keyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,keyL),
c1show(dlist),
if member('noplot,args) then plotmode:false,
if member('noview,args) then viewmode:false,
cmds : sconcat("( ",
"/* 定義域 D 上の関数 f=f(x,Y) の積分 */ @",
"D:on3ineq([[x^3+x*y+y^2,1,9,co],[y,-4,4,co]],'resultonly,'noplot,'noview), @",
"print(\"D = \",D), @",
"f0:exp(-(x^2+y^2)/2)/(2*%pi), Fxy:expand(f0 * D), @",
"print(\"Fxy=\",Fxy), @",
"Fx:on3integ19(Fxy,y,minf,inf), @",
"print(\"Fx=\",Fx), @",
"P:on3romberg(expand(Fx)), @",
"print(\"P=\",P) ",
" )"),
Pans : 0.36309648,
chk1show(cmds,Pans),
if plotmode then (
g2:on3gr2(D,'argsL=['xrange=[-4,4],'yrange=[-4.5,4.5]],'noview), /* caution */
if stringp(g2) then g2 : eval_string(g2), /* 注意 */
g:gr3d(line_width=1,xu_grid=60,yv_grid=60,enhanced3d=false,
explicit(Fxy,x,-4,4,y,-4,4)),
mk_draw([g2, g], dlist, swview)
),
return(P)
)$ /* end of q4() */
/* ex1: on3ineq([(x-y)/((x-1)*(y-2)), 1/(x-1), 1/(y-2),co])
ex2: C2 C2:funmake(on3ineq,[[x^2+y^3+2*x*y,1,9,co]]),
ex3: H1a H1a:funmake(on3ineq,[[x^2-y^2-(x^2+y^2)^2,-1,0,oc]]),
ex4: H2:funmake(on3ineq,
[[(93392896/15625)*y^6
+((94359552/625)*x^2+(91521024/625)*x +(-249088)/125)*y^4
+((1032192/25)*x^4-36864*x^3+((-7732224)/25)*x^2
+(-207360)*x+770048/25)*y^2
+65536*x^6+49152*x^5+(-135168)*x^4
+(-72704)*x^3+101376*x^2+27648*x-27648, 0,0,cc]]),
ex5: S1:funmake(on3ineq,[[(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co]]),
ex6: A1:funmake(on3ineq,
[[[y,(x-1)*(x-5)+5,(-(x-1))*(x-5)+5,co],[y,(-(x-2))+3,(x-2)+3,co]]]),
ex7: q3(file_name="tmp-q3",'noview)$
ex8: q4(file_name="tmp-q4",'noview)$
if member(excase,['H1,'H2,'H1a])
then (dxlr:[xl,xr,nx]:[-2,2,50], dylr:[yl,yr,ny]:[-2,2,50])
else if member(excase,['A1]) then
(dxlr:[xl,xr,nx]:[0, 6, 50], dylr:[yl,yr,ny]:[-2, 10, 50])
else if member(excase,['S1]) then
(dxlr:[xl,xr,nx]:[-4, 4, 50], dylr:[yl,yr,ny]:[0, 5, 50])
else if member(excase,['S2]) then
(dxlr:[xl,xr,nx]:[-2, 2, 50], dylr:[yl,yr,ny]:[0, 3, 50])
else if member(excase,['c3oo,'c3oc,'c3co,'c3cc]) then
(dxlr:[xl,xr,nx]:[-3, 3, 50], dylr:[yl,yr,ny]:[-3, 3, 50])
else (dxlr:[xl,xr,nx]:[-5, 5, 50], dylr:[yl,yr,ny]:[-5, 5, 50]),
*/
/*############################################################################*/
/*### extry : yrange の指定方法の試み ##################################*/
/*############################################################################*/
extry([args]) := block([progn:"<extry>",debug],
debug: ifargd(),
/* yrange の指定方法の試み */
gr2L0 : [title="gr2v plot",
grid=true, line_width=1.8,
color=colorL[1], key=keyL[1], line_type=line_typeL[1], yrange='auto
/* yrange=[yl,yr], key_pos=top_right, */
/* explicit(sin(x), x,-%pi,%pi), */
],
c1show(gr2L0),
gr2L : copylist(gr2L0),
/* gr2L の更新･追加 */
tlist : ['yrange='auto],
gkeyL : ['title, 'grid, 'line_width, 'color, 'key, 'line_type,
'xrange, 'yrange, 'zrange, 'key_pos],
gr2L : mergeL(gr2L,tlist,gkeyL), /* call mergeL */
/* yrange='auto の場合 */
c1show(progn,"start auto yrange"),
c1show(funcs),c1show(gr2L),c1show(find_key(gr2L,'yrange)),
if rhs(find_key(gr2L,'yrange)) = 'auto then (
yexp : exp2l(funcs[1],'explicit)[1],
cshow(yexp),
/* [func,var,vl,vr] : exp,
autoyrange : mk_range(func,ev(var),vl,vr),
*/
autoyrange : mk_range(yexp), /* yrange を自動作成 */
cshow(autoyrange),
gr2L[find_key_no(gr2L,'yrange)] : 'yrange = autoyrange,
cshow(gr2L)
),
c1show(progn, gr2L),
return("--end of extry--")
)$ /* end of extry() */
/*############################################################################*/
/*### on3ineq_jex : JJAS の例 ##########################################*/
/*############################################################################*/
on3ineq_jex([args]) := block([progn:"<on3ineq_jex>",debug,Lex0,ex7,ex8,swview],
debug: ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3ineq_jex('help)--
機能: JJAS 2011 の例題を検証する
文法: on3ineq_jex({'help|'ex|'go},...)
例示: on3ineq_jex('go)$ 全ての例題ex0,ex1,...,ex8 を実行
on3ineq_jex('go, [ex0,ex3])$ 例題ex0,ex3のみ実行
--end of on3ineq_jex('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3ineq_jex('ex)--"),
/* on3ineq_jex_ex(), */
on3ineq_jex('go, [ex0,ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8],swview),
print("--end of on3ineq_jex('ex)--"),
return("--end of on3ineq_jex('ex)--"),
block_main, /* main ブロック ====================================*/
Lex0 : ['ex0,'ex1,'ex2,'ex3,'ex4,'ex5,'ex6,'ex7,'ex8],
if length(args) >= 2 and listp(args[2]) then Lex0 : args[2],
print("実行例リスト: Lex = ",Lex0),
/* system("mkdir /tmp/fig > /dev/null 2>&1 "), */
if false then on3ineq(), /* on3ineq('help), */
if false then on3ineq('ex),
if member('ex0,Lex0) then
on3ineq([x^2+y^2,1,9,co],
'title="ex0:c2co",'xrange=[-3.5, 3.5],'yrange=[-3.5, 3.5],
'file_name=sconcat(figs_dir,"/","jjas-ex0"),swview,'resultonly,'nooutsum),
if member('ex1,Lex0) then
on3ineq([(x-y)/((x-1)*(y-2)), 1/(x-1), 1/(y-2),co],
'title="ex1", 'xrange=[-2, 6],'yrange=[0, 4],
'file_name=sconcat(figs_dir,"/","jjas-ex1"),swview,'resultonly,'nooutsum),
if member('ex2,Lex0) then
on3ineq([[x^2+y^3+2*x*y,1,9,co]],
'title="ex2:C2", 'xrange=[-5, 5],'yrange=[-5, 5],
'file_name=sconcat(figs_dir,"/","jjas-ex2"),swview,'resultonly,'nooutsum),
if member('ex3,Lex0) then
on3ineq([[x^2-y^2-(x^2+y^2)^2,-1,0,oc]],
'title="ex3:H1a", 'xrange=[-1.5, 1.5],'yrange=[-1.5, 1.5],
'file_name=sconcat(figs_dir,"/","jjas-ex3"),swview,'resultonly,'nooutsum),
if member('ex4,Lex0) then
on3ineq([[(93392896/15625)*y^6
+((94359552/625)*x^2+(91521024/625)*x +(-249088)/125)*y^4
+((1032192/25)*x^4-36864*x^3+((-7732224)/25)*x^2
+(-207360)*x+770048/25)*y^2
+65536*x^6+49152*x^5+(-135168)*x^4
+(-72704)*x^3+101376*x^2+27648*x-27648, 0,0,cc]],
'title="ex4:H2",'xrange=[-1.5, 1.5],'yrange=[-1.5, 1.5],
'file_name=sconcat(figs_dir,"/","jjas-ex4"),swview,'resultonly,'nooutsum),
if member('ex5,Lex0) then
on3ineq([[(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co]],
'title="ex5:S1",'xrange=[-4, 4],'yrange=[0, 5],
'file_name=sconcat(figs_dir,"/","jjas-ex5"),swview,'resultonly,'nooutsum),
if member('ex6,Lex0) then
on3ineq([[y,(x-1)*(x-5)+5,(-(x-1))*(x-5)+5,co],[y,(-(x-2))+3,(x-2)+3,co]],
'title="ex6:A1",'xrange=[0, 6],'yrange=[-2, 10],
'file_name=sconcat(figs_dir,"/","jjas-ex6"),swview,'resultonly,'nooutsum),
if member('ex7,Lex0) then
q3('go,'file_name=sconcat(figs_dir,"/","jjas-ex7"),swview,'resultonly,'nooutsum),
if member('ex8,Lex0) then
q4('go,'file_name=sconcat(figs_dir,"/","jjas-ex8"),swview,'resultonly,'nooutsum),
return("--end of on3ineq_jex--")
)$ /* end of on3ineq_jex */
/*############################################################################*/
/*### chk1g ####################################################################*/
/*############################################################################*/
chk1g([args]) := block([progn:"<chk1g>",debug, plotmode:true, viewmode:true,
x,y,z,x0,ex,out,ex1,out1],
debug:ifargd(),
if member('noplot,args) then plotmode:false,
if member('noview,args) then viewmode:false,
if length(args)>0 and numberp(args[1]) then x0:args[1] else x0:1/2, cshow(x0),
/* epsk:[1.e-5,1.e-2], */ epsk:[1.e-5,1.e-2],
ex: x^4+y^3+y*z+z^2, /* x0:1/2, x0:1 */
out:on3ineq([[ex,1,9,co]]),
out:ev(out,x=x0), out:l2f(map(expand,f2l(out))), cshow(out),
ex1:ev(ex,x=x0),
out1:on3ineq([[ex1,1,9,co]]), cshow(out1),
cshow(out-out1),
if plotmode=true then (
gout : on3gr2(out, xrange=[-3,3],yrange=[-4,4]),
gout1 : on3gr2(out1,xrange=[-3,3],yrange=[-4,4]),
c1show(gout), c1show(gout1),
grv(gout, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk1g-1"),'noview),
grv(gout1, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk1g-2"),'noview),
if viewmode then grv(gout,gout1,dimensions=[1800,2700])
), /* end of if-plotmode */
return("---end of chk1g ---")
)$ /* end of chk1g() */
/*############################################################################*/
/*### chk2g ####################################################################*/
/*############################################################################*/
chk2g([args]) := block([progn:"<chk2g>",debug, plotmode:true, viewmode:true,
x,y,z,x0,ex,out,ex1,out1],
debug:ifargd(),
if member('noplot,args) then plotmode:false,
if member('noview,args) then viewmode:false,
epsk:[1.e-8,1.e-5],
ex: z^4+x^3+x*y+x^2,x0:-1,
out:on3ineq([[ex,1,9,co]]),
out:ev(out,x=x0), cshow(out),
ex1:ev(ex,x=x0),
out1:on3ineq([[ex1,1,9,co]]), cshow(out1),
cshow(out-out1),
if plotmode then (
gout : on3gr2(out, xrange=[-15,55],yrange=[-5,5]),
gout1 : on3gr2(out1,xrange=[-15,55],yrange=[-5,5]),
c1show(gout),c1show(gout1),
grv(gout, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk2g-1"),'noview),
grv(gout1, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk2g-2"),'noview),
if viewmode then grv(gout,gout1,dimensions=[1800,2700])
), /* end of if-plotmode */
return("---end of chk2g ---")
)$ /* end of chk2g() */
/*############################################################################*/
/*### chk3g ####################################################################*/
/*############################################################################*/
chk3g([args]) := block([progn:"<chk3g>",debug, plotmode:true, viewmode:true,
x,y,z,x0,ex,out,ex1,out1],
debug:ifargd(),
if member('noplot,args) then plotmode:false,
if member('noview,args) then viewmode:false,
epsk:[1.e-8,1.e-5],
ex: y^4+z^3+z*x+x^2,x0:1,
out:on3ineq([[ex,1,9,co]]),
out:ev(out,x=x0), cshow(out),
ex1:ev(ex,x=x0),
out1:on3ineq([[ex1,1,9,co]]), cshow(out1),
cshow(out-out1),
if plotmode then (
gout : on3gr2(out, xrange=[-5,5],yrange=[-5,5]),
gout1 : on3gr2(out1,xrange=[-5,5],yrange=[-5,5]),
c1show(gout), c1show(gout1),
grv(gout, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk3g-1"),'noview),
grv(gout1, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk3g-2"),'noview),
if viewmode then grv(gout,gout1,dimensions=[1800,2700])
), /* end of if-plotmode */
return("---end of chk3g ---")
)$ /* end of chk3g() */
/*############################################################################*/
/*### globalvar: Maxima Global Variable Display ##############################*/
/*############################################################################*/
globalvar([args]) := block([progn:"<globalvar>",debug],
debug:ifargd(),
c0show("=== Maxima Global Variable Display ==="),
c0show(domain,"{real*,complex}:多項式の係数環を指定（参照 m1pbranch)"),
c0show(fpprec,"{16*,正整数}:bigfloat型の桁数指定"),
c0show(fpprintprec,"{0*,正整数}:bigfloat型の表示桁数指定"),
c0show(float2bf,"{true*,false}:float->bigfloat変換時に計算精度落ち警告表示の有無"),
c0show(m1pbranch,
"{true,false*}:(-1)^(1/4) -> (1+%i)/sqrt(2)等の自動変換の有無(domain:complexで使用)"),
c0show(radexpand,"{true*,false}:sqrt(a^2*b) -> abs(a)*sqrt(b) の自動変換の有無"),
c0show(keepfloat,"{true,false*}:浮動小数の有理数表現への近似の有無(参照 rat)"),
c0show(ratepsilon,"{2.0E-8*}:浮動小数の有理数近似の誤差"),
c0show(ratalgdenom,"{true*,false}:代数的整数(sqrt(2)等)を分母とする項の有理化を制御"),
c0show(ratprint,"{true*,false}:CRE表現への変換時の警告表示の有無"),
c0show(ratdenomdivide,"{true*,false}:(a1+a2)/b -> a1/b + a2/b の分離の有無"),
c0show(ratexpand,"{true,false*}: CRE表現の展開の制御"),
c0show(ratfac,"{true,false*}:CRE表現の因子分解の制御"),
c0show(ratsimpexpons,"{true,false*}:式中の冪に対しratsimpの自動実行制御"),
c0show(rootsconmode,"{true*,false,all}:冪の合併a^(1/2)*y^(1/4)->(a*b^(1/2)^(1/2)"),
c0show(algexact,"{true,false*}:厳密解のみを求めるか近似解を許すかを指定"),
c0show(realonly,"{true,false*}:実数解(%iを含まない解)に限定するか否かを指定"),
c0show(algepsilon,"{10^8*}:algsysの精度指定 (低<->高精度)"),
c0show("=== on3ineqlib 関連 ===================================================="),
c0show(on3floatnump,"{true,false}:algsysの結果:近似解(true),厳密解(false)を返す"),
c0show(restlr,"{[minf,inf]*,[xl,xr]}:第1変数解の範囲を制限したいときに指定する"),
c0show(outlineonly,"{true,false*}:開閉処理をしないときtrueとする"),
c0show(flimitmode,"{true*,false}:左右極限値評価を浮動小数モードで行うときtrueとする"),
c0show(resultonly,"{true,false*}:最終結果のみを表示する場合にtrueとする"),
c0show(chkerrsum,":結果を事前に設定された解と照合し,不一致となった回数を計測する"),
return("==========================")
)$
/*####### begin replace 2019.07.26 ####################################*/
/*############################################################################*/
/*** リストからキー名を含む最初の要素を取り出す ***/
/*############################################################################*/
find_key([args]) := block([progn:"<find_key>",list,key, a,w,out],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of find_key('help)--
機能: キー付きリストからキー名を含む最初の要素を取り出す. キー名がない場合はFALSEを返す.
文法: find_key(list,key,...)
例示: find_key([key1=a,key2=b,key3=c],key2) -> key2=b
--end of find_key('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of find_key('ex)--"),
/* find_key_ex(), */
block([progn:"<find_key_ex>",debug,dlist],
debug:ifargd(),
print("--begin of find_key_ex"),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","find_key-1"),
columns=2, dimensions=[1000,400]],
c0show(dlist),
c0show(find_key(dlist,'columns)),
c0show(find_key(dlist,'file_name)),
c0show(find_key(dlist,'not_key_name)),
return("--end of find_key_ex--")
), /* end of block */
print("--end of find_key('ex)--"),
return("--end of find_key('ex)--"),
block_main, /* main ブロック ====================================*/
list : args[1], key : args[2],
if listp(list) = false then (
cshow(progn,list,"-> not list"), return(false)),
chk(a) := if lhs(a) = key then true,
w : sublist(list,chk), /* call sublist */
c1show(progn," : w = ",w),
if length(w) > 0 then out : w[1] else out : false,
return(out)
)$ /* end of find_key() */
/*+++ find_key_ex +++++++++++++++++++++++++++++++++++++++++*/
find_key_ex([args]) := block([progn:"<find_key_ex>",debug,dlist],
debug:ifargd(),
print("--begin of find_key_ex"),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","find_key-2"),
columns=2, dimensions=[1000,400]],
cshow(dlist),
cshow(find_key(dlist,'columns)),
cshow(find_key(dlist,'file_name)),
cshow(find_key(dlist,'not_key_name)),
return("--end of find_key_ex--")
)$ /* end of find_key_ex() */
/*############################################################################*/
/*** リストからキー名を含む要素の位置を取り出す ***/
/*############################################################################*/
find_key_no([args]) := block([progn:"<find_key_no>",debug,list,key, klist,ii],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of find_key_no('help)--
機能: キー付きリストからキー名を含む要素の位置を取り出す
文法: find_key_no(list,key,...)
例示: find_key_no([key1=a,key2=b,key3=c],key2); -> 2
find_key_no([key1=a,key2=b,key3=c],key4); -> 0
--end of find_key_no('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of find_key_no('ex)--"),
/* find_key_no_ex(), */
block([progn:"<find_key_no_ex>",debug,dlist],
debug:ifargd(),
print("--begin of find_key_no_ex"),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","find_key_no-1"),
columns=2, dimensions=[1000,400]],
c0show(dlist),
c0show(find_key_no(dlist,'columns)),
c0show(find_key_no(dlist,'file_name)),
return("--end of find_key_no_ex")
), /* end of block */
print("--end of find_key_no('ex)--"),
return("--end of find_key_no('ex)--"),
block_main, /* main ブロック ====================================*/
list : args[1], key : args[2],
c1show(list,key),
if listp(list) = false then (
c1show(progn,list,"-> not list"), return(false)),
klist : map(lhs,list), ii : 0,
c1show(klist),
for i thru length(klist) do if klist[i] = key then ii:i,
return(ii)
)$ /* end of find_key_no() */
/*+++ find_key_no_ex +++++++++++++++++++++++++++++++++++++++++*/
find_key_no_ex([args]) := block([progn:"<find_key_no_ex>",debug,dlist],
debug:ifargd(),
print("--begin of find_key_no_ex"),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","find_key_no-2"),
columns=2, dimensions=[1000,400]],
cshow(dlist),
cshow(find_key_no(dlist,'columns)),
cshow(find_key_no(dlist,'file_name)),
return("--end of find_key_no_ex")
)$ /* end of find_key_no() */
/*############################################################################*/
/*### args_flat : 関数引数に'argsL=[..]の要素をフラットにする ###*/
/*############################################################################*/
args_flat([args]) := block([progn:"<args_flat>",debug,
keyno,argsL, args1, argsL0,on3fin,Lin,in,out],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of args_flat('help)--
機能: 関数引数に'argsL=[..]が存在するとき,その要素をフラットにする
文法: args_flat(x,y,...)
例示: args_flat([args])
メモ: args=[a1,[a2,[a31,a32]], 'argsL=['xrange=[1,2], 'yrange=[3,4], ...]]
-> flat_args = [a1,[a2,[a31,a32]], 'xrange=[1,2], 'yrange=[3,4], ...]
注: flatten(args) ではargsの第2成分のリスト構造が壊れる
--end of args_flat('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of args_flat('ex)--"),
/* args_flat_ex(), */
block([on3fin,Lin,argsL0,in,out],
on3fin : x^2*on3(x,1,3,co) + x * on3(x,2,4,co),
Lin : f2l_one(on3fin),
argsL0 : ['xrange=[1,2],'yrange=[3,4]],
print("--begin of args_flat('ex)--"),
print("例1.argsL=が存在するとき"),
in : 'args_flat(on3fin,Lin,'viewmode=true,'argsL=argsL0),
out : ev(in, nouns, infeval),
print("入力",in), print("結果",out),
print("例2.argsL=が存在しないとき"),
in : 'args_flat(on3fin,Lin,'viewmode=true,'xrange=[1,2],'yrange=[3,4]),
out : ev(in, nouns),
print("入力",in), print("結果",out),
return(out)
), /* end of block */
print("--end of args_flat('ex)--"),
return("--end of args_flat('ex)--"),
block_main, /* main ブロック ====================================*/
/* 関数本体 */
if listp(args[1])= true then args1 : copylist(args[1]),
c1show(progn,args1),
c1show(progn,length(args1),length(args1)),
c1show(progn,args1),
keyno : find_key_no(args1,'argsL),
c1show(progn,keyno),
if keyno > 0 then (
argsL : rhs(args1[keyno]),
c1show(progn,"find;",argsL),
args1[keyno] : 'del, args1 : delete('del, args1),
c1show(args1),
args1 : append(args1,argsL)
),
c1show(progn,"after:", args1),
return(args1)
)$ /* end of args_flat() */
/*############################################################################*/
/*** mk_fullname() : draw 関数の引数 file_name, terminal から fullname を生成する */
/*############################################################################*/
mk_fullname([args]) := block([progn:"<mk_fullname>",debug,dlist, sname,ext,fullname],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of mk_fullname('help)--
機能: draw 関数の引数 file_name, terminal から fullname を生成する
文法: mk_fullname(dlist)
例示: mk_fullname([file_name=\"tmp\",'terminal='png])
-> \"tmp.png\"
--end of mk_fullname('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of mk_fullname('ex)--"),
/* mk_fullname_ex(), */
block([],
c0show(mk_fullname([file_name=sconcat(figs_dir,"/","mk_fullname"),'terminal='png])),
return()
), /* end of block */
print("--end of mk_fullname('ex)--"),
return("--end of mk_fullname('ex)--"),
block_main, /* main ブロック ====================================*/
dlist : args[1],
sname : find_key(dlist,'file_name),
ext : find_key(dlist,'terminal),
fullname : sconcat(rhs(sname),".",rhs(ext)),
return(fullname)
)$ /* end of mk_fullname() */
/*############################################################################*/
/*** fna() : fullname から [dir,sname,ext] を生成する ***/
/*############################################################################*/
fna([args]) := block([progn:"<fna>",debug,fullname, dir,sname,ext],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of fna('help)--
機能: 文字列 fullname から 文字列リスト [dir,sname,ext] を生成する
文法: fna(fullname)
例示: fna(\"tmp.png\") -> [\"/tmp/\", \"tmp\", \"png\"]
--end of fna('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of fna('ex)--"),
/* fna_ex(), */
block([],
c0show(fna("/tmp/tmp.png")),
return()
), /* end of block */
print("--end of fna('ex)--"),
return("--end of fna('ex)--"),
block_main, /* main ブロック ====================================*/
fullname : args[1],
dir : pathname_directory(fullname), /* /tmp/lang/ */
sname : pathname_name(fullname), /* tmp1 */
ext : pathname_type(fullname), /* png */
return([dir,sname,ext])
)$ /* end of fna() */
/*############################################################################*/
/*** list2str リストの全ての要素を文字列化する *****************************/
/*############################################################################*/
list2str([args]) := block([progn:"<list2str>",debug,list, str],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of list2str('help)--
機能: リストの全ての要素を文字列化する
文法: list2str(list)
例示: list2str(['color=blue, (x+y)^2, title=\"test\"])
-> \"color = blue, (y+x)^2, title = \"test\"\"
--end of list2str('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of list2str('ex)--"),
/* list2str_ex(), */
block([exp1,L,out],
exp1 :(x+y)^2,
L : ['color=blue, exp1, file_name=sconcat(figs_dir,"/","list2str"), terminal='png],
c0show(exp1),
c0show(L),
c0show(map(stringp,L)),
c0show(list2str(L)),
c0show(stringp(list2str(L))),
return('noormal_return)
), /* end of block */
print("--end of list2str('ex)--"),
return("--end of list2str('ex)--"),
block_main, /* main ブロック ====================================*/
list : args[1],
if listp(list) = false then return("-- not list"),
if length(list) = 1 then (str : string(list[1]), return(str)),
str : string(list[1]),
for i:2 thru length(list) do (
str : sconcat(str,", ",list[i])
),
return(str)
)$ /* end of list2str() */
/*+++ list2str リストの全ての要素を文字列化する ++++++++++++++++++++++++*/
list2str_ex([args]) := block([progn:"<list2str_ex>",exp1,L,out],
cshow("-- begin of ",progn," --"),
exp1 :(x+y)^2,
L : ['color=blue, exp1, file_name=sconcat(figs_dir,"/","lit2str"), terminal='png],
cshow(exp1),
cshow(L),
out : list2str(L),
cshow(out),
return("-- end of <list2str> --")
)$ /* end of list2str_ex() */
/*############################################################################*/
/*### ush : system("unix-shell-command") #############################*/
/*############################################################################*/
ush([args]) := block([progn:"<ush>",debug,swview,script, cmd],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of ush('help)--
機能: xとyの和を求める
文法: ush(script,...)
例示: ush(\"eog tmp.png\")
--end of ush('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of ush('ex)--"),
/* ush_ex(), */
block([script],
script : "eog tmp.png",
c0show(script,",", stringp(script)),
if member('noview,args) then c0show("実行を省略する") else c0show(ush(script)),
return('normal_return)
), /* end of block */
print("--end of ush('ex)--"),
return("--end of ush('ex)--"),
block_main, /* main ブロック ====================================*/
script : args[1],
c1show(progn,script,stringp(script)),
if stringp(script) = false then
return("** Error : <script> is not string **"),
cmd : funmake(system, [script]),
return(ev(cmd))
)$ /* end of ush() */
/*############################################################################*/
/*** mk_draw 2019.07.07 ************************************/
/*############################################################################*/
mk_draw([args]) := block([progn:"<mk_draw>",debug,glist,dlist,cmds,g1,g2,
now,tlist,dlist0,dkeyL, alist,drawfunc,fullname,cmd,swview],
debug : ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of mk_draw('help)--
機能: 複数のグラフィックオブジェクトをdraw()に引き継ぎ作画する
文法: mk_draw(glist,dlist,...)
例示: mk_draw([g1,g2],dlist)
mk_draw()$ or mk_draw('help)$ /* このヘルプを標示する */
mk_draw('ex)$ /* 例を実行する */
g1 : gr2d(title=\"sin(x) and cos(x)\",
grid=true, yrange=[-1.25, 1.25], line_width=1.8,
color=blue, key=\"sin(x)\", line_type=solid,
explicit(sin(x), x,-%pi,%pi),
color=red, key=\"cos(x)\", line_type=dots,
explicit(cos(x), x, -%pi,%pi)
),
f(x,y) := (x+y+5)*on3(sqrt(x^2+y^2),2,3,co),
g2 : gr3d(enhanced3d=false, surface_hide=true, nticks=5, xu_grid=40,
title=\"example of f(x,y)\",
xlabel=\"x\", ylabel=\"y\", zlabel=\"z = f(x,y)\",
explicit(f(x,y), x,-3.5,3.5, y,-3.5,3.5)
),
glist : [g1,g2], /* gr2d, gr3d で生成されたグラフィックオブジェクトのリスト */
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, 'file_name=sconcat(figs_dir,'/','mk_draw-ex'),
columns=2, dimensions=[1000,400]],
if member('noview, args) then mk_draw(glist,dlist,'noview)
else mk_draw(glist,dlist,'view), /* mk_draw 関数の呼び出し */
mk_draw([g1,g2],
['file_name=sconcat(figs_dir,'/','gr2v'), 'columns=2, 'dimensions=[1000, 500]],
'view)$
--end of mk_draw('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of mk_draw('ex)--"),
/* mk_draw_ex(), */
block([cmds,figfile],
figfile : sconcat(figs_dir,"/","mk_draw"),
cmds : sconcat("( ",
" /* 例1. */ @",
sconcat("g1 : gr2v([explicit(sin(x),x,-%pi,%pi), ",
"explicit(cos(x),x,-%pi,%pi)], @",
" 'yrange=[-1.2,1.2], 'title=\"ex1-1 of mk-draw\", 'noview), @"),
sconcat("g2 : gr2v([implicit(x^2+y^2=1, x,-1,1, y,-1,1)], ",
" 'xrange=[-1.1, 1.1], 'yrange=[-1.1, 1.1], ",
" 'title=\"ex1-2 of mk-draw \", 'noview), @"),
sconcat("mk_draw([g1,g2], @",
"['file_name=figfile,'columns=2,'dimensions=[1000, 500]],",
swview, ") @"),
" )"),
chk1show(cmds,""),
return('normal_end)
), /* end of block */
print("--end of mk_draw('ex)--"),
return("--end of mk_draw('ex)--"),
block_main, /* main ブロック ====================================*/
glist : args[1], dlist : args[2], /* 実質引数 */
/* dlist : draw() 関数の引数のリスト : 標準値とその変更*/
tlist : copylist(dlist), /* tlist=dlist をtランザクションとしてdlist0を更新する */
dlist0 : [terminal='png, file_name=sconcat(figs_dir,"/","mk_draw"),
columns=1, dimensions=[600,500]], /* dlistの初期値リスト */
dkeyL : ['terminal, 'file_name, 'columns, 'dimensions], /* 必須項目 */
dlist0 : mergeL(dlist0,tlist,dkeyL), /* call mergeL */
c1show("mk_draw : 更新結果",dlist0),
alist : append(glist,dlist0),
d1show(progn,alist),
drawfunc : funmake(draw, alist), /* draw() 関数の生成 */
( now : display2d, display2d:false,
d1show(progn,drawfunc),
display2d : now),
ev(drawfunc), /* draw 関数の評価実行 dlist[file_name=*.png ファイルに出力 */
/* fna(fullname), */
fullname : mk_fullname(dlist0), /* dlist からグラフ出力ファイル名を生成する */
cmd : funmake(system, [sconcat("eog ",fullname)]),
if member('view, args) then ( /* args に'viewが指定されたとき */
ev(cmd), /* ビューコマンド cmd の実行 */
d1show(progn, cmd),
c0show(progn," : View --->",cmd)
), /* end of 'view */
c1show(progn," : View --->",cmd),
return("-- end of mk_draw --")
)$ /* end of mk_draw() */
/*** mk_draw_ex ***************************************************/
mk_draw_ex([args]) := block([progn:"<mk_draw_ex>",g1,g2,glist,dlist,swview],
if member('noview, args) then swview:'noview else swview:'view,
print("-- ",progn," is started --"),
g1 : gr2d(title="sin(x) and cos(x)",
grid=true, yrange=[-1.25, 1.25], line_width=1.8,
color=blue, key="sin(x)", line_type=solid,
explicit(sin(x), x,-%pi,%pi),
color=red, key="cos(x)", line_type=dots,
explicit(cos(x), x, -%pi,%pi)
),
f(x,y) := (x+y+5)*on3(sqrt(x^2+y^2),2,3,co),
g2 : gr3d(enhanced3d=false, surface_hide=true, nticks=5, xu_grid=40,
title="example of f(x,y)",
xlabel="x", ylabel="y", zlabel="z = f(x,y)",
explicit(f(x,y), x,-3.5,3.5, y,-3.5,3.5)
),
glist : [g1,g2], /* gr2d, gr3d で生成されたグラフィックオブジェクトのリスト */
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","mk_draw_ex"),
columns=2, dimensions=[1000,400]],
dlist : mergeL(dlist,args,['terminal,'file_name,'columns,'dimensions]),
mk_draw(glist,dlist,swview), /* mk_draw 関数の呼び出し */
return("-- end of mk_draw_ex --")
)$ /* end of mk_draw_ex */
/*############################################################################*/
/* mergeL : keylist の項目に従い, トランザクションリストの内容をマスターリストにマージする */
/*############################################################################*/
mergeL([args]) := block([progn:"<mergeL>",debug, mlist,tlist,keylist,outL,
key,t_no,o_no,outlist],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of mergeL('help)--
機能: keylist の項目に従い, トランザクションリストの内容をマスターリストにマージする
文法: mergeL(mlist,tlist,keylist)
例示:
keylistで定義されたキー項目に関して,mlist(マスター)の内容を
tlist(トランザクション)の内容でマージする.
具体的には,キー項目がmlist,tlistに存在する場合はtlistの内容でmlistの内容で更新し,
キー項目がtlistに存在し,mlistに存在しない場合はtlistの内容をmlistに追加する.
なお,キー項目にない内容は対象外とし,無処理とする.
-- example --
mlist : [terminal='png, file_name=\"tmp\", columns=1, dimensions=[600,500] ],
tlist : ['file_name=\"ex-mergeL\", 'columns=2, 'dimensions=[1000,500] ],
keylist : ['terminal, 'file_name, 'columns, 'dimensions],
outL : mergeL(mlit,tlist,keylist),
--end of mergeL('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of mergeL('ex)--"),
/* mergeL_ex(), */
block([mlist,tlist,keylist,outL],
mlist : [terminal='png, file_name=sconcat(figs_dir,"/","mergeL"),
columns=1, dimensions=[600,500]],
tlist : ['file_name=sconcat(figs_dir,"/","ex-mergeL"),
'columns=2, 'dimensions=[1000,500] ],
keylist : ['terminal, 'file_name, 'columns, 'dimensions],
outL : mergeL(mlist,tlist,keylist),
c0show(progn,"--実行例--"),c0show(mlist),c0show(tlist),c0show(keylist),
c0show("outL : mergeL(mlist,tlist,keylist)"),
c0show("結果:",outL),
return(outL)
), /* end of block */
print("--end of mergeL('ex)--"),
return("--end of mergeL('ex)--"),
block_main, /* main ブロック ====================================*/
c1show(progn,"--begin--"),
c1show(length(args),args),
if length(args) >= 3 then (
mlist : args[1], tlist : args[2], keylist : args[3]
),
if length(args) >= 3
and listp(mlist) and listp(tlist) and listp(keylist) then ( /* main part */
outlist : copylist(mlist),
c1show(outlist),
for key in keylist do (
t_no : find_key_no(tlist,key),
o_no : find_key_no(outlist,key),
c1show(key, o_no, t_no),
if o_no > 0 then c1show(outlist[o_no]),
if t_no > 0 then c1show(tlist[t_no]),
if t_no > 0 and o_no > 0 then ( outlist[o_no] : tlist[t_no] ), /* 変更 */
if t_no > 0 and o_no=0 then (
c1show(t_no,tlist[t_no]),
outlist : endcons(tlist[t_no], outlist) ) /* 追加 */
), /* end of for-key */
c1show(progn, outlist),
return(outlist)
) /* end of if-listp */
)$ /* end of mergeL() */
/*+++ mergeL_ex ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
mergeL_ex([args]) := block([progn:"<mergeL_ex>",debug,mlist,tlist,keylist],
mergeL('help),
mergeL(),
mergeL('ex),
mlist : ['terminal='png, 'file_name=sconcat(figs_dir,"/","mergeL_ex"),
'dimensions=[600,500]],
tlist : ['file_name=sconcat(figs_dir,"/","ex-mergeL"), 'columns=2,
'dimensions=[1000,500] ],
keylist : ['terminal, 'file_name, 'columns, 'dimensions],
outL : mergeL(mlist,tlist,keylist),
cshow("結果",outL),
return("--end of mergeL_ex--")
)$ /* end of mergeL_ex() */
/*############################################################################*/
/*** gr2v 2019.10.16 ***************************************************/
/*############################################################################*/
gr2v([args]) := block([progn:"<gr2v>",debug,
colorL,line_typeL,point_typeL,keyL, nopoints,
Ls,Lc,Le, keyLs,keyLc,keyLe, fp,L,Lnew,gxr,gyr,
n, iL, f,var,xl,xr,f2lout, gxrange,gyrange,
SL, SL0, Skey, SLsum, ic,is,ie,
gr2L,g1,g2,g3,F,dF,glist,dlist,tlist, dkey,dkeyL, swview],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_main, /* main ブロック ====================================*/
/* 作図オプションの初期設定 */
c1how("-- ",progn," is started --"),
colorL : [red, blue, dark_green, dark_cyan, magenta, gray60], /* 線カラー */
line_typeL : [solid, solid, solid, solid, dots, dots], /* 線種 */
point_typeL : [filled_circle, circle], /* ポイント記号 */
keyL : ["key1","key2","key3","key4","key5","key6"], /* 凡例キー */
/* Ls:冒頭,Lc:中間,Le:末尾での標準値を陽指定するときに用いる */
Ls : ['grid=true, 'line_width=1.8, 'point_size=1.2],
Le : ['title="Plot by gr2v", 'key_pos=top_right],
/* Ls:冒頭,Lc:中間,Le:末尾の部分で更新対象とするキー付き引数(末尾指定キーに注意) */
keyLs : ['grid, 'line_width, 'point_size],
keyLc : ['color, 'key, 'line_type, 'point_type],
keyLe : ['title, 'xrange, 'yrange, 'key_pos],
/* 引数リストの例 */
if false then (
fp :[[0,0]],
L : ['key="line",explicit(sin(x),x,-%pi,%pi),'color=red,'key="points",points(fp)],
args : [L,'title="ex of gr2v", 'gxyrange,'view]
),
if false then (
f : on3(x,1,3,co) + on3(x,2,4,co),
L : [explicit(f,x,0,5),explicit(sin(x),x,-%pi,2*%pi)],
args : [L,'title="ex of on3func",'xrange=[-0.5,6],'yrange=[-0.2,2.5], 'view]
),
if true then (L : args[1]),
c1show(progn,args),
/* 関数型引数(キー付き引数でない)の位置を検出する : iL : [0,2,5,7] */
n : length(L), iL : [0],
for i:1 thru n do if rhs(L[i])=0 then iL:endcons(i,iL),
if member(n,iL)=false then iL : endcons(n,iL),
c1show(progn,iL),
/** 作画要素リスト L の更新:ジャンプ点の追加処理と作画領域の作成 **/
if true then ( /* L内にpoints()が存在しないとき,不連続点リスト fp の追加処理 */
c1show(progn,"作画要素リスト L の初期内容"),c1show(L),
if (length(exp2l(L,'points))=0) and (length(exp2l(L,'explicit))>0) then
c1show(progn,"Lの更新処理開始"),
if length(exp2l(L,'points))=0 then nopoints:true else nopoints:false,
Lnew : [], gxrange : [inf,minf], gyrange : [inf,minf],
for i:1 thru length(L) do (
c1show(progn,i,L[i]),
Lnew : append(Lnew,[L[i]]),
c1show(f2l_one(L[i])),
f2lout : f2l_one(L[i]),
if (rhs(L[i]) = 0) and (f2lout[1]='explicit) then (
/** L内のexplicit(f,x,xl,xr)の関数fの全てが表示可能な作図領域調べる **/
c1show(progn,i,f2lout),
[f,var,xl,xr] : rest(f2lout,1),
c1show(progn,f,var,xl,xr),
/** ジャンプ点(不連続点), 作図領域の検出 **/
[fp, gxr, gyr] : jumppoints(f, 'gxyrange),
gxr : [xl-(xr-xl)*0.1, xr+(xr-xl)*0.15], gxr : float(gxr),
/** gxrange は explicit(f,x,xl,xr) から算出する **/
c1show(progn,i,fp,gxr,gyr),
gxrange[1] : min(gxrange[1], gxr[1]), gxrange[2] : max(gxrange[2],gxr[2]),
gyrange[1] : min(gyrange[1], gyr[1]), gyrange[2] : max(gyrange[2],gyr[2]),
c1show(progn,i,gxrange,gyrange),
/** 初期の L 内にpoints()がなく,かつ length(fp)>0 のとき points(fp) を追加する **/
if nopoints and (length(fp) > 0)
then Lnew : append(Lnew,['color=red,points(fp)])
), /* end of if */
c1show(progn,i,Lnew)
), /* end of for-i */
L : Lnew.
c1show(progn,"作画要素リスト L の更新結果"),c1show(L),
/** gxrange, gyrange は args内に 'gxyrange があるとき,'xrange, 'yrange 更新対象となる **/
c1show(progn,"作画領域"),c1show(progn,gxrange,gyrange),
L : Lnew,
/* 関数型引数(キー付き引数でない)の位置を検出する : iL : [0,2,5,7] */
n : length(L), iL : [0],
for i:1 thru n do if rhs(L[i])=0 then iL:endcons(i,iL),
if member(n,iL)=false then iL : endcons(n,iL),
c1show(progn,iL)
), /* end if true */
/* gr2v([args]) -> args[1] = L = [gr2dの引数], args[2]={xrange,yrange,title,'view},... */
/* 関数型引数の間のキー付き引数(グラフオプション)をkeyLs,keyLc,keyLe を用いて更新する */
SLsum : [],
for ic:1 thru length(iL)-1 do (
Lc : ['color=colorL[ic], 'key=keyL[ic], 'line_type=line_typeL[ic],
'point_type=filled_circle],
is : iL[ic]+1, ie : iL[ic+1],
c1show(ic,is,ie,n),
if n-ie>0 then SL:rest(L,-1*(n-ie)) else SL:L,
if is>1 then SL:rest(SL,is-1),
c1show("--pre :",SL),
if ic=1 then (SL0:append(Ls,Lc), Skey:append(keyLs,keyLc))
else if ic<=length(iL)-1 then (SL0:Lc, Skey:keyLc)
/* else if ic=length(iL)-1 then (SL0:Le, Skey:keyLe) */
else (SL0:[]),
if is<=ie then (SL : mergeL(SL0,SL,Skey), SL : endcons(L[ie],SL)),
c1show("--post :",SL),
SLsum : append(SLsum,SL)
),
c1show(progn,SLsum),
gr2L : SLsum,
c1show(progn,find_key(args,'title)),
c1show(progn,"--pre args-- ",gr2L),
gr2L : mergeL(gr2L,args,keyLe), /* args[2],..での指定をkeyLeを用いて再度更新する */
c1show(progn,"--post args--",gr2L),
/* gxyrange の適用 */
if member('gxyrange, args) then (
/* gxyrange の試み */
c1show(progn,"xrange yrange の更新適用(設定値 gxrange gyrange)."),
gr2L:mergeL(gr2L,['xrange=gxrange,'yrange=gyrange],['xrange,'yrange])
), /* end of gxyrange */
/* gr2L を引数リストとして gr2d() を実行する */
c1show(progn,"gr2Lの最終結果",gr2L),
g1 : funmake(gr2d, gr2L),
glist : [g1], /* gr2d, gr3d で生成されたグラフィックオブジェクトのリスト */
/* dlist : draw() 関数の引数のリスト : 標準値とargsからの変更*/
tlist : copylist(args),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","gr2v"),
columns=1, dimensions=[600,500]],
dkeyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,tlist,dkeyL), /* call mergeL */
c1show(progn, dlist),
mk_draw(glist, dlist,swview),
c1show("-- end of gr2v --"),
return(g1),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of gr2v('help)--
機能: 2次元(x,y)作図: 関数に不連続点が存在する場合の描画を意識した.
文法: gr2v([args]) 内容的には gr2v([作画要素],その他の設定,...)
その他の設定: 'title=\"...\", 'gxyrange 'xrange 'yrange, 'view
例示:
gr2v()$ or gr2v('help)$ /* このヘルプを標示する */
gr2v('ex)$ /* 例を実行する */
gr2v([explicit(on3(x,1,3,co)+on3(x,2,4,co), x,0,5)],'gxrange, 'view)$
gr2v([explicit(sin(x),x,-%pi,%pi)],'gxyrange,'title=\"ex of gr2v\")$
gr2v([explicit(sin(x),x,-%pi,%pi), explicit(cos(x),x,-%pi,%pi)],'gxyrange)$
gr2v([implicit(x^2+y^2=1, x,-1,1, y,-1,1)])$
gr2v([points(makelist([random(20),random(50)],k,1,10))])$
gr2v([explicit(sin(x),x,-%pi,%pi),
explicit(x,x,-%pi,%pi),
explicit(-x,x,-%pi,%pi)],
'yrange=[-1.2,1.2], 'columns=2)$ /* gr2d にオプションを追加する */
fp : makelist([xv,ev(f1,x=xv)],xv,[1,3]),
g1:gr2v([explicit(f1,x,0,4),'color=red, points(fp)],'gxyrange,'noview),
/* 複数個のgr2dオブジェクトg1,g2,g3,g4を同時に表示する例 */
(g1 : gr2v([explicit(sin(x),x,-%pi,%pi)], 'noview),
g2 : gr2v([explicit(sin(x),x,-%pi,%pi), explicit(cos(x),x,-%pi,%pi)], 'noview),
g3 : gr2v([implicit(x^2+y^2=1, x,-1,1, y,-1,1)], 'noview),
g4 : gr2v([points(makelist([random(20),random(50)],k,1,10))], 'noview) )$
mk_draw([g1,g2,g3,g4],
['file_name=\"gr2v\", 'columns=2, 'dimensions=[1000, 1000]],
'view)$
--end of gr2v('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of gr2v('ex)--"),
/* gr2v_ex(), */
block([cmds,f,F,df,g1,g2,g3,figfile],
figfile : sconcat(figs_dir,"/","gr2v-ex1"),
cmds : sconcat("( ",
" /* 例1. gxyrange の使用例 */ @",
sconcat("gr2v([explicit(sin(t),t,-%pi,%pi), ",
"explicit(cos(t),t,-%pi,%pi)], @",
"'title=\"ex1 of gr2v\", 'gxyrange, @",
"'file_name=",figfile,", ",swview, " ) @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex2"),
cmds : sconcat("( ",
" /* 例2. gxyrange の使用例 */ @",
sconcat("gr2v([explicit(on3(x,1,3,co)+on3(x,2,4,co),x,0,5)], @",
"'title=\"ex2 of gr2v\", 'gxyrange, @",
"'file_name=",figfile,", ",swview, " ) @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex3"),
cmds : sconcat("( ",
" /* 例3. */ @",
sconcat("g1 : gr2v([explicit(sin(x),x,-%pi,%pi), @",
"explicit(cos(x),x,-%pi,%pi)], @",
" 'gxyrange, 'title=\"ex2-1 of gr2v\", 'noview), @"),
sconcat("g2 : gr2v([implicit(x^2+y^2=1, x,-1,1, y,-1,1)], @",
" 'xrange=[-1.1, 1.1], 'yrange=[-1.1, 1.2], @",
" 'title=\"ex2-2 of gr2v \", 'noview), @"),
sconcat("mk_draw([g1,g2], @",
"['file_name=",figfile,", @",
" 'columns=2, 'dimensions=[1000, 500]], ", swview, " ) @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex4"),
cmds : sconcat("( ",
" /* 例4. on3()関数f(x), 不定積分関数F(x), F(x)の微分関数dF(x) */ @",
sconcat("f : on3(x,1,3,co)+on3(x,2,5,co), @",
"g1 : gr2v([explicit(f,x,0,6)],'gxyrange,'title=\"f(x)\",'noview), @",
"F : on3integ19(f,x), @",
"g2 : gr2v([explicit(F,x,0,6)],'gxyrange,'title=\"F(x)\",'noview), @",
"dF : on3diff(F,x), @",
"g3 : gr2v([explicit(dF,x,0,6)],'gxyrange,'title=\"dF(x)\",'noview), @",
"mk_draw([g1,g2,g3], @",
"['file_name=",figfile,", @",
"'columns=3,dimensions=[1500,500]],", swview, " ) @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex5"),
cmds : sconcat("( ",
" /* 例5. on3()関数f(x), 不定積分関数F(x), F(x)の微分関数dF(x) */ @",
sconcat("f : exp(x-1)*on3(x,minf,1,oo)+exp(1-x)*on3(x,1,inf,co), @",
"g1 : gr2v([explicit(f,x,-4,6)],'gxyrange,'title=\"f(x)\",'noview), @",
"F : on3integ19(f,x), @",
"g2 : gr2v([explicit(F,x,-4,6)],'gxyrange,'title=\"F(x)\",'noview), @",
"dF : on3diff(F,x), @",
"g3 : gr2v([explicit(dF,x,-4,6)],'gxyrange,'title=\"dF(x)\",'noview), @",
"mk_draw([g1,g2,g3],@",
"['file_name=",figfile,", @",
"'columns=3,dimensions=[1500,500]],", swview, " ) @"),
" )"),
chk1show(cmds,""),
return('normal_return)
), /* end of block */
print("--end of gr2v('ex)--"),
return("--end of gr2v('ex)--")
)$ /* end of gr2v() */
/*+++ gr2v_ex ++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
gr2v_ex([args]) := block([progn:"<gr2v_ex>",debug,g1,g2,g3,g4,swview],
debug : ifargd(),
if member('noview,args) then swview:'noview else swview:'view,
if false then
gr2v([explicit(sin(x),x,-%pi,%pi),
explicit(x,x,-%pi,%pi),
explicit(-x,x,-%pi,%pi)],
'yrange=[-1.2,1.2], 'columns=2, swview),
if false then (
g1 : gr2v([explicit(sin(x),x,-%pi,%pi)], 'noview),
g2 : gr2v([explicit(sin(x),x,-%pi,%pi), explicit(cos(x),x,-%pi,%pi)], 'noview),
g3 : gr2v([implicit(x^2+y^2=1, x,-1,1, y,-1,1)], 'noview),
g4 : gr2v([points(makelist([random(20),random(50)],k,1,10))], 'noview),
mk_draw([g1,g2,g3,g4],
['file_name=sconcat(figs_dir,"/","gr2v_ex"), 'columns=2,
'dimensions=[1000, 1000]],
swview)
),
gr2v('help), /* gr2v() も可 */
gr2v('ex,swview),
return("end of gr2v_ex")
)$ /* end of gr2v_ex() */
/*##########################################################################*/
/*### jumppoints : on3関数(1変数)式fのジャンプ点リストを作成 2019.10.04 ##########*/
/*##########################################################################*/
jumppoints([args]) := block([progn:"<jumppoints>",debug, f,var, gxyrange:false,
xp, w, fkn, fp, gxl,gxr, gyl,gyr, xlist,ylist,ymin,ymax, out],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of jumppoints('help)--
機能: 関数(1変数)式fのジャンプ点リストfpを作成する.
また,引数に'gxrangeが指定され,かつジャンプ点が2点以上のときに
gxrange,gyrangeを提案する.
文法: jumppoints(func,...)
例示: jumppoints(on3(x.1.3.co) + on3(x,2,4,co)) -> fp=[[x1,y1],[x2,y2],...]
-> [[1,1],[2,2],[3,1],[4,0]]
jumppoints(on3(x.1.3.co) + on3(x,2,4,co),'gxyrange) -> [fp,gxrange,gyrange]
-> [[[1,1],[2,2],[3,1],[4,0]],[-0.5,5.5],[-0.4,2.4]]
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of jumppoints('ex)--"),
/* ush_ex(), */
block([script],
cashow(jumppoints(on3(x,1,3,co)+on3(x,2,4,co))),
cashow(jumppoints(on3(x,1,3,co)+on3(x,2,4,co),'gxyrange)),
cashow(jumppoints(exp(x-1)*on3(x,minf,1,oo)+exp(1-x)*on3(x,1,inf,co))),
return('normal_return)
), /* end of block */
print("--end of jumppoints('ex)--"),
return("--end of jumppoints('ex)--"),
block_main, /* main ブロック ====================================*/
f : args[1],
var : listofvars(f)[1],
if member('gxyrange, args) then gxyrange:true,
c1show(progn,f,gxyrange),
/* on3関数fの不連続点をxpとして取り出す */
xp : [],
w : on3lrl(f), /* w = [[x],[[minf,1,3,inf]],[true]] */
if length(w[1]) = 1 then (
var : ev(w[1][1]),
xp : w[2][1], xp : delete(minf,xp), xp : delete(inf,xp),
c1show(progn,var,xp)
),
/* on3関数fの不連続点リストxpでの関数値fpを求める -> points(fp)で用いる */
fp : [],
if length(xp) > 0 then (
fp : makelist([xv,ev(f,ev(var)=xv)],xv,xp),
/* fp : [[xv1,fp1],[xp2,fp2],...] g1 での描画で用いる */
c1show(progn,xp,fp,length(fp))
),
out : fp,
c1show(progn,fp),
/* 描画領域[[gxl,gxr],[gyl,gyr]]を設定する */
if gxyrange then (
/* gxl,gxr の仮設定 */
gxl : -10, gxr : 10,
/* 引数 args に xrange=[gxl,gxr] の指定があるとき fkn >0 */
fkn:find_key_no(args,'xrange), c1show(progn,fkn),
if fkn > 0 then (
cashow(args[fkn]),
gxl : rhs(args[fkn])[1],
gxr : rhs(args[fkn])[2],
cashow(gxl,gxr)
),
/* on3関数fの不連続点の個数が2以上のとき,両端の値から描画領域[[gxl,gxr],[gyl,gyr]]を設定する */
if (length(xp) > 1) and gxyrange then (
gxl : first(xp) - (last(xp)-first(xp))*0.5,
gxr : last(xp) + (last(xp)-first(xp))*0.5
),
/* on3関数fの関数値リストから yrange=[gyl,gyr] を作成する */
xlist : makelist(gxl+(gxr-gxl)*i/50, i,0,50),
if length(xp)>0 then xlist : append(xlist,xp),
ylist : makelist(ev(f,ev(var)=xv), xv, xlist),
ymin : lmin(ylist), ymax : lmax(ylist),
gyl : ymin - (ymax-ymin)*0.2, gyr : ymax + (ymax-ymin)*0.2,
c1show(progn,ymin,ymax,gyl,gyr),
out : [fp, [gxl,gxr], [float(gyl),float(gyr)]]
), /* end of if-gxyrange */
c1show(progn,out),
return(out)
)$ /* end of jumppoints() */
/*##########################################################################*/
/*### gr2vf : on3関数(1変数)式fの自動描画(閉点描画) 2019.10.03 ##########*/
/*##########################################################################*/
gr2vf([args]) := block([progn:"<gr2vf>",debug, f,var, atitle:"Plot by gr2vf",
fp, gxl,gxr,gyl,gyr, g1,g2,glist,dlist,dkeyL,swview],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of gr2vf('help)--
機能: on3関数(1変数)式fの自動描画(閉点描画)
文法: gr2vf(f,[args])
例示:
gr2vf()$ or gr2vf('help)$ /* このヘルプを標示する */
gr2vf('ex)$ /* 例を実行する */
f : on3(x,1,3,co) + on3(x,2,5,co),
gr2vf(f)$
gr2vf(f, 'xrange=[0,6], 'title=\"f(x)\")$
--end of gr2vf('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of gr2vf('ex)--"),
/* gr2v_ex(), */
block([cmds],
figfile : sconcat(figs_dir,"/","gr2vf-ex0"),
cmds : sconcat("( ",
" /* 例0. */ @",
sconcat("f:sin(t), ",
"c0show(f), gr2vf(f,'xrange=[-%pi,%pi],'file_name=",figfile,", ",
swview, ") @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex1"),
cmds : sconcat("( ",
" /* 例1. */ @",
sconcat("f:on3(t,1,3,co)+on3(t,2,5,co), @ ",
"c0show(f), gr2vf(f,'file_name=",figfile,", ", swview, ") @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex2"),
cmds : sconcat("( ",
" /* 例2. */ @",
sconcat("f:exp(x-1)*on3(x,minf,1,oo)+exp(1-x)*on3(x,1,inf,co), @",
"c0show(f), gr2vf(f,'file_name=",figfile,", ", swview, ") @"),
" )"),
chk1show(cmds,""),
return('normal_return)
), /* end of block */
print("--end of gr2vf('ex)--"),
return("--end of gr2vf('ex)--"),
block_main, /* main ブロック ====================================*/
f : args[1],
c1show(progn,f),
if length(listofvars(f)) > 1 then (
cashow(progn,"==Error 1変数関数でない =="),
return("error")
),
var : listofvars(f)[1], c1show(progn,var),
[fp, [gxl,gxr], [gyl,gyr]] : jumppoints(f,'gxyrange),
c1show(prong,fp,gxl,gxr,gyl,gyr),
/* 引数 args に 'title="..." の指定があるとき fkn >0 */
fkn:find_key_no(args,'title), c1show(fkn),
if fkn > 0 then (
c1show(progn,args[fkn]),
atitle : rhs(args[fkn]),
c1show(progn,atitle)
),
if length(fp)=0 then
g1:gr2v([explicit(f,ev(var),gxl,gxr),
color=red],
'title=atitle,'xrange=[gxl,gxr],'yrange=[gyl,gyr], 'noview),
if length(fp) > 0 then
g1:gr2v([explicit(f,ev(var),gxl,gxr),'color=red,
points(fp)],
'title=atitle,'xrange=[gxl,gxr],'yrange=[gyl,gyr], 'noview),
/* color=red,point_type=filled_circle,point_size=1.2 */
c1show(g1),
/* dlist : draw() 関数の引数のリスト : 標準値とargsからの変更*/
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","gr2vf"),
columns=1, dimensions=[600,500]],
dkeyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,dkeyL), /* call mergeL */
c1show(progn, dlist),
mk_draw([g1],dlist,swview), /* mk_draw 関数の呼び出し */
c1show(progn,"---end of view---"),
return(g1)
)$ /* end of gr2vf() */
/*############################################################################*/
/*** gr3v 2019.07.04 *******on3lib();********************************************/
/*############################################################################*/
gr3v([args]) := block([progn:"<gr3v>",debug, figfile, funcs,cmds,gkeyL,dkeyL,
gr3L,g1,g2,glist,dlist,swview],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of gr3v('help)--
機能: 3次元グラフの作図
文法: gr3v(funcs,...)
例示:
gr3v()$ or gr3v('help)$ /* このヘルプを標示する */
gr3v('ex)$ /* 例を実行する */
gr3v([explicit((x+y+5)*on3(sqrt(x^2+y^2),2,3,co),
x,-3.5,3.5, y,-3.5, 3.5)], 'title=\"ex1 of gr3v\")$
gr3v([implicit(x^2+y^2+z^2=1, x,-1,1, y,-1,1, z,-1,1)])$
gr3v([points(makelist([random(20),random(50),random(50)],k,1,10))])$
--end of gr3v('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of gr3v('ex)--"),
/* gr3v_ex(), */
block([cmds,figfile],
figfile : sconcat(figs_dir,"/","gr3v-ex1"),
cmds : sconcat("( ",
" /* 例1. */ @",
sconcat("gr3v([explicit((x+y+5)*on3(sqrt(x^2+y^2),2,3,co), ",
"x,-3.5,3.5, y,-3.5, 3.5)], @",
"'title=\"ex1 of gr3v\", 'file_name=",figfile,",",swview, " ) @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr3v-ex2"),
cmds : sconcat("( ",
" /* 例2. */ @",
sconcat("g1 : gr3v([explicit((x+y+5)*on3(sqrt(x^2+y^2),2,3,co), ",
"x,-3.5,3.5, y,-3.5, 3.5)], @",
"'title=\"ex1 of gr3v\", 'noview), @"),
sconcat("g2 : gr3v([implicit(x^2+y^2+z^2=1, x,-1,1, y,-1,1, z,-1,1)], @",
" 'xrange=[-1.1, 1.1], 'yrange=[-1.1, 1.1], ",
" 'title=\"ex2 of gr3v \", 'noview), @"),
sconcat("mk_draw([g1,g2], @",
"['file_name=",figfile,", @",
" 'columns=2, 'dimensions=[1000, 500]], ",swview," ) @"),
" )"),
chk1show(cmds,""),
return('normal_end)
), /* end of block */
print("--end of gr3v('ex)--"),
return("--end of gr3v('ex)--"),
block_main, /* main ブロック ====================================*/
funcs : args[1],
if length(funcs) > 1 then (
print(" -- 描画関数は1本までとする.", length(funcs)), return()
),
gr3L : [title="gr3v plot",
enhanced3d=true, /*surface_hide = true,*/
/* cbrange=[-3,10], nticks = 5,xu_grid = 40, zrange = [zl, zr], */
color=green, view=[60, 30],
interpolate_color=true, contour=none,
/* explicit(f(x,y), x,-%pi,%pi, y,-%pi,%pi), */
funcs[1]],
gkeyL : ['title, 'enhanced3d, 'cbrange, 'nticks, 'xu_grid,
'xrange, 'yrange, 'zrange, 'interpolate_color, 'contour],
gr3L : mergeL(gr3L,args,gkeyL), /* call mergeL */
c1show(progn, gr3L),
g1 : funmake(gr3d, gr3L),
glist : [g1], /* gr2d, gr3d で生成されたグラフィックオブジェクトのリスト */
/* dlist : draw() 関数の引数のリスト : 標準値とその変更*/
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","gr3v"),
columns=1, dimensions=[600,500]],
dkeyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,dkeyL), /* call mergeL */
mk_draw(glist,dlist,swview), /* mk_draw 関数の呼び出し */
c1show("-- end of gr3v --"),
return(g1)
)$ /* end of gr3v() */
/*+++ gr3v_ex ++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
gr3v_ex([args]) := block([progn:"<gr3v_ex>",debug,g1,g2,g3,g4,swview],
debug : ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
gr3v('help),
g1 : gr3v([explicit((x+y+5)*on3(sqrt(x^2+y^2),2,3,co),
x,-3.5,3.5, y,-3.5, 3.5)], 'noview),
g2 : gr3v([implicit(x^2+y^2+z^2=1, x,-1,1, y,-1,1, z,-1,1)], 'noview),
g3 : gr3v([points(makelist([random(20),random(50),random(50)],k,1,10))], 'noview),
mk_draw([g1,g2,g3],
['file_name=sconcat(figs_dir,"/","gr3v_ex"),
'columns=2, 'dimensions=[1000, 1000]],
swview),
return("end of gr3v_ex")
)$ /* end of gr3v_ex() */
/*############################################################################*/
/*### mk_yrange : 関数func of var の定義域[xl,xr]での[最大値,最小値]を求める #########*/
/*############################################################################*/
mk_yrange([args]) := block([progn:"<mk_yrange>",debug,func,var,vl,vr,n:30,xvL,yvL,
ymin,ymax,yl,yr,out],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of mk_yrange('help)--
機能: 関数func of var の定義域[xl,xr]での[最大値,最小値]を求める
文法: mk_yrange([args],...)
例示:
mk_yrange(func,var,vl,vr)$
/* 変数varの関数funcの区間[vl,vr]における[min,max]をリストで返す*/
mk_yrange(sin(x),x,-%pi/2,%pi/2)$ -> [-1.3,1.3]
mk_yrange([sin(x),x,-%pi/2,%pi/2])$ /* リスト形式も可 */
--end of mk_yrange('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of mk_yrange('ex)--"),
/* mk_range_ex(), */
block([],
cshow("--ex of mk_yrange(sin(x),x,-%pi/2,%pi/2)--"),
cashow(mk_yrange(sin(x),x,-%pi/2,%pi/2)),
cshow("--ex of mk_yrange([sin(x),x,-%pi/2,%pi/2])--"),
cashow(mk_yrange([sin(x),x,-%pi/2,%pi/2])),
cashow(mk_yrange(on3(t,1,3,co)+on3(t,2,4,co),t,0,5)),
return("end from mk_yrange('ex)")
), /* end of block */
print("--end of mk_yrange('ex)--"),
return("--end of mk_yrange('ex)--"),
block_main, /* main ブロック ====================================*/
if length(args) >= 4 then ( /* 引数exp,keyfuncを取り出す */
func:args[1] ,var:args[2], vl:args[3], vr:args[4]
),
if length(args)>0 and listp(args[1]) and length(args[1])=4 then (
func:args[1][1] ,var:args[1][2], vl:args[1][3], vr:args[1][4]
),
c1show(func,var,xl,xr),
n : 30,
xvL : makelist(vl+(vr-vl)*i/n, i,0,n),
if true then (
cshow(func,ev(func)),
w : on3lrl(ev(func)),
/* 式内のon3()から,またはその完全リストからon3関数端点リストを取り出す.
また,端点リストに非数値が含まれるときFALSEを含まれないときTRUEを返す. */
cshow(w),
if length(w[1]) > 0 then (
wx : w[2][1], wx: delete(minf,wx), wx : delete(inf,wx),
if length(wx) > 1 then (
xl : first(wx) - (last(wx)-first(wx))*0.25,
xr : last(wx) + (last(wx)-first(wx))*0.25
) else (xl:-10, xr:10),
cshow(wx), cshow(xl,xr),
if length(wx)#0 then xvL : append(xvL,wx)
) /* end of if-length */
),
c1show(xvL),
yvL : makelist(ev(func,ev(var)=xvL[i]), i,1,length(xvL)),
c1show(yvL),
ymin : lmin(yvL),
ymax : lmax(yvL),
c1show(ymin,ymax),
yl : ymin - (ymax-ymin)*0.15,
yr : ymax + (ymax-ymin)*0.15,
out : float([yl,yr]),
c1show(out),
return(out)
)$ /* end of mk_yrange */
/*###########################################################################*/
/* <exp2l>: exp内に使われているkeyfuncで指定された関数(複数回使用可)の引数リストを返す */
/*###########################################################################*/
exp2l([args]) := block([progn:"<exp2l>",debug,expr,keyfunc,
exp1,exp2,exp3,out,outfind,outf,outa],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of exp2l('help)--
機能: exp内に使われているkeyfuncで指定された関数(複数回使用可)の引数リストを返す
文法: exp2l(expr,keyfunc,...)
例示:
exp2l(expr,keyfunc)$ /* 表現exp内において,keyfuncで指定された関数を検出し,その引数を返す */
exp1 : 'gr2v([explicit(sin(x),x,-%pi,%pi)], 'noview)$
exp2l(exp1,'explicit)$
exp2 : 'gr2v([explicit(sin(x),x,-%pi,%pi),
explicit(x^2,x,-%pi,%pi)], 'noview)$
exp2l(exp2,'explicit)$
exp3 : 'gr3v([implicit(x^2+y^2+z^2=1, x,-1,1, y,-1,1, z,-1,1)], 'noview)$
exp2l(exp3,explicit)$ /* 未検出の例 */
--end of exp2l('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of exp2l('ex)--"),
/* exp2l_ex(), */
block([exp1,exp2,exp3],
exp1 : 'gr2v([explicit(sin(x),x,-%pi,%pi)], 'noview),
c0show(exp1), cashow(exp2l(exp1,'explicit)),
exp2 : 'gr2v([explicit(sin(x),x,-%pi,%pi),
explicit(x^2,x,-%pi,%pi)], 'noview),
c0show(exp2),cashow(exp2l(exp2,'explicit)),
exp3 : 'gr3v([implicit(x^2+y^2+z^2=1, x,-1,1, y,-1,1, z,-1,1)], 'noview),
c0show(exp3),cashow(exp2l(exp3,explicit)), /* 未検出の例 */
return("end from exp2l('ex)")
), /* end of block */
print("--end of exp2l('ex)--"),
return("--end of exp2l('ex)--"),
block_main, /* main ブロック ====================================*/
if length(args) >= 2 then (expr:args[1], keyfunc:args[2]), /* 引数exp,keyfuncを取り出す */
c1show("S0:入力関数:",expr, keyfunc),
/* 式表現から完全リストを作成する */
out: scanmap(lambda([u], if atom(u)=false
then u:cons(op(u),args(u)) else u), expr),
c1show("S1:完全リスト:",out),
outfind :[],
c2show(outfind),
/* expr のリスト表現からkeyfuncを含むサブリストoutfindを作成する */
out : scanmap(lambda([u], if listp(u) and u[1]=keyfunc
then (outfind : endcons(u,outfind), u) else u ), out),
c1show("S2:explicit関数部抽出:",outfind),
if length(outfind)=0 then
(c1show(progn,"結果:",keyfunc,"を検出しなかったので空リスト[]を返す"),
return([]))
else if length(outfind)>0 then
(outf:copylist(outfind), outa:copylist(outfind),
for i:1 thru length(outfind) do (
outf[i] : l2f(outfind[i]),
c1show("S3:explicit関数部抽出:",outf[i]),
outa[i] : args(outf[i]),
c1show("S4:explicit関数の引数部抽出:",outa[i])
), /* end of do */
c1show(progn,"結果:",keyfunc),c1show(outa),
return(outa)
) /* end of else-if */
)$ /* end of exp2l() */
/*############################################################################*/
/*### grv: draw out in png/pdf-file and view ##########################*/
/* 使用例 XXX 廃止予定
g1 : gr2d(explicit(sin(x)/x, x, -10,10))$
c2co : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co)$
g2 : on3gr2(c2co)$
mk_draw mk_draw([g1,g2],
[terminal="png, file_name=sconcat(figs_dir,"/","grv"),
columns=1, dimensions=[900,1350]],'view)$
*/
/*############################################################################*/
grv([args]) := block([progn:"<grv>",debug,swview,plotmode:true,viewmode:true,ii:0,
inparm : "",
cmd0 : "system(\"convert /tmp/tmp.png /tmp/tmp.pdf\")",
cmd1 : "system(\"eog /tmp/tmp.png > /dev/null 2>&1 \" )"],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of grv('help)--
機能: grオブジェクトの描画
文法: grv([g1])
例示: grv(expr)
g1 : gr2d(explicit(sin(x)/x, x, -10,10))$
c2co : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co)$
g2 : on3gr(c2co)$ /* on3() を含む2変数関数をgr2d()で表現する */
grv([g1,g2],columns=2,dimensions=[1000,500])$
--end of grv('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of grv('ex)--"),
grv_ex(swview),
print("--end of grv('ex)--"),
return("--end of grv('ex)--"),
block_main, /* main ブロック ====================================*/
if member('noview, args) then swview:'noview else swview:'view,
c1show(progn,"1---",args),
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","grv_ex"),
columns=2, dimensions=[1000,500]],
dlist : mergeL(dlist,args,['terminal,'file_name,'columns,'dimensions]),
mk_draw(glist,dlist,swview), /* mk_draw 関数の呼び出し */
print(" => grv out :",cmd1),
return("")
)$
/*-------------------------------------------------------------------------*/
grv_ex([args]) := block([progn:"<grv_ex>",debug,swview],
if member('noview, args) then swview:'noview else swview:'view,
display2d:false,
cshow("--- begin of grv_ex ---"),
g1 : gr2d(explicit(sin(x)/x, x, -10,10)),
c2co : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co),
cshow(c2co),
g2 : on3gr(c2co), /* on3() を含む2変数関数をgr2d()で表現する */
glist : [g1,g2], /* gr2d, gr3d で生成されたグラフィックオブジェクトのリスト */
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","grv_ex"),
columns=2, dimensions=[1000,500]],
dlist : mergeL(dlist,args,['terminal,'file_name,'columns,'dimensions]),
mk_draw(glist,dlist,swview), /* mk_draw 関数の呼び出し */
return("--- end of grv_ex ---")
)$ /* end of grv_ex() */
/*############################################################################*/
/* ### on3gr : on3関数で記述された領域(3変数も可，孤立点は不可)の作図 ##########*/
/* 使用例 : on3gr(ex2), on3gr(ex2,xrange=[0,3],yrange=[0,3]), */
/* on3gr(ex3co,xrange=[-3,3],yrange=[-3,3],zrange=[-3,3],noview) */
/*############################################################################*/
on3gr([args]) :=
block([progn:"<on3gr>",debug,expr, plotmode:true,viewmode:false,swview,
varl,xvar,lastvar,vend,rxrange:"",ryrange:"",rzrange:"",
rxl:-3.1,rxr:3.1,ryl:-3.1,ryr:3.1,rzl,rzr,
L,fl,fr,flr,xl,xr,xlr,fltype,frtype,xrng,D,Fl,Fr,gst,gout:""],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3gr('help)--
機能: on3関数で記述された領域(3変数も可，孤立点は不可)の作図
文法: on3gr(expr,...)
例示: on3gr(expr)
ex2 : on3(x,0,3/5,co)*on3(y,sqrt(1-x^2),x+1,cc)
+on3(x,sqrt(17)/2-1/2,4*sqrt(11)/5-1/5,co)*on3(y,(x+1)/2,sqrt(9-x^2),cc)
+on3(x,3/5,sqrt(17)/2-1/2,co)*on3(y,(x+1)/2,x+1,cc),
grex1 : ev(on3gr(ex2)),
c0show(\"実行例:\",grex1),
glist : [grex1],
dlist : [terminal=png, file_name=sconcat(figs_dir,'/','on3gr')],
mk_draw(glist,dlist,'view)
--end of on3gr('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3gr('ex)--"),
on3gr_ex(swview),
print("--end of on3gr('ex)--"),
return("--end of on3gr('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
/*** 作図，表示の選択 ***/
if member(noplot,args) then (plotmode:false, args:delete(noplot,args)),
if member(view,args) then (viewmode:true, args:delete(view,args)),
varl : listofvars(expr), for lr in [cc,co,oc,oo] do varl : delete(lr,varl),
xvar:first(varl), lastvar:last(varl), vend:length(varl),
d1show(xvar,lastvar,vend),
rzrange : 'zrange=[-5,5],
for i thru length(args) do (
if lhs(args[i])='xrange then (
rxrange : string(args[i]), rxl:rhs(args[i])[1], rxr:rhs(args[i])[2] )
else if lhs(args[i])='yrange then (
ryrange : string(args[i]), ryl:rhs(args[i])[1], ryr:rhs(args[i])[2] )
else if lhs(args[i])='zrange then (
rzrange : string(args[i]), rzl:rhs(args[i])[1], rzr:rhs(args[i])[2] )
), /* end of for-i */
d1show(rxrange,rxl,rxr),
L : f2l(expr), Fl:[], Fr:[],
for i:2 thru length(L) do (
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=lastvar then
(fl:u[3], fr:u[4], flr:u[5]) else u ), L[i]),
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=xvar then
(xl:u[3], xr:u[4], xlr:u[5]) else u ), L[i]),
D:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=lastvar then
u:1 else u ), L[i]),
D : l2f(D), if vend = 3 then (fl:fl*D, fr:fr*D),
if flr=oo then (fltype:line_type=dots, frtype:line_type=dots)
else if flr=oc then (fltype:line_type=dots, frtype:line_type=solid)
else if flr=co then (fltype:line_type=solid, frtype:line_type=dots)
else if flr=cc then (fltype:line_type=solid, frtype:line_type=solid),
xrng: [xvar,xl,xr],
Fl:endcons([fl,fltype,xvar,xl,xr],Fl),
Fr:endcons([fr,frtype,xvar,xl,xr],Fr)
),
d1show(Fl),d1show(Fr),
if length(varl) = 2 then ( /* 2次元プロット */
cshow(progn,":2次元プロット: 1個のgr2d()オブジェクト"),
gL : [line_width=2],
if rxrange # "" then gL : endcons(rxrange,gL),
if ryrange # "" then gL : endcons(ryrange,gL),
for i thru length(Fl) do (
gL: append(gL,[color=blue,
Fl[i][2], explicit(Fl[i][1],Fl[i][3],Fl[i][4],Fl[i][5])] ),
gL: append(gL, [color=red,
Fr[i][2], explicit(Fr[i][1],Fr[i][3],Fr[i][4],Fr[i][5])] )
),
d1show(progn,gL),
gout : funmake(gr2d,gL),
d1show(progn,gout)
), /* end of plot-2D */
if length(varl) = 3 then ( /* 3次元プロット */
cshow(progn,":3次元プロット: 複数個のgr3d()オブジェクト"),
gout:[],
for i:1 thru length(Fl) do (
gL : [line_width=2],
if rxrange # "" then gL : endcons(rxrange, gL),
if ryrange # "" then gL : endcons(ryrange, gL),
if rzrange # "" then gL : endcons(rzrange, gL),
/* 作図見本 */
gL: append(gL,[color=blue,xu_grid=40,yv_grid=40,
Fl[i][2], parametric_surface(x,y,Fl[i][1],
x,rxl,rxr, y,ryl,ryr)] ),
gL: append(gL,[color=red,xu_grid=40,yv_grid=40,
Fr[i][2], parametric_surface(x,y,Fr[i][1],
x,rxl,rxr, y,ryl,ryr)] ),
gst : funmake(gr3d,gL), d1show(gst),
gout : endcons(gst,gout)
), /* end of do */
d1show(progn,gout)
), /* end of plot-3D */
return(gout)
)$ /* end of on3gr() */
/*--- on3gr_ex --------------------------------------------------------------*/
on3gr_ex([args]) := block([progn:"<on3gr_ex>",
debug, plotmode:true, viewmode:false, ex2,ex3co,ex3oc, ex,gex,swview],
debug : ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
display2d:false,
ex2 : on3(x,0,3/5,co)*on3(y,sqrt(1-x^2),x+1,cc)
+on3(x,sqrt(17)/2-1/2,4*sqrt(11)/5-1/5,co)*on3(y,(x+1)/2,sqrt(9-x^2),cc)
+on3(x,3/5,sqrt(17)/2-1/2,co)*on3(y,(x+1)/2,x+1,cc),
ex3co : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),oo)
*on3(z,-sqrt(-y^2-x^2+9),-sqrt(-y^2-x^2+1),oc)
+on3(x,-1,1,oo)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),oo)
*on3(z,sqrt(-y^2-x^2+1),sqrt(-y^2-x^2+9),co),
ex3oc : on3(x,1,3,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),cc)
+on3(x,-3,-1,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),cc)
+on3(x,-1,1,cc)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),co)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),cc)
+on3(x,-1,1,cc)*on3(y,sqrt(1-x^2),sqrt(9-x^2),oc)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),cc)
+on3(x,-1,1,cc)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),cc)
*on3(z,-sqrt(-y^2-x^2+9),-sqrt(-y^2-x^2+1),co)
+on3(x,-1,1,cc)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),cc)
*on3(z,sqrt(-y^2-x^2+1),sqrt(-y^2-x^2+9),oc),
argL1 : [ex2,xrange=[0,3],yrange=[0,3]],
argL2 : [ex3co,xrange=[-3,3],yrange=[-3,3],zrange=[-3,3]],
grex1 : ev(on3gr(ex2)),
cshow("実行例:",grex1),
glist : [grex1],
dlist : [terminal=png, file_name=sconcat(figs_dir,"/","on3gr-ex1")],
mk_draw(glist,dlist,swview),
c0show(progn,"on3gr(ex3co) を実行しています."),
grex2 : ev(on3gr(ex3co)),
cshow("実行例:",grex2),
glist : [grex2],
dlist : [terminal=png, file_name=sconcat(figs_dir,"/","on3gr-ex2"),
columns=2, dimensions=[900,1350]],
mk_draw(glist,dlist,swview),
return("--- end of on3gr_ex ---")
)$ /* end of on3gr_ex() */
/*############################################################################*/
/* ### on3funcdraw() : gr3d + mk_draw による描画 ###############################*/
/*############################################################################*/
on3funcdraw([args]) := block([progn:"<on3funcdraw>",debug,
g,g1,g2,swview],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3funcdraw('help)--
機能: gr3d + mk_draw による描画
文法: on3funcdraw([args],...)
例示:
g(x,y) := (x+y+5)*on3(sqrt(x^2+y^2), 2, 3, co),
g1 : gr3d(enhanced3d=true, color=green, cbrange=[-3,10],
view=[60, 30],
title=\"example of on3-func, and contour\",
interpolate_color=true, contour=none,
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
g2 : gr3d(view=map,enhanced3d=true, color=green, cbrange=[-3,10],
interpolate_color=true, contour=none,
title=\"example of contour \",
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
mk_draw([g1,g2],[terminal=png, file_name=\"tmp\",
columns=2, dimensions=[900,500]],'view),
--end of on3funcdraw('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3funcdraw('ex)--"),
/* on3funcdraw_ex(), */
block([g,g1,g2,viewmode,strview],
if member('noview, args) then strview:'noview else strview:'view,
g(x,y) := (x+y+5)*on3(sqrt(x^2+y^2), 2, 3, co),
g1 : gr3d(enhanced3d=true, color=green, cbrange=[-3,10],
view=[60, 30],
title="example of on3-func, and contour",
interpolate_color=true, contour=none,
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
g2 : gr3d(view=map,enhanced3d=true, color=green, cbrange=[-3,10],
interpolate_color=true, contour=none,
title="example of contour ",
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
mk_draw([g1,g2],[terminal=png, file_name=sconcat(figs_dir,"/","on3funcdraw"),
columns=2, dimensions=[900,500]],swview),
return("-- end of on3funcdraw_ex --")
), /* end of block */
print("--end of on3funcdraw('ex)--"),
return("--end of on3funcdraw('ex)--"),
block_main, /* main ブロック ====================================*/
g(x,y) := (x+y+5)*on3(sqrt(x^2+y^2), 2, 3, co),
g1 : gr3d(enhanced3d=true, color=green, cbrange=[-3,10],
view=[60, 30],
title="example of on3-func, and contour",
interpolate_color=true, contour=none,
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
g2 : gr3d(view=map,enhanced3d=true, color=green, cbrange=[-3,10],
interpolate_color=true, contour=none,
title="example of contour ",
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
if member('noview,args) then strview:'noview else strview:'view,
mk_draw([g1,g2],[terminal=png, file_name=sconcat(figs_dir,"/","on3funcdraw"),
columns=2, dimensions=[900,500]],swview),
return("-- end of on3funcdraw --")
)$ /* end of on3funcdraw() */
/*** ###### end of replace 2019.04.05 #################################*/
/*** ###### 2019.05.04 add ############################################*/
/*############################################################################*/
/*### on3varfix on3関数on3(x,xl,xr,xlr)の第1引数xをx_fixに変更する（2019.04.19）###*/
/*############################################################################*/
on3varfix([args]) := block([progn:"<on3fix>", debug,on3func,var,fix,
on3varsL, L, var_fix, one, out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3varfix('help)--
機能: on3関数on3(x,xl,xr,xlr)の第1引数xをx_fixに変更する
文法: on3varfix(on3func,var,'on,...)
例示: on3func : a*on3(x,a,b,co)*on3(y,c,d,co),
on3varfix(on3func,x,'on)
on3varfix(on3func,x,'off)
--end of on3varfix('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3varfix('ex)--"),
/* on3varfix_ex(), */
block([ex0,ex1,ex2,ex,out_on,out_off],
ex0 : a*x+b,
ex1 : on3(x,a,b,co),
ex2 : a*on3(x,a,b,co)*on3(y,c,d,co),
for ex in [ex0,ex1,ex2] do (
c0show(ex),
out_on : on3varfix(ex,x,'on),
c0show(" -> ", out_on),
out_off : on3varfix(out_on,x,'off),
c0show(" -> ", out_off)
),
return('normal_return)
), /* end of block */
print("--end of on3varfix('ex)--"),
return("--end of on3varfix('ex)--"),
block_main, /* main ブロック ====================================*/
if length(args) < 3 then (
c0show(progn, "Errror in number of arguments"), return('error)
),
on3func : args[1], var : args[2], fix : args[3],
on3varsL : on3vars(on3func),
c2show(progn, var, fix, on3varsL),
if length(on3varsL) = 0 then return(on3func),
L:f2l(on3func), c1show(L), /* change 2012.01.25, 2019.04.14 */
if L[1] = on3 then L : f2l(one*on3func),
var_fix : eval_string(sconcat(var,"_fix")),
c1show(progn,var,var_fix,fix),
c2show(properties(var),properties(var_fix)),
c1show(progn,"before",L),
if fix='on then (
/* on3(x,xl,xr,xlr)-> on3(x_fix,xl,xr,xlr)とし,積分に反応しないようにする */
L:scanmap(lambda([u],if listp(u) and u[1]='on3 and u[2]=var
then (u[2]:ev(var_fix), u) else u),L)
) else (
/* on3(x_fix,xl,xr,xlr) -> on3(x,xl,xr,xlr)とする */
L:scanmap(lambda([u],if listp(u) and u[1]='on3 and u[2]=ev(var_fix)
then (u[2]:ev(var), u) else u),L)
/* out1 : ev(l2f(L), ev(var_fix)=ev(var)), cshow(out1) */
),
c1show(progn,"after",L),
out : ev(l2f(L), one=1),
c1show(out),
return(out)
)$ /* end of on3varfix() */
/*############################################################################*/
/*### on3chgvar3_ex([args]) ######################################*/
/*** 2019.04.19 *************************************************
3変数矩形領域 D : [0 < x <1, 0 < y < 1, 0 < z < 1] から
変換 [t = x + y + z, u = y, v = z] のとき (t,u,v) の領域Gを求める
G = on3(t,2,3,oc)*on3(u,t-2,1,cc)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,0,t-1,co)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,t-1,1,cc)*on3(v,0,t-u,cc)
+on3(t,0,1,cc)*on3(u,0,t,cc)*on3(v,0,t-u,cc)
? on3ineq([[t-u-v, 0, 1, cc], [u, 0, 1, cc], [v, 0, 1, cc]]) では失敗する??
(1) (2) (3)
k1; t-u を tu として (1),(3)の不等式を tu, v について解き 結果を c0 とする.
c0 = on3(t-u,1,2,oc)*on3(v,(-u)+t-1,1,cc)+on3(t-u,0,1,cc)*on3(v,0,t-u,cc)
= c01 * c0v1 + c02 * c0v2
k2: c0の t-u に関する不等式 c01 と(2)の不等式を解き,結果を out01 とする.
k3: c0の t-u に関する不等式 c02 と(2)の不等式を解き,結果を out02 とする.
k4: 解 out : out01*c0v1 + out02*c0v2
****************************************************************/
/*############################################################################*/
on3chgvar3([args]) := block([progn:"<on3chgvar3>",debug,
c0,c0ans,c0v1,c0v2,c01,c02,out01,out02,out,outans,gtans, G_tuv,G_tu,G_t,G],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3chgvar3('help)--
機能: 3変数矩形領域 D : [0 < x <1, 0 < y < 1, 0 < z < 1] から
変換 [t = x + y + z, u = y, v = z] のとき (t,u,v) の領域Gを求める
文法: on3chgvar3(...)
例示: on3chgvar3('go')
G = on3(t,2,3,oc)*on3(u,t-2,1,cc)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,0,t-1,co)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,t-1,1,cc)*on3(v,0,t-u,cc)
+on3(t,0,1,cc)*on3(u,0,t,cc)*on3(v,0,t-u,cc)
? on3ineq([[t-u-v, 0, 1, cc], [u, 0, 1, cc], [v, 0, 1, cc]]) では失敗する??
(1) (2) (3)
k1; t-u を tu として (1),(3)の不等式を tu, v について解き 結果を c0 とする.
c0 = on3(t-u,1,2,oc)*on3(v,(-u)+t-1,1,cc)+on3(t-u,0,1,cc)*on3(v,0,t-u,cc)
= c01 * c0v1 + c02 * c0v2
k2: c0の t-u に関する不等式 c01 と(2)の不等式を解き,結果を out01 とする.
k3: c0の t-u に関する不等式 c02 と(2)の不等式を解き,結果を out02 とする.
k4: 解 out : out01*c0v1 + out02*c0v2
--end of on3chgvar3('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3chgvar3('ex)--"),
/* on3chgvar3_ex(), */
print("--end of on3chgvar3('ex)--"),
return("--end of on3chgvar3('ex)--"),
block_main, /* main ブロック ====================================*/
print("--begin ",progn,"--"),
c0 : on3ineq([[tu-v,0,1,cc],[v,0,1,cc]],'resultonly,'noview),
c0 : ratsubst(t-u,tu,c0),
c0ans : on3(t-u,1,2,oc)*on3(v,(-u)+t-1,1,cc)+on3(t-u,0,1,cc)*on3(v,0,t-u,cc),
cshow(c0),cshow(c0ans),
cshow(f2l(c0)),
c0v1 : l2f(f2l(c0)[2][4]), /* c0v1 = on3(v,(-u)+t-1,1,cc) */
c0v2 : l2f(f2l(c0)[3][4]), /* c0v2 = on3(v,0,t-u,cc) */
cshow(progn,c0v1,c0v2),
c01 : f2l(c0)[2][3], /* [on3, t-u,1,2,oc] */
c02 : f2l(c0)[3][3], /* [on3 t-u,0,1,cc] */
cshow(progn,c01,c02),
out01 : on3ineq([rest(c01,1),[u,0,1,cc]],'resultonly,'noview),
out02 : on3ineq([rest(c02,1),[u,0,1,cc]],'resultonly,'noview),
out : out01*c0v1 + out02*c0v2,
out : expand(out),
outans : on3(t,2,3,oc)*on3(u,t-2,1,cc)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,0,t-1,co)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,t-1,1,cc)*on3(v,0,t-u,cc)
+on3(t,0,1,cc)*on3(u,0,t,cc)*on3(v,0,t-u,cc),
c1show(out),c1show(outans),
if false then chk1show("out",outans), /* 検証 call chkshow */
/* 検算 */
print("変換後の定義域 G_tuv=out においてp.d.f.が g(t,u,v)=1 on G とする"),
G_tuv : out,
c1show(G_tuv),
chk1show("G_tuv",outans), /* 検証 call chkshow */
G_tu : on3integ19(G_tuv,v,minf,inf),
c1show(G_tuv),
c0show(G_tu),
G_t : on3integ19(G_tu,u,minf,inf), /* G_t : on3decomp(G_t), */
gtans : (t-3)^2/2*on3(t,2,3,oc)
+(-(2*t^2-6*t+3)/2)*on3(t,1,2,oc)
+t^2/2*on3(t,0,1,cc) ,
/* gtans : on3decomp(gtans), */
c0show("G_t: T=X+y+Z の確率密度関数"), chk1show("G_t", gtans),
G : on3integ19(G_t,t,minf,inf), cshow("全確率の確認:",G),
return(out)
)$ /* end of on3chgvar3 */
/*############################################################################*/
/*### on3find #########2019.04.21 ###*/
/* on3()の積の項において指定した変数Varに関するon3(var,,,,)を検索する */
/*############################################################################*/
on3find([args]) := block([progn:"<on3find>",debug,on3func,var],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3find('help)--
機能: on3()の積の項において指定した変数Varに関するon3(var,,,,)を検索する
文法: on3find(on3func,var,...)
例示:
ex = on3(x,a,b,co)*on3(y,yl,yr,oo)+x*on3(x,c,d,cc)$
on3typep(on3func) = on3poly , on3vars(on3func) = [x,y]
** find ic = 1 , u = [on3,x,a,b,co]
** find ic = 2 , u = [on3,x,c,d,cc]
L = [\"+\",[\"*\",1,\"<<here-1>>\",[on3,y,yl,yr,oo]],[\"*\",x,\"<<here-2>>\"]]
--end of on3find('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3find('ex)--"),
/* on3find_ex(), */
block([progn:"<on3find('ex)>",debug,ex,x,out],
debug: ifargd(),
ex : on3(x,a,b,co)*on3(y,yl,yr,oo) + x*on3(x,c,d,cc),
c0show(ex),
out : on3find(ex,x),
c0show(out),
return("-- end of on3find_ex --")
), /* end of block */
print("--end of on3find('ex)--"),
return("--end of on3find('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1],
cshow(on3typep(on3func), on3vars(on3func)),
if (length(args)=1) and (length(on3vars(on3func))=1)
then var: on3vars(on3func)[1]
else if (length(args) > 1) and member(args[2],on3vars(on3func))
then var : args[2]
else (c0show("Error in ",progn),return()),
cshow(var),
L : f2l(on3func),
ic : 0,
L : scanmap(lambda([u],
if listp(u) and u[1]=on3 and u[2]=ev(var) then (
ic:ic+1, cshow("** find ",ic,u),
u:sconcat("<<here-",ic,">>"), u) else u), L),
cshow(L),
return(l2f(L))
)$ /* end of on3find() */
on3find_ex([args]) := block([progn:"<on3find_ex>",debug],
debug: ifargd(),
ex : on3(x,a,b,co)*on3(y,yl,yr,oo) + x*on3(x,c,d,cc),
cshow(ex),
out : on3find(ex,x),
cshow(out),
return("-- end of on3find_ex --")
)$ /* end of on3find_ex() */
/* ### From: interpol.mac (引用)#######################################################*/
/* Cubic splines interpolation. The argument must be either: */
/* a) a two column matrix, p:matrix([2,4],[5,6],[9,3]) */
/* b) a list of pairs, p: [[2,4],[5,6],[9,3]] */
/* c) a list of numbers, p: [4,6,3], in which case the abscissas will be */
/* assigned automatically to 1, 2, 3, etc. */
/* In cases a) and b) the pairs are ordered wrt the 1st. coordinate before any */
/* computation is made. Options: */
/* 'd1='unknown: 1st derivative at x_1; if it is 'unknown, the second derivative */
/* at x_1 is made equal to 0 (natural cubic spline); if it is equal to a */
/* number, the second derivative is estimated based on this number */
/* 'd2='unknown: 1st derivative at x_n; if it is 'unknown, the second derivative */
/* at x_n is made equal to 0 (natural cubic spline); if it is equal to a */
/* number, the second derivative is estimated based on this number */
/* 'varname='x: the name of the independent variable */
/* Reference: this algorithm is based on 'Numerical Recipes in C', section 3.3 */
/*### on3cspline ######################################################################*/
on3cspline(tab,[select]):= block([options, defaults, n, aux, y2, u, sig, p,
qn, un, a, b, s:0, aj, bj, cj, dj, lr:'co, ratprint:false],
/*--- block -----------------------------------------------------------------------*/
interpol_check_input(data,funame):=
block([n,out],
if not listp(data) and not matrixp(data)
then error("Argument to '",funame,"' must be a list or matrix"),
n: length(data),
if n<2
then error("Argument to '",funame,"' has too few sample points")
elseif listp(data) and
every('identity,map(lambda([x], listp(x) and length(x)=2),data))
then out: sort(data)
elseif matrixp(data) and length(data[1]) = 2
then out: sort(args(data))
elseif listp(data) and every('identity,map(lambda([x], not listp(x)),data))
then out: makelist([i,data[i]],i,1,n)
else error("Error in arguments to '",funame,"' function"),
/* controlling duplicated x's */
for i:2 thru n do
if out[i-1][1] = out[i][1]
then error("Duplicated abscissas are not allowed"),
out ),
/*--------------------------------------------------------------------------------*/
tab: interpol_check_input(tab,"cspline"), remfunction(interpol_check_input),
options: ['d1, 'dn, 'varname],
defaults: ['unknown, 'unknown, 'x],
for i in select do(
aux: ?position(lhs(i),options),
if numberp(aux) and aux <= length(options) and aux >= 1
then defaults[aux]: rhs(i)),
if not numberp(defaults[1]) and defaults[1] # 'unknown
then error("Option 'd1' is not correct"),
if not numberp(defaults[2]) and defaults[2] # 'unknown
then error("Option 'dn' is not correct"),
if not symbolp(defaults[3])
then error("Option 'varname' is not correct"),
/* if tab contains only two points, linear interpolation */
n: length(tab),
if n=2 /* case of two points */
then return(ratsimp( tab[2][2] + (tab[2][2]-tab[1][2]) *
(defaults[3]-tab[2][1]) / (tab[2][1]-tab[1][1]))),
/* constructing the interpolating polynomial */
y2: makelist(0,i,1,n),
u: makelist(0,i,1,n-1),
/* controlling the lower boundary condition */
if /*d1*/ defaults[1] = 'unknown
then (y2[1]: 0, u[1]: 0)
else (y2[1]: -1/2,
u[1]: 3 / (tab[2][1]-tab[1][1]) *
((tab[2][2] - tab[1][2])/(tab[2][1] - tab[1][1]) - defaults[1]) ),
/* decomposition loop of the triangular algorithm */
for i:2 thru n-1 do (
sig: (tab[i][1] - tab[i-1][1]) / (tab[i+1][1] - tab[i-1][1]),
p: sig * y2[i-1] + 2,
y2[i]: (sig - 1) / p,
u[i]: (tab[i+1][2] - tab[i][2]) /(tab[i+1][1] - tab[i][1]) -
(tab[i][2] - tab[i-1][2]) /(tab[i][1] - tab[i-1][1]),
u[i]: (6 * u[i] / (tab[i+1][1] - tab[i-1][1]) - sig * u[i-1]) / p ) ,
/* controlling the upper boundary condition */
if /*dn*/ defaults[2] = 'unknown
then (qn: 0, un: 0)
else (qn: 1/2, un: 3 / (tab[n][1] - tab[n-1][1]) *
(defaults[2] - (tab[n][2] - tab[n-1][2]) / (tab[n][1] - tab[n-1][1]))),
y2[n]: (un - qn * u[n-1]) / (qn * y2[n-1] + 1),
/* backsubstitution loop of the tridiagonal algorithm */
for k: n-1 thru 1 step -1 do
y2[k]: y2[k] * y2[k+1] + u[k],
/* constructing the cubic splines */
for j:2 thru n do (
if j=2 then (a: 'minf, b: tab[j][1], lr:oo )
else if j=n then (a: tab[j-1][1], b: 'inf, lr:co)
else (a: tab[j-1][1], b: tab[j][1], lr:co),
/* in the following sentences, defaults[3] is variable's name */
aux: (tab[j][1] - tab[j-1][1]),
aj: (tab[j][1] - defaults[3]) / aux, bj: (defaults[3] - tab[j-1][1]) / aux,
aux: aux * aux /6,
cj: (aj^3 - aj) * aux, dj: (bj^3 - bj) * aux,
s: s + funmake('on3,[defaults[3], a, b, lr]) *
expand(aj * tab[j-1][2] + bj * tab[j][2] + cj * y2[j-1] + dj * y2[j]) ),
s )$ /* end of on3cspline() */
/*--- on3cspline_ex ------------------------------------------------------------*/
on3cspline_ex([args]) := block([progn:"<on3cspline_ex>",debug],
debug:ifargd(),
p:[[7,2],[8,2],[1,5],[3,2],[6,7]], cshow(p),
/* cspline(p); ==> natural cubic spline (second derivatives are zero in both extremes) */
f(x):=on3cspline(p),
map(f,[2.3,5/7,%pi]),
g1:gr2d(
explicit(f(x),x,0,9),
title = concat("cspline: default"), yrange=[0,10],
point_size = 3,
points(p)),
g(x) := on3cspline(p,d1=0,dn=0),
g2:gr2d(
explicit(g(x),x,0,9),
title = concat("cspline: d1=0, dn=0"), yrange=[0,10],
point_size = 3,
points(p)),
grv(g1,g2,dimensions=[1800,2800]),
return()
)$ /* end of on3cspline_ex() */
/*############################################################################*/
/*### on3lspline #############################################################*/
/*############################################################################*/
on3lspline(tab,[select]) := block([n,s:0,a,b,options, defaults,ratprint:false,lr],
/*--- block -----------------------------------------------------------------------*/
interpol_check_input(data,funame):=
block([n,out],
if not listp(data) and not matrixp(data)
then error("Argument to '",funame,"' must be a list or matrix"),
n: length(data),
if n<2
then error("Argument to '",funame,"' has too few sample points")
elseif listp(data) and
every('identity,map(lambda([x], listp(x) and length(x)=2),data))
then out: sort(data)
elseif matrixp(data) and length(data[1]) = 2
then out: sort(args(data))
elseif listp(data) and every('identity,map(lambda([x], not listp(x)),data))
then out: makelist([i,data[i]],i,1,n)
else error("Error in arguments to '",funame,"' function"),
/* controlling duplicated x's */
for i:2 thru n do
if out[i-1][1] = out[i][1]
then error("Duplicated abscissas are not allowed"),
out ),
/*--------------------------------------------------------------------------------*/
tab: interpol_check_input(tab,"linearinterpol"), remfunction(interpol_check_input),
options: ['varname],
defaults: ['x],
for i in select do(
aux: ?position(lhs(i),options),
if numberp(aux) and aux <= length(options) and aux >= 1
then defaults[aux]: rhs(i)),
if not symbolp(defaults[1])
then error("Option 'varname' is not correct"),
/* constructing the interpolating polynomial */
n: length(tab),
if n=2 /* case of two points */
then s: tab[2][2] + (tab[2][2]-tab[1][2]) *
(defaults[1]-tab[2][1]) / (tab[2][1]-tab[1][1])
else for i:2 thru n do(
if i=2
then (a: 'minf, b: tab[i][1], lr:oo)
else if i=n then (a: tab[i-1][1], b: 'inf, lr:co)
else (a: tab[i-1][1], b: tab[i][1], lr:co),
s: s + funmake('on3,[defaults[1], a, b, lr]) *
expand( tab[i][2] + (tab[i][2]-tab[i-1][2]) *
(defaults[1]-tab[i][1]) / (tab[i][1]-tab[i-1][1]) ) ),
s )$ /* end of on3lspline() */
/*--- on3lspline_ex ------------------------------------------------------------*/
on3lspline_ex([args]) := block([progn:"<on3lspline_ex>",debug],
debug:ifargd(),
p:[[7,2],[8,2],[1,5],[3,2],[6,7]], cshow(p),
/* cspline(p);
==> natural cubic spline (second derivatives are zero in both extremes) */
f(x):=on3lspline(p),
map(f,[2.3,5/7,%pi]),
g1:gr2d(
explicit(f(x),x,0,9),
title = concat("cspline: default"), yrange=[0,10],
point_size = 3,
points(p)),
g(x) := on3lspline(p,d1=0,dn=0),
g2:gr2d(
explicit(g(x),x,0,9),
title = concat("cspline: d1=0, dn=0"), yrange=[0,10],
point_size = 3,
points(p)),
grv(g1,g2,dimensions=[1800,2800]),
return()
)$ /* end of on3lspline_ex() */
/*############################################################################*/
/*### funcxyp : F(x,y)=0 の零点リスト LL=[[x1,y1],[x2,y2],...]を返す ############*/
/*############################################################################*/
/* 2変数高次(4次以上)陰関数の描画と関数化を目指す
Fx+Fy*y'=0 -> y'(x) = -Fx/Fy
(Fxx+Fxy*y')+(Fyx+Fyy*y')*y' + Fy*y''=0
-> y''(x) = -{Fxx +(Fxy+Fyx)*y'+Fyy*(y')^2}/Fy
*/
funcxy([args]) := block([progn:"<funcxy>",debug, func,xs,xe,
realonly_old,ratprint_old,plotmode:true,
Fx,Fy,send,ans0,ans,order,ansy,xmid,ymid,xys,xye,xw,yw,wansy,
dis,dmin,dy1,dy2,dy,MR,ML,LL, spline,lend,ys,ye,g0,gall,gxs,gxe,dlist],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of funcxy('help)--
機能: 2変数高次陰関数 F(x,y)=0 の描画と近似関数表現
文法: funcxy(func,xs,xe,...)
例示: funcxy(x^5-2*x^2*y+y^5,-2,2,'plot);
funcxy(x^2+2*x*y+y^3-1,-4,4);
--end of funcxy('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of funcxy('ex)--"),
block([out,strview],
c0show("== 2変数高次陰関数 F(x,y)=0 の描画と近似関数表現==="),
if member('noview, args) then strview:'noview else strview:'view,
out:funcxy(x^5-2*x^2*y+y^5,-2,2,'file_name=sconcat(figs_dir,"/","funcxy-ex1"),strview),
c1show(out),
out:funcxy(x^2+2*x*y+y^3-1,-4,4,'file_name=sconcat(figs_dir,"/","funcxy-ex2"),strview),
c1show(out),
return('normal_return)
), /* end of block */
print("--end of funcxy('ex)--"),
return("--end of funcxy('ex)--"),
block_main, /* main ブロック ====================================*/
if length(args) < 3 then (
c0show(progn, "Erroor; 引数の個数が3未満です"),return("Error")),
func : args[1], xs : args[2], xe : args[3],
c1show(xs,xe),
if member('plot,args) then plotmode:true,
if member('noplot,args) then plotmode:false,
define(F(x,y),func), Fx:diff(F(x,y),x), Fy:diff(F(x,y),y),
realonly_old:realonly, realonly:true,
ratprint_old:ratprint, ratprint:false,
send:10, /* 分点数 */
ans0:algsys([F(x,y),Fy],[x,y]), /* Fy=0 となる(x,y)を求める */
for i thru length(ans0) do ans0[i]:map(rhs,ans0[i]), c2show(ans0),
if length(ans0) > 1 then (
order:msort(ans0,1),
ans:copylist(ans0),
for i thru length(order) do ans[i]:ans0[order[i]], c2show(ans)
) else ans:[],
if length(ans)=0 or xs < ans[1][1] then (
ansy:flatten(algsys([F(xs,y)],[y])),
if length(ansy) > 0 then ans : cons([xs,rhs(ansy[1])], ans)
),
if length(ans)=0 or xe > last(ans)[1] then (
ansy:flatten(algsys([F(xe,y)],[y])),
if length(ansy) > 0 then ans : endcons([xe,rhs(ansy[1])], ans)
),
ans:float(ans),
cshow(ans),
if length(ans)=0 then (cshow("範囲 xs,xe で零点は存在しない"), return([])),
/***********************************************************/
LL:[],
for ll:1 thru length(ans)-1 do (
xmid:(ans[ll][1]+ans[ll+1][1])/2, xys:copylist(ans[ll]), xye:ans[ll+1],
ansy:algsys([F(xmid,y)],[y]), ansy:map(rhs,flatten(ansy)),
/* yに関する多価関数に対応 */
for kk:1 thru length(ansy) do (
ymid:ansy[kk], c1show(xmid,ymid), c1show("===START:",xys,xye,send,MR),
/* xの中間点xmidから右の評価 */
MR:[[xmid,ymid]],
for s in [4,7,8,9,9.5,10] do (
xw: xmid+(xye[1]-xmid)*s/send,
if s=send and floatnump(xye[1]) then xw:xw-1.e-5,
wansy:algsys([F(xw,y)],[y]), wansy:map(rhs,flatten(wansy)), wansy:float(wansy),
dis:copylist(wansy),
for i thru length(wansy) do dis[i]:(last(MR)[2]-wansy[i])^2,
dmin:dis[1],
if length(dis)>1 then for i:2 thru length(dis) do dmin:min(dmin,dis[i]),
c2show(dis,dmin),
for i thru length(dis) do if dis[i]=dmin then yw:wansy[i],
lend:length(MR),
if lend > 2 then (
dy1 : (MR[lend][2]-MR[lend-1][2])/(MR[lend][1]-MR[lend-1][1]),
dy2 : (MR[lend-1][2]-MR[lend-2][2])/(MR[lend-1][1]-MR[lend-2][1]),
dy : dy2/dy1
),
if lend > 2
and ((0.9 < dy and dy < 1.1) or abs(dy1) < 0.1) and s # 10
then c2show("--skip---")
else ( c1show(xw,yw), MR:endcons([xw,yw],MR) )
),
c1show("Right:",MR),
/* xの中間点xmidから左の評価 */
ML:[[xmid,ymid]],
for s in [4,7,8,9,9.5,10] do (
xw: xmid+(xys[1]-xmid)*s/send,
if s=send and floatnump(xys[1]) then xw:xw+1.0e-5,
wansy:algsys([F(xw,y)],[y]),
wansy:map(rhs,flatten(wansy)), wansy:float(wansy),
dis:copylist(wansy),
for i thru length(wansy) do dis[i]:(first(ML)[2]-wansy[i])^2,
dmin:dis[1],
if length(dis)>1 then for i:2 thru length(dis) do dmin:min(dmin,dis[i]),
c2show(dis,dmin),
for i thru length(dis) do if dis[i]=dmin then yw:wansy[i],
lend:length(ML),
if lend > 2 then (
dy1 : (ML[2][2]-ML[1][2])/(ML[2][1]-ML[1][1]),
dy2 : (ML[3][2]-ML[2][2])/(ML[3][1]-ML[2][1]),
dy : dy2/dy1
),
if lend > 2
and ((0.9 < dy and dy < 1.1) or abs(dy1) < 0.1) and s # 10
then c2show("---skip---")
else ( c1show(xw,yw), ML:cons([xw,yw],ML) )
),
c1show("Left:",ML),
LL : endcons( append(ML,rest(MR,1)), LL)
), /* end of for-kk 多価関数 */
c1show(LL)
), /* end of for-ll */
if plotmode then (
ys:inf, ye:minf,
for i thru length(LL) do for j thru length(LL[i]) do
(ys:min(ys,LL[i][j][2]), ye:max(ye,LL[i][j][2])),
dy:max(abs(ys),abs(ye))*0.1, ys:ys-dy, ye:ye+dy,
g0:gr2d(implicit(F(x,y),x,xs,xe,y,ys,ye),
title=concat("Implicit Func."),
grid=true,xrange=[xs,xe]),
gall:sconcat("gr2d(grid=true,point_size=1,xrange=[xs,xe],yrange=[ys,ye]"),
gall:sconcat(gall,",title=\"cspline in funcxy\" "),
spline:makelist(null,i,1,length(LL)),
for kk:1 thru length(LL) do (
spline[kk]:on3cspline(LL[kk]), gxs:LL[kk][1][1], gxe:last(LL[kk])[1],
gall:sconcat(gall,", explicit(",spline[kk],",x,",gxs,",",gxe,
"), points(",LL[kk],")"),
c2show(kk,gall)
),
gall:sconcat(gall,")"), gall : eval_string(gall),
c2show(gall),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","fig/funcxy"),
columns=2, dimensions=[1000,500]],
dlist : mergeL(dlist, args, ['terminal, 'file_name, 'columns, 'dimensions]),
c1show(progn,dlist),
if member('view,args) then mk_draw([g0,gall], dlist, 'view )
else mk_draw([g0,gall], dlist, 'noview )
),
realonly:realonly_old, ratprint:ratprint_old, remfunction(F),
return(LL)
)$ /* end of funcxy() */
/*--- funcxy_ex ----------------------------------------------------------------*/
funcxy_ex([args]) := block([progn:"<funcxy_ex>",debug,out],
debug:ifargd(),
cshow("== 2変数高次陰関数 F(x,y)=0 の描画と近似関数表現==="),
out:funcxy(x^5-2*x^2*y+y^5,-2,2,'plot),
cshow(out),
if true then out:funcxy(x^2+2*x*y+y^3-1,-4,4),
cshow(out)
)$ /* end of funcxy_ex() */
/*########################################################################*/
/*### p2suface : 3次元空間内の3点A,B,Cを通る平面の方程式を求める 2021.07.04 ###*/
/*########################################################################*/
p2surface([args]) := block([progn:"p2surface",debug,A,B,C,AB,AC,v,eq,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* ヘルプブロック */
printf(true,"
--begin of p2furface('help)--
機能: 3次元空間内の3点A,B,Cを通る平面の方程式を求める
文法: p2surface(A,B,C)
例示: (A : [1,1,2], B : [0,-2,1], C : [3,-1,0], p2surface(A,B,C));
--end of p2surface('help')--
"
),
return('normal_return),
block_ex, /* 例ブロック */
print("--begin of p2surface('ex)--"),
block([A,B,C,out],
A : [1,1,2], B : [0,-2,1], C : [3,-1,0],
c0show(A,B,C),
cashow(p2surface(A,B,C)),
return("---end of p2surface_ex---")
), /* end of block */
return("--end of p2surface_ex--"),
/* p2surface_ex(), */
/* block_main */
block_main, /* メインブロック */
c1show(progn,length(args)),
if length(args) < 3
then (c0show("引数の個数が3未満のため終了する"), return("---Error---")),
if (listp(args[1])=false) or (length(args[1]) # 3)
then (c0show("第1引数が3次元ベクトルでないため終了する"), return("---Error---")),
A : args[1], B : args[2], C : args[3],
cross( u, v ):= [ u[2]*v[3] - u[3]*v[2],
u[3]*v[1] - u[1]*v[3],
u[1]*v[2] - u[2]*v[1] ],
AB : B-A,
AC : C-A,
v : cross(AB,AC),
eq : v[1]*(x-A[1]) + v[2]*(y-A[2]) + v[3]*(z-A[3]) = 0,
eq : expand(eq),
return(eq)
)$
/*########################################################################*/
/*### slit : 1辺 a の立方体 ABCD-EFGH と平面 KLM の交線の描画 2021.08.24 ###*/
/*########################################################################*/
slit([args]) := block([progn:"slit",debug,x,y,z,K,L,M,a:6,gview:[60,30],
A,B,C,D,E,F,G,H,N,O,R,S,T, s0,s1,s2,s3,s4,s5,s6,s,sc,
ans0,lh,rh,rhstr,ifind,rhchg,v,vranges,vrng,pscmd,gcmd,g0,
vnoend,varl,on3f,on3ineq,on3ineq_OutL,acnode,FL,va,vsing,LL,V,outsum],
debug:ifargd(),
/*** common ***/
/* a : 立方体 ABCD-EFGH の1辺の長さ */
A : [0,0,a], B : [a,0,a], C : [a,a,a], D : [0,a,a],
E : [0,0,0], F : [a,0,0], G : [a,a,0], H : [0,a,0],
K : (A+D)/2, L : (A+B)/2, M : (B+F)/2, N : (A+E)/2,
O : (A+G)/2,
R : (F+G)/2, S : (G+H)/2, T : (D+H)/2,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* ヘルプブロック */
printf(true,"
--begin of slit('help)--
機能: 1辺 a の立方体 ABCD-EFGH と平面 KLM の交線の描画(点K,L,M は K=[kx,ky,kz]のように指定可)
文法: slit(), slit('gview=[60,30],'view), slit(a=10,M=G,'gview=[60,120],'view)
例示: slit(a=10,M=G,'gview=[60,120],'view);
--end of slit('help')--
"
),
return('normal_return),
block_ex, /* 例ブロック */
print("--begin of slit('ex)--"),
block([g0,g1],
c0show("上面: ",A,B,C,D),
c0show("下面: ",E,F,G,H),
c0show("切り口面:",K,L,M),
g0 : slit('gview=[60,30]),
g1 : slit('gview=[60,120]),
mk_draw([g0,g1],
['file_name=sconcat(figs_dir,"/","fig-slit"),
'columns=2, 'dimensions=[1000,500]],
'view),
return("return slit_ex")
), /* end of block */
return("--end of slit_ex()--"),
/* block_main */
block_main, /* メインブロック */
cshow(progn,args),
if length(args) > 0 then for i:1 thru length(args) do (
if lhs(args[i]) = 'gview then (
gview : rhs(args[i]),
c1show(i,args[i], rhs(args[i]), gview)
)
else if lhs(args[i]) = 'a then (
a : rhs(args[i]), c1show(a),
A : [0,0,a], B : [a,0,a], C : [a,a,a], D : [0,a,a],
E : [0,0,0], F : [a,0,0], G : [a,a,0], H : [0,a,0],
K : (A+D)/2, L : (A+B)/2, M : (B+F)/2, N : (A+E)/2,
c1show(a),c1show(A,B,C,D),c1show(E,F,G,H),
c1show(K,L,M)
)
else if lhs(args[i]) = 'K then (
K : ev(rhs(args[i])), c1show(K)
)
else if lhs(args[i]) = 'L then (
L : ev(rhs(args[i])), c1show(L)
)
else if lhs(args[i]) = 'M then (
M : ev(rhs(args[i])), c1show(M)
)
),
/* 1辺 a の立方体 ABCD-EFGH と平面 KLM の交線の描画 */
s0 : p2surface(K,L,M), /* 点K,L,M の平面方程式 */
s1 : p2surface(A,B,E), /* 点A,B,E の平面方程式 */
s2 : p2surface(B,C,F),
s3 : p2surface(C,D,G),
s4 : p2surface(D,A,H),
s5 : p2surface(A,B,C),
s6 : p2surface(E,F,G),
pscmd : "", sc :0,
for s in [s1,s2,s3,s4,s5,s6] do (
sc : sc + 1,
c0show(sc,"◆ 2つの平面方程式から交線方程式を求める: ",s0,s),
/* Example -------------------------------------------------------
s0 = 9*z+9*y+9*x-81 = 0 s = 36*y = 0
lh = [x,y,z] , rh = [9-%r1,0,%r1] , ifind = 3 , rhchg = [9-z,0,z] , v = [z]
progn = <on3ineq> , outsum = on3(z,3,9,cc)
vranges = parametric_surface(9-z, 0, z, z,3,6, y,0,6 )
-------------------------------------------------------------------*/
ans0 : solve([s0,s],[x,y,z]), /* 交線 */
ans0 : flatten(ans0),
lh : map(lhs,ans0), rh : map(rhs,ans0), rhstr : map(string,rh),
c1show(lh, rh, rhstr),
ifind : 0,
for i:1 thru 3 do (
c1show(i,slength(rhstr[i]), ssearch("%r",rhstr[i])),
if ( slength(rhstr[i])<=4 ) and ( ssearch("%r",rhstr[i])=1 ) then ifind : i
), /* end of for-i */
c1show(rhstr, ifind),
rhchg : ratsubst(lh[ifind],rh[ifind],rh),
v : listofvars(rhchg),
c1show(lh,rh, ifind, rhchg, v),
/*== 得られた交線方程式から作画関数 parametric_surface() を作成する ==*/
/* parametric_surface(x-fun,y-fun,z-fun, v1,v1l,v1r, v2,v2l,v2r) */
vranges : sconcat("parametric_surface(",
rhchg[1],", ",rhchg[2],", ",rhchg[3]),
for i:1 thru 3 do (
c1show(i,freeof(v[1], rhchg[i]),atom(rhchg[i])),
if (freeof(v[1], rhchg[i])=true) and (atom(rhchg[i])=true) then
vranges : sconcat(vranges,", ", lh[i], ",", 0, ",", a, " ")
else if (freeof(v[1], rhchg[i])=false) and (atom(rhchg[i])=false)
then (
c1show("---ineq---",i,rhchg),
vrng : on3ineq([rhchg[i],0,a,cc],'resultonly,'noview)*on3(v[1],0,a,cc),
c1show(vrng),
vrng : on3simp(vrng),
vrng : f2l(vrng),
c1show(vrng),
vranges : sconcat(vranges, ", ",
vrng[2], ",", vrng[3], ",", vrng[4])
) , c1show(i,vranges)
), /* end of for-i */
vranges : sconcat(vranges,")"),
cashow(vranges),
pscmd : sconcat(pscmd," ",vranges,", "),
if false then quit()
), /* end of for-s */
c1show(pscmd), c1show(gview),
gcmd : sconcat("gr3d(axis_3d=false, proportional_axes=\'xyz, view=",gview,",",
"enhanced3d=false, palette=gray,",
"title= \"view by slit ",gview, "\",",
"point_type=filled_circle,point_size=1.4,points_joined=true,color=blue,",
"points([A,B,C,D,A]),",
"points([E,F,G,H,E]),",
"points([A,E]), points([B,F]), points([C,G]), points([D,H]),",
"label([\"A\",A[1],A[2],A[3]+a/10]), label([\"B\",B[1],B[2],B[3]+a/10]),",
"label([\"C\",C[1],C[2],C[3]+a/10]), label([\"D\",D[1],D[2],D[3]+a/10]),",
"label([\"E\",E[1],E[2],E[3]-a/10]), label([\"F\",F[1],F[2],F[3]-a/10]),",
"label([\"G\",G[1],G[2],G[3]-a/10]), label([\"H\",H[1],H[2],H[3]-a/10]),",
"label([\"K\",K[1],K[2],K[3]+a/10]), label([\"L\",L[1],L[2]-a/10,L[3]]),",
"label([\"M\",M[1]+a/10,M[2],M[3]]),",
"color=red, line_width=1.5,",
pscmd, /* parametric_surface() の挿入 */
"xrange=[0-a/10,a+a/10], yrange=[0-a/10,a+a/10], zrange=[0-a/10,a+a/10] )"
), /* end of sconcat() */
c1show(gcmd),
/* gcmd の評価と描画 */
g0 : eval_string(gcmd),
if member('view, args) then (
mk_draw([g0],
['file_name=sconcat(figs_dir,"/","fig-slit"),
'columns=1, 'dimensions=[600,500]],
'view)
),
return(g0)
)$ /* end of slit() */
/*#############################################################################*/
/* end of on3lib20all.mx */
/*#############################################################################*/
on3lib20all.mx の内容
cat ~/Maxlib-20/on3lib20all.mx
/* on3lib20all.mx 2020.05.21 (by INOUE Takakatsu) */
/*### --- fsplit: on3env.mx --- ###########################################*/
/*### on3env : on3ライブラリーの環境設定 2020.05.21 ###*/
/*#########################################################################*/
on3env([args]) ::= block([progn:"<on3env>",outmsg],
/* Maxima 作業用ディレクトリの設定 */
USER : "inoue", HOME : "/home/inoue", ENV : sconcat(HOME,"/.env/tmp_dirsL"),
cmd : sconcat("/home/",USER,"/","bin/tmpdirs2env resetmaxima"),
system(cmd),
tmpdirsL : read_list(ENV),
tmp_dir : tmpdirsL[1], tmp_maxima_dir : tmpdirsL[2], tmp_user_dir : tmpdirsL[3],
tmp_lang_dir : tmpdirsL[4], figs_dir : tmpdirsL[5],
maxima_tempdir : tmp_maxima_dir,
/* on3lib20 関連の規則の追加 */
if true then ( on3rules() ),
if false then batchload("/home/inoue/Maxlib-20/on3ineq20lib.mx"),
/* 環境 */
if true then (
display2d:false,
linel:90,
radexpand:true,
/* domain:complex$ m1pbranch:true$ */
fpprintprec:8,
alias(ineqex, on3ineq_ex),
kill(labels),
print("-- ", progn," logbegin --")
),
outmsg : sconcat("-- on3 library Env Set : tmp_dir, on3rules, global vars --"),
return(outmsg)
)$
/*#########################################################################*/
/*### on3lib : on3ライブラリーのロードと環境設定 2020.05.21 ###*/
/*#########################################################################*/
on3lib([args]) ::= block([outmsg],
if false then print(args),
clear_rules(),
if false then (
init_str : "/home/inoue/.maxima/max-init.mac",
kill(allbut(init_str,args)),
batchload(init_str)
),
if length(args)=0 then (
batchload("/home/inoue/Maxlib-20/on3lib20all.mx"),
on3env(), /* Maxiima 作業用ディレクトリの設定と規則の設定 */
outmsg : sconcat("-- batchload: ",
"--- ~/Maxlib-20/on3lib20all.mx and on3env() ---")
),
if length(args)>0 and member(args[1],[21]) then (
batchload("/home/inoue/Maxlib-20/on3lib21.mx"),
on3env(), /* Maxiima 作業用ディレクトリの設定と規則の設定 */
outmsg : sconcat("-- batchload: ",
"--- ~/Maxlib-20/on3lib21.mx and on3env() ---")
),
if length(args)>0 and member(args[1],[20]) then (
batchload("/home/inoue/Maxlib-20/on3lib20all.mx"),
on3env(), /* Maxiima 作業用ディレクトリの設定と規則の設定 */
outmsg : sconcat("-- batchload: ",
"--- ~/Maxlib-20/on3lib20all.mx and on3env() ---")
),
if (length(args)>0) and member(args[1],[19]) then (
batchload("/home/inoue/Maxlib-20/on3lib19.mx"),
batchload("/home/inoue/Maxlib-20/on3ineq19lib.mx"),
outmsg : sconcat("-- batchload: ",
"~/Maxlib-20/on3lib19.mx,~/Maxlib-20/on3ineq19lib.mx ---")
),
if (length(args)>0) and member(args[1],[17]) then (
batchload("/home/inoue/Maxlib-11/on3lib.mx"),
batchload("/home/inoue/Maxlib-11/on3ineq17lib.mx"),
outmsg : sconcat("-- batchload: ",
"~/Maxlib-11/on3lib.mx,~/Maxlib-11/on3ineq17lib.mx ---")
),
print(outmsg),
return(outmsg)
)$
/*#########################################################################*/
/*### max_save : Maxima 状態の保存と復元 2020.05.21 ###*/
/*#########################################################################*/
max_save([args]) ::= block([max_save_file:"/tmp/max_save.lisp",cmd],
cmd : sconcat("save(\"",max_save_file,"\", all)"),
print(cmd),
eval_string(cmd)
)$
/*#########################################################################*/
/*### max_restore : Maxima の復元 2020.05.21 ###*/
/*#########################################################################*/
max_restore([args]) ::= block([max_save_file:"/tmp/max_save.lisp"],
load(max_save_file),
on3env(), /* 作業用ディレクトリの設定, on3環境設定 */
return("-- restored and on3env() ---")
)$
/*### --- fsplit: on3-head.mx --- #######################################*/
/* [ on3lib.mx ] Ver. 1.9 (by Takakatsu INOUE) */
/* (2007-06-27, 2007-09-14, 2007-12-11, 2008-02-29, 2009-03-29(改訂) */
/*######################################################################*/
/*--- 関数の参照関係
on3 --- f2l
on3simp --- (on3rule2, on3rule5), on3rngm
on3decomp --- on3decomp_inv, on3decomp_decomp, on3decomp_reduce,
on3decomp_decomp --- on3lrl, on3rule5, on3simp
on3std --- on3std_sub, on3typep, on3lrl
on3ev --- on3typep, on3std
on3diff --- on3typep, on3lrl, on3decomp, on3show
on3integ --- on3typep, on3lrl, on3std, on3decomp, on3show
on3chgvar2 --- on3std, f2l, l2f
on3show --- on3show_sub, on3typep
on3pw
* f2l, l2f, ifargd, cshow, d1show, d2show, d3show --- 全般的に使用
注： on2で始まるシンボル名，シンボル cc,co,oc,oo,eval は予約語とする．
----------------------------------------------------------------------*/
/*#########################################################################*/
/* ### funcs : ユーザ定義の関数名,マクロ名のリストの文字列化とソート,検索,等の処理 ###*/
/*#########################################################################*/
funcs([args]) := block([progn:"<funcs>",debug, sortmode:true, str,strL,out],
debug : ifargd(),
if length(args) = 0 then go(block_main),
if length(args) > 0 and args[1]='help then go(block_help),
if length(args) > 0 and args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of funcs('help)--
機能: ユーザ定義の関数名,マクロ名のリストの文字列化とソート,検索,等の処理
文法: funcs({'help,'ex,'sort,'str},...)
例示: funcs() : functions, macros のソート済リストを返す
funcs('nosort) : functions, macros のリスト(未ソート)を返す
funcs('show) : functions, macros から文字列 show を含む要素を返す
funcs('help) : 本関数のヘルプを標示
funcs('ex) : 例を実行
--end of funcs('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of funcs('ex)--"),
/* funcs_ex(), */
block([str],
str : "funcs('show)",
c0show(ev(str)),
return('normal_return)
), /* end of block */
print("--end of funcs('ex)--"),
return("--end of funcs('ex)--"),
block_main, /* main ブロック ====================================*/
/* 注: functions, macros : Maxima 予約リスト */
/* 標準:ソート */
c1show(args),
if (length(args) = 0) or (args[1]='nosort) then (
if length(args)>0 and args[1] = 'nosort then sortmode : false,
for listname in ['functions, 'macros] do (
strL : ev(listname),
c1show(listname,strL),
if sortmode and length(strL) > 0 then
for i:1 thru length(strL) do strL[i] : string(strL[i]),
if sortmode then out : sort(strL) else out : strL,
print(" ==ユーザ定義の関数名,マクロ名一覧: ",listname,", sortmode=",sortmode,"=="),
print(out)
),
return("--end of funcs--")
),
if length(args) = 1 and args[1] # 'nosort then str : args[1],
/* 検索文字列を含む関数名,マクロ名の表示 */
str : args[1],
print(" ==文字列",str,"を含むユーザ定義の関数名,マクロ名の検索結果=="),
declare(str,noun), str : string(str),
print(progn,"search string =",str),
chk(a) := if ssearch(str, string(a)) > 0 then true, /* sublist の判定関数 */
for listname in ['functions, 'macros] do (
out : sublist(ev(listname), chk), /* 判定関数chk()がTRUEのサブリストを返す */
out : sort(out),
print(progn,listname,"-->",out)
),
return("--end of funcs--")
)$ /* end of funcs */
/*========== on3ライブラリの関数一覧 2009.03.20 (T.INOUE) ====================
on3help: on3ヘルプ関数
on3simp: (主に内部使用): on3(z,a,b,cc) 関数の積に関する簡約化
on3rngm: 2つの区間の共通区間を与える (簡約化2 で使用する)
on3: on3 関数の定義 (区間で異なる関数)
f2l_one: 式から得られる第１層のリスト表現を返す
f2l: 式から得られる完全リスト表現を返す --- f2l_ex
l2f_one: 完全リスト表現から式表現処理を1回だけ行う
l2f: 完全リスト表現から式表現処理を行った結果を返す --- l2f_ex
on3vars: 完全リストからon3関数変数を取り出す --- on3vars_ex
ex:[+,[*,f1,[on3,x,1,2,co]],[on3,y,3,4,co]], on3vars(ex) ---> [x,y]
ex:f1*on3(x,1,2,co)+on(y,3,4,co), on3vars(ex) ---> [x,y]
on3lrl: 完全リストからon3関数端点リストを取り出す --- on3lrl_ex
f0+f1*on3(x,1,2,co) ---> [[x],[[minf,1,2,inf]],[true]]
f0+f1*on3(x,1,2,co)*on3(y,3,4,co)
---> [[x,y],[[minf,1,2,inf],[minf,3,4,inf]],[true,true]]
on3typep: 式からon3式タイプを調べ結果を返す
on3std: 式からon3標準型(排他的分解の出来ない状況での可)表現を返す --- on3std_ex
on3std_sub: (内部使用) 標準化リスト表現を返す
on3ev: on3多項式の各項の関数部を{factor,expand,ratsimp}した表現を返す
on3termsep: 項 f*on3(x..)*on3(y,.) から on3(x,.) を分離した表現を返す
--- on3termsep_ex
on3decomp_reduce: (内部使用) : 同一関数部をもつ領域の簡素化(合併)
on3decomp_decomp: (内部使用) : on3多項式の排他分解処理
on3decomp_inv: (内部使用) : on3多項式の逆数の処理
on3decomp: on3一般式の排他的分解処理全般 --- on3decomp_ex
on3show_sub on3show内部使用副関数
on3show: on3関数式の表示 --- on3show_ex
on3diff : on3 関数の微分(多変数関数の1変数に関するp階偏微分) --- on3diff_ex
on3integ : on3 関数の積分(多変数関数の1重不定積分関数/定積分を返す)
--- on3integ_ex
on3solve: on3 関数方程式の求解 (多変数対応版)
on3chgvar2: on3関数式f(x,y)を変換(t=x+y,u=y)した関数g(t,u)を返す
on3dim2_uni2: 一様分布の和の分布
on3dim2_exp2: 指数分布の和の分布
cshow: チェック用表示関数
d1show: デバック用表示関数(debug >= 1 のときに表示する)
d2show: デバック用表示関数(debug >= 2 のときに表示する)
d3show: デバック用表示関数(debug >= 3 のときに表示する)
ifargd: 親関数引数にdebug1,debug2,debug3があれば debug:1,2,3 を返す --- debug_ex
on3pw: on3関数式のカプセル化
on3ftrue: 式にon3関数が含まれていればTRUEを返す --- on3frue_ex
lpup: リストの指定要素を取り出す --- lpup_ex
L:[+,[*,f1,[on3,x,3,4,co]],[on3,x,1,2,co]], lpup(L,[2,2]) ---> f1
loffuncs: 式に含まれる演算子(関数を含む)からなるリストを返す --- loffuncs_ex
=============================================================================*/
/*----------------------------------------------------------------------*/
load("eval_string")$ /*** on3lrj (lrリストの結合) で使用 for 5.11 ***/
load("stringproc")$ /*** on3help で使用 ***/
gradef(on3(x,a,b,rc),0,0,0,0)$
/* on3ftrue(funcs)
::= buildq([u:funcs], integerp(ssearch("on3",string(u))) )$ */
/*### --- fsplit: on3help.mx --- ########################################*/
/* <on3help> : ヘルプ */
/*######################################################################*/
on3help() := block([],
printf(true,"~%
=== on3lib.mx (定義域を伴った関数の数式操作) 一覧 ===~%
0. on3help() : on3関数の機能一覧 ~%
1. on3(z,z0,z1,arg) : on3関数(関数定義域)の定義[変数，下限，上限，開閉]~%
2. f2l(on3funcs) : on3関数式をon3リスト形式に変換する[多変数対応版]~%
3. l2f(on3list) : on3リスト形式をon3関数形式に変換する[多変数対応版]~%
4. on3simp(on3funcs) : on3関数式の積に関する簡約化(on3decompに組み込み) ~%
5. on3decomp(funcs,[args]) : [多変数対応版]
on3関数式の和(差)において素な区間(領域)への分解表現を与える~%
6. on3std(on3func) : on3一般式の標準化 ~%
7. on3ev(on3func,arg) : 関数部に{factor,ratsimp,expand}を作用する~%
8. on3solve(funcs,vars) : on3関数式の求解[多変数対応版]~%
9. on3diff(func,var,p) : on3関数式の微分[多変数対応版]~%
10. on3integ(func,var,[args]) : on3関数式の積分[多変数対応版]
on3integ(func,var) : 不定積分関数(分布関数に対応)
on3integ(func,var,x0,x1) : 定積分値 ~%
11. on3chgvar2(funcs) : on3関数式f(x,y)を変換(t=x+y,u=y)した関数g(t,u)を返す~%
12. on3show(funcs) : on3関数式の表示[多変数対応版] ~%
13. on3pw(funcs) : on3関数式のカプセル化 ~%
ex. on3_ex(), on3simp_ex(), on3std_ex(),
on3decomp_ex(), on3show_ex(), on3ev_ex(),
on3diff_ex(), on3integ_ex(), on3solve_ex(),
on3chgvar2_ex() on3pw_ex(),
ex. on3dim2_uni2() : 一様分布に従う独立確率変数の和の分布
on3dim2_exp2() : 指数分布に従う独立確率変数の和の分布
ex. on3test() : on3_ex, on3list_ex, on3simp_ex, on3decomp_ex の連続実行~%
---> 関数表示 dispfun(on3,on3simp,...) または grind(on3)
"),
return("--- end of on3help ---")
)$
/*#########################################################################*/
/*### on3rules : 規則 2020.05.21 ###*/
/*#########################################################################*/
on3rules([args]) ::= block([progn:"<on3rules>"],
clear_rules(),
/*** on3 ライブラリーの冒頭で定義し，常駐させれば機能する ***/
declare([oo,oc,co,cc],constant),
declare([plot,noplot,view,noview],constant),
declare([debug1,debug2,debug3],constant),
/*** 自動簡約化 (Maxima内部簡約化の前に評価される) ***/
matchdeclare([on3z,on3a,on3b,on3cc],true,on3k,integerp),
tellsimp((on3(on3z,on3a,on3b,on3cc))^on3k, on3(on3z,on3a,on3b,on3cc)),
/*** add 2019.04.13 ****/
tellsimp('diff(on3(on3z,on3a,on3b,on3cc),on3z), 0),
tellsimp('integrate(on3(on3z,on3a,on3b,on3cc),on3z),
on3(on3z,on3a,on3b,on3cc)),
/* memo 2020.07.18 ----------------------------------------------------
diff(on3(x,1,3,co),x) -> 0
diff(x^2*on3(x,1,3,co),x) -> 2*x*on3(x,1,3,co) ok
integrate(on3(x,1,3,co),x) -> on3(x,1,3,co)
integrate(2*x*on3(x,1,3,co),x)
-> 'integrate(2*x*on3(x,1,3,co),x) x
telsimp に *(積)は使えない
--------------------------------------------------------------------- */
/*** add end ***/
/*** 簡約化2：on3(z,a,b,cc) * on3(z,c,d,cc) ---> on3(z,E,F,cc) ***/
matchdeclare(on3,true, on32z,true,
[on32a,on32b,on32lr1,on32c,on32d,on32lr2],true),
let([on3(on32z,on32a,on32b,on32lr1) * on3(on32z,on32c,on32d,on32lr2),
on3rngm_new([on3, on32z,on32a,on32b,on32lr1],
[on3, on32z,on32c,on32d,on32lr2])],on3rule2),
/** on3rngm(rng1,rng2) : 2つの区間の共通区間を与える(簡約化2で使用) **/
/*** 簡約化5：on3(z,a,b,cc) * on3(z,minf,inf,oo) ---> on3(z,a,b,cc) ***/
matchdeclare([on35a,on35b],true,[on35c,on35d],constantp,
on35z,true,on35lr1,true, on35lr2,true),
let([on3(on35z,on35a,on35b,on35lr1) * on3(on35z,on35c,on35d,on35lr2),
on3rngone([on35z,on35a,on35b,on35lr1],
[on35z,on35c,on35d,on35lr2])],on3rule5),
/* --- 参照 on3rngm_new(on3(x,a,b,co),on3(x,c,d,co)) --- */
/*** ev評価関数として組み込む ***/
declare(on3decomp,evfun),
declare(on3std,evfun)
)$ /* end of on3rules */
/*#########################################################################*/
/** on3rngone(rng1,rng2):on3(x,a,b,co)*on3(x,minf,inf,oo)の処理(簡約化5で使用) **/
/*#########################################################################*/
on3rngone(rng1,rng2) := block([out],
if rng1[2]=minf and rng1[3]=inf and rng1[1]=rng2[1]
then out:funmake(on3,rng2)
else if rng2[2]=minf and rng2[3]=inf and rng1[1]=rng2[1]
then out:funmake(on3,rng1)
else out:funmake(on3,rng1) * funmake(on3,rng2),
return(out)
)$
/*#########################################################################*/
/* on3rngm_new : 同一変数に関するon3()関数の積の簡約化を試み,簡約化ができない場合は無処理とする */
/*#########################################################################*/
/*** memo ************************************************************
[a] on3 関数の加(減)法演算のメモ
cases of f*on3(a,b) + g*on3(c,d) where (a < b, and c < d)
v1 : max(a,c), v2 : (b,d)
1: ---a-[f]-b--[0]--c-[g]-d--- : [0,0] v1=c & v2=b & v1 > v2
2: ---a-[f]-c-[f+g]-b-[g]-d--- : [c,b] v1=c & v2=b & v1 <= v2
3: ---a-[f]-c-[f+g]-d-[f]-b--- : [c,d] v1=c & v2=d
4: ---c-[g]-a-[f+g]-b-[g]-d--- : [a,b] v1=a & v2=b
5: ---c-[g]-a-[f+g]-d-[f]-b--- : [a,d] v1=a & v2=d & v1 <= v2
6: ---c-[g]-d--[0]--a-[f]-b--- : [0,0] v1=a & v2=d & v1 > v2
***************************************************************************/
/*### on3rngm_new ##########################################################*/
/* 同一変数に関するon3()関数の積の簡約化を試み,簡約化ができない場合は無処理とする
on3(x,a,b,lr1)*on3(x,c,d,lr2) (a<=b,c<=d) -> on3(x,vl,vr,vlr)
--a--c--b--d-- (a<=c, c<=b, b<=d)のとき on3(x,c,b,vlr), vlr=[lr2l,lr1r]
--a--c--d--b-- (a<=c, c<=d, d<b)のとき on3(x,c,d,vlr), vlr=[lr2l,lr2r]
--c--a--b--d-- (c<a, a<=b, b<=d)のとき on3(x,a,b,vlr), vlr=[lr1l,lr1r]
--c--a--d--b-- (c<a, a<=d, d<b)のとき on3(x,a,d,vlr), vlr=[lr1l,lr2r]
otherwise のときは無処理で on3(x,a,b,lr1)*on3(x,c,d,lr2) を返す
用途:
matchdeclare([on3v,on3a,on3b,on3lr1,on3c,on3d,on3lr2],true),
tellsimp(on3(on3v,on3a,on3b,on3lr1)*on3(on3v,on3c,on3d,on3lr2),
on3on3(on3(on3v,on3a,on3b,on3lr1),on3(on3v,on3c,on3d,on3lr2)) )
*/
on3rngm_new([args]) := block([progn:"<on3rngm_new>",debug,
on3L1,on3L2,
L1,L2,L12, v1,a,b,lr1, v2,c,d,lr2, l1,r1, l2,r2, chg, out0, out1, out],
/* 永久ループの問題<<注意>> : ------------------------------------------
on3rngm_new() はtellsimpの記述に基づいて呼び出される.
on3rngm_new 内に on3()*on3() と行った文があると,またtellsimpの対象として
on3rngm_newが呼び出され永久ループとなる.
tellsimp から letsimp に変更
--------------------------------------------------------------------- */
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3rngm_new('help)--
機能: 同一変数に関するon3()関数の積の簡約化を試み,
簡約化ができない場合は無処理とする
文法: on3rngm_new(on3L1,on3L2) or on3rngm_new(on3func1,on3func2)
例示: on3rngm_new([on3,x,a,a+2,cc],[on3,x,a+1,a+5,oc]) -> on3(x,a+1,a+2,oc)
--end of on3rngm_new('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3rngm_new('ex)--"),
on3rngm_new_ex1(),
on3rngm_new_ex2(),
print("--end of on3rngm_new('ex)--"),
return("--end of on3rngm_new('ex)--"),
block_main, /* main ブロック ====================================*/
if length(args) >= 2 then (
if listp(args[1]) then on3L1:copylist(args[1]) else on3L1:f2l(args[1]),
if listp(args[2]) then on3L2:copylist(args[2]) else on3L2:f2l(args[2])
) else return("引数の個数が2未満"),
c1show(on3L1,on3L2),
/* local(v1,a,b,lr1, v2,c,d,lr2, l1,r1,l2,r2,out), */
L1 : on3L1, v1:L1[2], a:L1[3], b:L1[4], lr1:L1[5],
L2 : on3L2, v2:L2[2], c:L2[3], d:L2[4], lr2:L2[5],
c1show(L1,L2),
c1show(v1,a,b,lr1,v2,c,d,lr2),
/* ベキ等性 */
if L1 = L2 then return(l2f(L1)),
/* on3(v,minf,inf,oo) がある場合 */
if a=minf and b=inf and lr1=oo then return(l2f(L2)),
if c=minf and d=inf and lr2=oo then return(l2f(L1)),
/* lr1 lr2 から端点a,b,c,dの開閉を取り出す */
l1:"o", r1:"o", l2:"o", r2:"o",
if lr1=cc or lr1=co then l1:"c", if lr1=oc or lr1=cc then r1:"c",
if lr2=cc or lr2=co then l2:"c", if lr2=oc or lr2=cc then r2:"c",
c2show(lr1,"->",l1,r1,lr2,"->",l2,r2),
/* 第1引数が区間端点に一致する場合 on3(a,a,b,c?)=1 else 0 */
chg:false,
if v1=a then (chg:true, if l1="c" then L1:1 else L1:0),
if v1=b then (chg:true, if r1="c" then L1:1 else L1:0),
if v2=c then (chg:true, if l2="c" then L2:1 else L2:0),
if v2=d then (chg:true, if r2="c" then L2:1 else L2:0),
if chg then return(l2f(L1)*l2f(L2)),
c1show(progn,"--enter---"),
out0 : l2f(L1)*l2f(L2), /* 以下の処理前のon3()*on3()の内容 */
c1show(out0),
L12 : ["*",1,L1,L2], /* 無処理のとき返す内容(on3の積にしないこと) */
out : l2f(ratsubst(ON3,on3,L12)), /* on3rule2 の永久ループ回避処理 */
c1show(L12,out),
/* v1=v2 の確認 */
if v1 # v2 then return(out0) else v:v1,
if is(a>b)=true then (
cshow(progn,"区間指定 a <= b の例外を検出した!"),
cshow(" -> ",a,b), return("Error")),
if is(c>d)=true then (
cshow(progn,"区間指定 c <= d の例外を検出した!"),
cshow(" -> ",c,d), return("Error")),
if is(a<=b) = unknown then (
assume(a <= b), c1show(facts(a)),
print(" ++ 仮定: assume : ",a," <= ",b, " を追加し,処理を続行する ++") ),
if is(c<=d) = unknown then (
assume(c <= d), c1show(facts(c)),
print(" ++ 仮定: assume : ",c, " <= ",d," を追加し,処理を続行する ++") ),
if a<=c and c<=b and b<=d then
( lr:eval_string(sconcat(l2,r1)), out : l2f([on3,v,c,b,lr]) )
else if a<=c and c<=d and d<b then
( lr:eval_string(sconcat(l2,r2)), out : l2f([on3,v,c,d,lr]) )
else if c<a and a<=b and b<=d then
( lr:eval_string(sconcat(l1,r1)), out : l2f([on3,v,a,b,lr]) )
else if c<a and a<=d and d<b then
( lr:eval_string(sconcat(l1,r2)), out : l2f([on3,v,a,d,lr]) ),
if b<c or d<a then out : 0,
c1show(out0), out1:l2f(out), c1show("-->",out1),
/* assume() で設定した仮定,変数の表示と解除 */
c1show("設定された仮定:",properties(a)),c1show(facts(a),facts(c)),
forget(facts(a)), forget(facts(b)), forget(facts(c)), forget(facts(d)),
kill(a,b,c,d), /* 仮定,変数の解除 */
c1show("設定された仮定及び変数の削除(forget,kill)確認: ",
facts(a),facts(b),facts(c),facts(d)),
return(out)
)$ /* end of on3rngm_new() */
/*## on3rngm_new_ex1 ####################################################*/
on3rngm_new_ex1([args]) := block([progn:"<on3rngm_new_ex1>",debug],
debug:ifargd(),
c0show(on3rngm_new([on3,x,a,a+2,cc],[on3,x,a+1,a+5,oc])),
c0show(on3rngm_new(on3(x,a,a+2,cc),on3(x,a+1,a+5,oc)))
)$ /* end of on3rngm_new_ex */
/*### on3rngm_new_ex2 #####################################################*/
on3rngm_new_ex2([args]) := block([progn:"<on3rngm_new_ex2>",debug,a,b,c,d],
debug:ifargd(),
/* local(a,b,c,d), */
cshow(progn,"--enter--"),
/* 永久ループの問題<<注意>> : ------------------------------------------
on3rngm_new() はtellsimpの記述に基づいて呼び出される.
on3rngm_new 内に on3()*on3() と行った文があると,またtellsimpの対象として
on3rngm_newが呼び出され永久ループとなる.
tellsimp から letsimp に変更
--------------------------------------------------------------------- */
c1show(values),
c0show("--- begin of ex1 ---"),
ex1 : "on3(x,a,a+2,cc)*on3(x,a+1,a+5,oc)",
ans1 : "on3(x,a+1,a+2,oc)",
out : eval_string(ex1),
out : letsimp(out,on3rule2), /* on3rule2 の適用*/
out : ON3on3(out), /* ratsubst(on3,ON3,out), */ /* on3rule2 の後始末*/
c0show(ex1,"-->",out, ans1),
c0show("--- begin of ex2 ---"),
ex2 : "on3(x,a,b,cc)*on3(x,a-1,b+1,cc)",
ans2 : "on3(x,a,b,cc)",
out : eval_string(ex2),
out : letsimp(out,on3rule2), /* on3rule2 の適用*/
out : ON3on3(out), /* on3rule2 の後始末*/
c0show(ex2,"-->",out, ans2),
c0show("--- begin of ex3 ---"),
ex3 : "on3(x,a,b,cc)*on3(x,b+1,d,cc)",
ans3 : "0",
out : eval_string(ex3),
out : letsimp(out,on3rule2), /* on3rule2 の適用*/
out : ON3on3(out), /* on3rule2 の後始末*/
c0show(ex3,"-->",out, ans3),
if true then (
c0show("--- begin of ex4 ---"),
ex4 : "on3(x,a,b,cc)*on3(x,a+3,a-2,cc)",
ans4 : "実行停止",
out : eval_string(ex4),
c0show(ex4,"-->",out, ans4)
)
)$ /* end of on3on3_ex2 */
/*### --- fsplit: on3simp.mx --- #######################################*/
/* <on3simp> : on3(z,a,b,cc) 関数の積に関する簡約化 */
/*######################################################################*/
on3simp([args]) := block([progn:"<on3simp>",debug,on3funcm,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
/* block_main */
block_main, /* main ブロック ========================================*/
on3funcm : args[1],
out : ev(on3funcm),
d1show(out),
/*** 簡約化2：on3(z,a,b,cc) * on3(z,c,d,cc) ---> on3(z,E,F,cc) ***/
out : letsimp(out,on3rule2),
out : ON3on3(out), /* on3rule2 の後始末*/
d1show(out),
out : expand(out),
return(out),
block_help, /* help ブロック =======================================*/
printf(true,"
--begin of on3simp('help)--
機能: on3(z,zl,zr,lr) 関数の積に関する簡約化(簡約化規則 on3rule2 を使用する)
文法: on3simp(on3()の積)
例示: on3simp(x * on3(x,0,3,co) * on3(x,0,3,co))
--end of on3simp('help')--
"
),
return('normal_return),
block_ex, /* example ブロック =======================================*/
print("--begin of on3simp('ex)--"),
block([progn:"<on3simp('ex)>",debug,
x,ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8,ex0,ex0f,Lex,ex,out,a,out2],
debug:ifargd(),
ex1 : ["x * on3(x,0,3,co) * on3(x,0,3,co)", "x*on3(x,0,3,co)"],
ex2 : ["x^3 * on3(x,0,3,co) / (x * on3(x,0,3,co))", "x^2*on3(x,0,3,co)"],
ex3 : ["x* on3(x,minf,3,co) * x^2 * on3(x,2,4,co)", "x^3*on3(x,2,3,co)"],
ex4 : ["x^3 * on3(x,0,3,co) / (x*on3(x,1,5,co))", "x^2*on3(x,1,3,co)"],
ex5 : ["x* on3(x,1,3,co) * x^3 * on3(x,2,4,co) * x * on3(x,2,5,co)",
"x^5*on3(x,2,3,co)"],
ex6 : ["(f1*on3(x,1,5,co) + f2*on3(x,2,8,co)) * on3(x,3,10,co)",
"f1*on3(x,3,5,co) + f2*on3(x,3,8,co)"],
ex7 : ["1/(f1*on3(x,1,5,co) + f2*on3(x,2,8,co)) * on3(x,3,10,co)",
"on3(x,3,10,co)/(f2*on3(x,2,8,co)+f1*on3(x,1,5,co))", "on3show"],
/* f1*on3(x,1,5,co) + f2*on3(x,2,8,co)
= f1*on3(x,1,2,co) + (f1+f2)*on3(x,2,5,co) + f2*on3(x,5,8,co)
与式 = 1/(f1+f2)*on3(x,3,5,co) + 1/f2*on3(x,5,8,co)
参考: on3decomp(1/(f1*on3(x,1,5,co) + f2*on3(x,2,8,co)) * on3(x,3,10,co));
*/
ex8 : ["(f1*on3(x,1,5,co) + f2*on3(x,2,8,co))*on3(x,minf,inf,oo)",
"f1*on3(x,1,5,co) + f2*on3(x,2,8,co)"],
ex0 : ["x^3 * on3(x,0,3,co) / (x*on3(x,a,3,co))",
"x^2*on3(x,0,3,co)*on3(x,a,3,co)"],
Lex : [ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8],
print(" 例．on3関数の積/商の簡約化"),
for ex in Lex do (
exchk("on3simp",[ex])
),
print(" 例0．on3関数の積(評価不能の場合と置数後の評価)"),
ex0 : "x^3 * on3(x,0,3,co) / (x*on3(x,a,3,co))",
ex0f : sconcat("on3simp(",ex0,")"),
cshow(a, ex0, ex0f),
out : eval_string(ex0f),
ldisplay(out),
a : 2,
cshow(a),
out2 : eval_string(ex0f),
ldisplay(a,out2),
return("---end of block---")
), /* end of block */
/* on3simp_ex(), */
print("--end of on3simp('ex)--"),
return("--end of on3simp('ex)--")
)$ /* end of on3simp */
icerror:0$
/*### --- fsplit: on3.mx --- #########################################*/
/* <on3> : on3 関数の定義 (区間で異なる関数) */
/*######################################################################*/
on3([args]) := block([progn:"<on3>",debug,z,zl,zr,lr, l, r, chkl,chkr,
as0, out, evalmode:false, listmode:false, debugmode:false, solvetype:solve,
L2, t,wt,atom,ans1,ans2,LV,vl,vmid,vr,wl,wmid,wr,chkcomplex,on3sum],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
if length(args) >= 4 then go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--on3('help)--
機能: 変数zが不等式 zl <= z < zr (lc=co) のとき1を返しそのたのとき0を返す
文法: on3(z,zl,zr,lr,...) lrは開(o)閉(c)を表す. 追加引数としてlist,evalが可能
例示:
on3(z,zl,zr,co); 変数zが不等式 zl <= z < zr のとき1を返しそのたのとき0を返す
on3(0,1,3,co); -> 0 on3(1,1,3co) -> 1 on3(3,1,3,co) -> 0
on3(2,1,3,co); -> 1
on3(x,1,3,co); -> on3(x,1,3,co) 判定不能の場合は定義式を返す
on3(a,a-1,a+3,co); -> 1
on3(x^2,1,4,co,list); -> [on3,x^2,1,4,co] (リスト形式に変換)
on3(log(x),1,2,cc,eval); -> on3(x,%e,%e^2,cc) (evalによる評価変換)
メモ: findstr('on3) -> on3 を含む関数名一覧を標示する
--end of on3('help)--
"
),
return("end of on3('help)"),
block_ex, /* example ブロック ===================================*/
block([progn:"<on3_ex>",debug,exansL],
exansL : [["基本動作"],
["on3(0,1,3,co)","0"],
["on3(1,1,3,co)","1"],
["on3(3,1,3,co)","0"],
["on3(x,1,3,co)","on3(x,1,3,co)"],
["on3(3,1,b,co)","on3(3,1,b,co)"],
["on3(x,minf,inf,oo)","on3(x,minf,inf,oo)",
" <- ( = 1 であるが,on3decomp()の仕様のため無処理とする)"],
["inf/minf の取扱"],
["on3(inf,1,inf,co)","1"],
["on3(inf+1,1,inf,co)","0"],
["変数式の取扱"],
["on3(a,a-1,a+3,co)","1"],
["on3(a+3,a-1,a+3,co)","0"],
["on3(t-u,t-u,(-u)+t+3,co)","1"],
["on3((-u)+t+3,t-u,(-u)+t+3,co)","0"],
["on3()関数のリスト変換,eval評価"],
["on3(x^2,1,4,co,list)","[on3,x^2,1,4,co]"],
["on3(x^2,1,4,co,eval)","on3(x,1,2,co)+on3(x,-2,-1,oc)"],
["on3(log(x),1,2,cc,eval)","on3(x,%e,%e^2,cc)"],
["on3(sin(x),1/2,1,cc,eval)","on3(x,%pi/6,%pi/2,cc)"],
["on3(sin(2*x+%pi/4),1/2,1,oo,eval)","on3(x,-%pi/24,%pi/8,oo)"]
],
print(" === on3('ex) : on3 関数の使用例 ==="),
exchk("",exansL),
return("---end of on3('ex) ---")
), /* end of block */
return('normal_end),
block_main, /* main ブロック ====================================*/
z : args[1], zl : args[2], zr : args[3], lr : args[4],
if false then (
/* 暗黙仮定を考慮したon3()の評価 */
if (numberp(zl)=false) or (numberp(zr)=false) then (
out : funmake(on3, [z,zl,zr,lr]),
if lr=cc then (
as0 : assume(zl<=zr), c1show(progn,"暗黙仮定:",as0,facts(zl)),
if is(z >= zl) and is(z <= zr) then out:1
else if is(z < zl) or is(z > zr) then out:0,
forget(as0)
),
if lr=co then (
as0 : assume(zl < zr), c1show(progn,"暗黙仮定:",as0,facts(zl)),
if is(z >= zl) and is(z < zr) then out:1
else if is(z < zl) or is(z >= zr) then out:0,
forget(as0)
),
if lr=oc then (
as0 : assume(zl < zr), c1show(progn,"暗黙仮定:",as0,facts(zl)),
if is(z > zl) and is(z <= zr) then out:1
else if is(z <= zl) or is(z > zr) then out:0,
forget(as0)
),
if lr=oo then (
as0 : assume(zl < zr), c1show(progn,"暗黙仮定:",as0,facts(zl)),
if is(z > zl) and is(z < zr) then out:1
else if is(z <= zl) or is(z >= zr) then out:0,
forget(as0)
),
c1show(progn,out),
return(out)
) /* end of implicit asumption */
),
/*** モード検査 ***/
if member(list,args) then listmode:true,
if member(eval,args) then evalmode:true,
if member(realroots,args) then solvetype:realroots,
if member(debug,args) then debugmode:true ,
/* add beig 2019.05.24
on3(z,f1(z),f2(z),co) 等では f1(z) > f2(z) となる場合がある
*/
if true then ( /* zl>zr のとき zl < z < zr となる z は存在しないので 0 を返す */
if is(zl>zr)=true then return(0)
),
if false then (
if is(zl>zr)=true then
(icerror:icerror+1,
if icerror < 6 then (
print("◆◆ on3(z,zl,zr,lr):区間指定例外zl>zrを検出した. ◆◆"),
cshow(progn,z,zl,zr),
return(0))
)),
if zl=inf and zr=inf then return(0),
/*
if freeof(inf, zl)=false then return(0), /* 2020.05.28 add */
if (freeof(inf,z)=false) and (freeof(inf,zr)=false) then return(0),
if freeof(minf,zr)=false then return(0), /* 2020.05.28 add */
if (freeof(minf,z)=false) and (freeof(minf,zl)=false) then return(0),
*/
if zl=minf and zr=minf then return(0),
if zl=zr and member(lr,[co,oc,oo]) then return(0), /* 追加 2019.09.17 */
/* if realp(z) and zl=minf and zr=inf then return(1), 再考*/
/* if z=minf and zl=minf then return(1), */
/* if zl=zr and z=zl then (if lr=cc then return(1) else return(0)), */
c2show(progn,"point-1"),
/* lr から端点a,b,c,dの開閉を取り出す */
l:"o", r:"o",
if lr=cc or lr=co then l:"c", if lr=oc or lr=cc then r:"c",
c2show(lr,"->",l,r),
/* 第1引数が区間端点に一致する場合 on3(a,a,b,c?)=1 else 0 */
if z=zl then (if l="c" then return(1) else return(0)),
if z=zr then (if r="c" then return(1) else return(0)),
c2show(progn,"point-2"),
/* 非数値評価が可能な場合 on3(a, a-1, a+2, co)*/
if l="c" then chkl:is(zl<=z) else chkl:is(zl<z),
if r="c" then chkr:is(z<=zr) else chkr:is(z<zr),
if (zl # minf) and (zr # inf) then
if chkl=true and chkr=true then return(1), /* 再考 */
/* add beig 2019.04.29 */
c2show(progn,"point-3"),
/*** 基本処理 ***/
/* cc : close-close, co : close-open, oc : open-close, oo : open-open */
if constantp(z) and constantp(zl) and constantp(zr) then
( if lr = cc then out : charfun(zl <= z and z <= zr)
else if lr = co then out : charfun(zl <= z and z < zr)
else if lr = oc then out : charfun(zl < z and z <= zr)
else if lr = oo then out : charfun(zl < z and z < zr)
)
else out : funmake(on3, [z,zl,zr,lr]), /*定義式を返す*/
if evalmode=false and listmode=false then return(out), /* 基本戻り口 */
/*** 追加処理 1 : list ####################################***/
if constantp(out)=false and listmode=true and evalmode=false then
return([on3, z, zl, zr, lr]),
/*** 追加処理 2 : eval ####################################***/
if constantp(out)=false and evalmode=true then (
atom : listofvars(z)[1], define(t(atom), z),
if atom = z then return(out),
if solvetype=solve then
(solvetrigwarn:false,
ans1 : solve([z=zl],[atom]), ans2 : solve([z=zr],[atom]),
solvetrigwarn:true,
chkcomplex:false,
for i thru length(ans1) do
if featurep(rhs(ans1[i]),real)=false then chkcomplex:true,
for i thru length(ans2) do
if featurep(rhs(ans2[i]),real)=false then chkcomplex:true,
if chkcomplex then
(mshow(chkcomplex),
ans1 : realroots(z = zl), ans2 : realroots(z = zr))
)
else if solvetype=realroots then
(ans1 : realroots(z = zl), ans2 : realroots(z = zr)),
d1show(atom,ans1,ans2),
L2 : [z, zl, zr, lr],
LV : [],
for j thru length(ans1) do LV : endcons(rhs(ans1[j]),LV),
for j thru length(ans2) do LV : endcons(rhs(ans2[j]),LV),
LV : sort(LV,"<"),
d1show(LV),
/*** 同値リスト値を切り詰める ***/
LV : unique(LV),
if first(LV) # minf then LV : cons(minf,LV),
if last(LV) # inf then LV : endcons(inf,LV),
if freeof(log,z)=false then LV[1] : 0.1^10,
if freeof(sin,z)=false then (LV[1] : -%pi/2, LV[length(LV)]:%pi/2),
if freeof(cos,z)=false then (LV[1] : 0, LV[length(LV)]:%pi),
block([i], i : 0, loop, i : i+1,
if LV[i] = LV[i+1] then
(LV : delete(LV[i+1],LV,1), i : i-1,
d1show(LV,length(LV))),
if i < length(LV)-1 then go(loop)
),
d1show(LV),
on3sum :0,
wt(atom) := block([ans], if errcatch(t(atom), return) = []
then ans:0 else ans:t(atom), return(ans)),
for j:1 thru length(LV)-1 do (
vl : LV[j], vr : LV[j+1], vmid : (LV[j]+LV[j+1])/2,
d1show(wt(vl),wt(vmid),wt(vr)),
wl : on3(wt(vl),L2[2],L2[3],L2[4]),
wmid : on3(wt(vmid),L2[2],L2[3],L2[4]),
wr : on3(wt(vr),L2[2],L2[3],L2[4]),
d1show(vl,vmid,vr,wl,wmid,wr),
if wmid = 1 then
(if wl=0 and wr=0 then lr:oo
else if wl=0 and wr=1 then (if vr # inf then lr:oc else lr:oo)
else if wl=1 and wr=0 then (if vl # minf then lr:co else lr:oo)
else if wl=1 and wr=1 then
(if vl # minf and vr # inf then lr:cc
else if vl # minf then lr:co
else if vr # inf then lr:oc
else lr:oo),
on3sum : on3sum + funmake(on3,[atom,vl,vr,lr])
)
), /* loop-end j */
d1show(on3sum),
if listmode=true then return(f2l(on3sum)) else return(on3sum)
), kill(t,wt) /* 追加処理 2 : eval の終了***/
)$ /* end of on3() */
/* ### 2021.01.30 ####################################################### */
/* 未定定数 a, b をもつ 関数 on3(x,a,b,lr) における暗黙仮定
on3関数 : 定義不等式 : 暗黙仮定
on3(x,a,b,cc) : a <= x <= b : a <= b
on3(x,a,b,co) : a <= x < b : a < b
on3(x,a,b,oc) : a < x <= b : a < b
on3(x,a,b,oo) : a < x < b : a < b
*/
on3x([args]) := block([progn:"<on3x>",debug,z,zl,zr,lr, as0, out],
debug:ifargd(),
z : args[1], zl : args[2], zr : args[3], lr : args[4],
c1show(progn,z,zl,zr,lr),
/* 仮定を考慮したon3()の評価 */
out : funmake(on3, [z,zl,zr,lr]),
if lr=cc then (
as0 : assume(zl<=zr), cshow(progn,facts(zl)),
if is(z >= zl) and is(z <= zr) then out:1
else if is(z < zl) or is(z > zr) then out:0,
forget(as0)
),
if lr=co then (
as0 : assume(zl < zr), cshow(progn,facts(zl)),
if is(z >= zl) and is(z < zr) then out:1
else if is(z < zl) or is(z >= zr) then out:0,
forget(as0)
),
if lr=oc then (
as0 : assume(zl < zr), cshow(progn,facts(zl)),
if is(z > zl) and is(z <= zr) then out:1
else if is(z <= zl) or is(z > zr) then out:0,
forget(as0)
),
if lr=oo then (
as0 : assume(zl < zr), cshow(progn,facts(zl)),
if is(z > zl) and is(z < zr) then out:1
else if is(z <= zl) or is(z >= zr) then out:0,
forget(as0)
),
c1show(progn,out),
return(out)
)$
/* ##################################################################### */
/*### fsplit: on3ex.mx ##################################################*/
/*--- on3ex ----------------------------------------------------*/
/*#######################################################################*/
on3ex([args]) := block([progn:"<on3ex>",debug],
debug:ifargd(),
d2show("---1変数---"),
ex11 : f0,
ex12 : on3(x,1,2,co),
ex13 : -on3(x,1,2,co),
ex14 : f0+on3(x,1,2,co),
ex15 : f0-f1*on3(x,1,2,co),
ex16 : f0+f1*f2*on3(x,1,2,co),
ex17 : f0+f1*log(x)*on3(x,1,2,co),
ex18 : f1*on3(x,3,5,co) + f1*on3(x,5,7,co),
ex19 : f1*on3(x,1,3,co)+f2*on3(x,2,5,co)+f3*on3(x,0,inf,co),
ex1a : f0*on3(x,3,5,co) + 1/(f1*on3(x,1,5,co)+f2*on3(x,3,7,co)),
ex1b : f0 + 1/(f1*on3(x,1,5,co)
+ f2*on3(x,3,7,co)/(f21*on3(x,1,3,co)+f22*on3(x,3,5,co))
),
ex1c : x^2*on3(x,minf,0,oo)+(1-x^2)/2*on3(x,0,1,oo)+(1-x)*on3(x,1,inf,oo)+sin(x),
ex1d : x^2*on3(x,minf,0,oo)+(1-x^2)/2*on3(x,0,1,oo)+(1-x)*on3(x,1,inf,oo)+myfunc(x),
ex1e : x^2*on3(x,0,1,co) + %e^(1-x)*on3(x,1,inf,co),
ex1r1 : f1*on3(x,a,b,co),
ex1r2 : f1*on3(x,a,b,co) + f2*on3(x,c,d,co),
ex1f1 : f1(x)*on3(x,1,2,co),
ex1f2 : f1(x)*on3(x,1,3,co) + f2(x)*on3(x,2,4,co),
ex1d1 : f1(x)*on3(x,a,b,co),
ex1d2 : f1(x)*on3(x,a,b,co) + f2(x)*on3(x,c,d,co),
ex1m1 : x * on3(x,0,3,co) * on3(x,0,3,co),
ex1m2 : x^2 * on3(x,0,3,co) / (x * on3(x,0,3,co)),
ex1m3 : x* on3(x,minf,3,co) * x^2 * on3(x,2,4,co),
ex1m4 : x^2 * on3(x,0,3,co) / (x*on3(x,1,3,co)),
ex1m5 : x* on3(x,1,3,co) * x^2 * on3(x,2,4,co) * x * on3(x,2,3,co),
ex1m6 : (f1*on3(x,1,5,co) + f2*on3(x,2,8,co))*on3(x,3,10,co),
ex1m7 : 1/(f1*on3(x,1,5,co) + f2*on3(x,2,8,co))*on3(x,3,10,co),
ex1m8 : (f1*on3(x,1,5,co) + f2*on3(x,2,8,co))*on3(x,minf,inf,oo),
ex1m0 : x^2 * on3(x,0,3,co) / (x*on3(x,a,3,co)),
d2show("---2変数---"),
ex21 : on3(x,1,2,co)*on3(y,3,4,co),
ex21 : f0+on3(x,1,2,co)*on3(y,3,4,co),
ex22 : f0+f1*on3(x,1,2,co)*on3(y,3,4,co),
ex23 : f0+f1*f2*on3(x,1,2,co)*on3(y,3,4,co),
ex24 : f0+f1*log(x)*on3(x,1,2,co)*on3(y,3,4,co),
ex25 : f0+f1*on3(x,1,2,co)*on3(y,3,4,co)+f2,
ex26 : f1*on3(x,3,5,co)*on3(y,2,4,co) + f1*on3(x,5,7,co)*on3(y,2,4,co),
ex27 : f1*on3(x,1,2,co)*on3(y,3,4,co)+f0*on3(y,5,6,co),
ex28 : f1*on3(x,3,7,co)*on3(y,4,8,co)+f2*on3(x,1,5,co)*on3(y,2,6,co),
ex2a : (x+y+5)*(on3(x,2,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)
+ on3(x,-2,2,co)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc)
+ on3(x,-2,2,co)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc)
+ on3(x,-3,-2,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)),
ex2b : (r*cos(t)+r*sin(t)+5)*r*on3(r,2,3,cc)*on3(t,0,2*%pi,cc),
ex2c : f1*on3(x,1,2,co)*on3(y,3,4,co) + f2*on3(x,1,2,co)*on3(y,3,4,co),
ex2d : f1*on3(x,1,2,co)*on3(y,3,5,co) + f2*on3(x,1,2,co)*on3(y,4,6,co),
ex2e : 1/ex2d,
d2show("---3変数---"),
ex31 : on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co),
ex32 : f1*on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co) + f2*on3(y,3,4,co)*on3(z,5,6,co),
Lex1 : [ex11,ex12,ex13,ex14,ex15,ex16,ex17,ex18,ex19,ex1a,ex1b,ex1c,ex1d,ex1e,
ex1r1,ex1r2,ex1f1,ex1f2,ex1d1,ex1d2],
Lex2 : [ex21,ex22,ex23,ex24,ex25,ex26,ex27,ex28,ex2a,ex2b,ex2c,ex2d,ex2e],
Lex3 : [ex31,ex32],
Lexm : [ex1m1,ex1m2,ex1m3,ex1m4,ex1m5,ex1m6,ex1m7,ex1m8],
Lex : flatten([Lex1,Lex2,Lex3]),
/*** 上記 ex?? は ??_ex() 内で on3ex(), を実行することで呼び出せる ***/
if length(args) > 0 and not member(args[1],[debug1,ddebug2,debug3])
then ldisplay(args[1]),
return("---on3ex: 例を設定した---")
)$
/*--- fsplit: on3f2l.mx ------------------------------------------------*/
/*######################################################################*/
/* <f2l_one>: 式から得られる第１層のリスト表現を返す */
/*######################################################################*/
f2l_one([args]) := block([progn:"<f2l_one>",debug,exp,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of f2l_one('help)--
機能: 式から得られる第１層のリスト表現を返す
文法: f2l_one(exp,...)
例示: f2l_one(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",f1*on3(x,1,3,co),f0]
参照: f2l(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",[\"*\",f1*log(x),[on3,x,1,2,co]],f0]
--end of f2l_one('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of f2l_one('ex)--"),
block([progn:"<f2l_one_ex>", ex1, ex2, ex, L:[], out, chk],
print("---begin of f2l_one_ex---"),
on3ex(), /* call example */
L : copylist(Lex1),
/* start */
for ex in L do
( print("--例--"),
out:f2l_one(ex),
ldisplay(ex),
print(" out : f2l_one(ex) --->"),
ldisplay(out),
chk : if ex = l2f(out) then chk:true else chk:false,
if chk = false then print(" chk : l2f(out) is not equal to ex")
),
return("--- end of f2l_one_ex---")
), /* end of block */
print("--end of f2l_one('ex)--"),
return("--end of f2l_one('ex)--"),
block_main, /* main ブロック ====================================*/
if listp(args[1])=true then return(args[1]),
exp : args[1], out : exp,
if atom(exp) = false then out:cons(op(exp),args(exp)),
return(out)
)$ /* end of f2l_one() */
/*######################################################################*/
/* <f2l_full>: 式から得られる完全リスト表現を返す 2020.02.22 */
/*######################################################################*/
f2l_full([args]) := block([progn:"<f2l_full>",debug,exp,fp,on3p:[],out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of f2l_full('help)--
機能: 関数(式)表現を数学関数,on3(),ON3()を含めて完全にリスト表現に変換する
文法: f2l_full(exp,...)
例示: ex : f1*log(x)*ON3(x,1,2,co)+f0;
ratsubst(on3,ON3,ex);
-> f1*log(x)*ON3(x,1,2,co)+f0 変更できない
L : f2l_full(ex);
-> [\"+\",[\"*\",f1,[log,x],[ON3,x,1,2,co]],f0]
LW : ratsubst(on3,ON3,L);
-> [\"+\",[\"*\",f1,[log,x],[on3,x,1,2,co]],f0]
l2f(LW);
-> f1*log(x)*on3(x,1,2,co)+f0
メモ: f2l(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",[\"*\",f1*log(x),[on3,x,1,2,co]],f0]
f2l_one(exp) は式から第１層のリスト表現を返す
f2l_one(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",f1*log(x)*on3(x,1,2,co),f0]
--end of f2l_full('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of f2l_full('ex)--"),
block([progn:"<f2l_full_ex>", ex1, ex2, ex, L:[], out, chk],
print("---begin of f2l_full_ex---"),
on3ex(), /* call example */
L : copylist(Lex1),
/* start */
for ex in L do
( print("--例--"),
out:f2l_full(ex),
ldisplay(ex),
print(" out : f2l(ex) --->"),
ldisplay(out),
chk : if ex = l2f(out) then chk:true else chk:false,
if chk = false then print(" chk : l2f_full(out) is not equal to ex")
),
return("--- end of f2l_full_ex---")
), /* end of block */
print("--end of f2l_full('ex)--"),
return("--end of f2l_full('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
d1show("S0:入力関数:",exp),
/* 式表現から完全リストを作成する */
out: scanmap(lambda([u], if atom(u)=false
then u:cons(op(u),args(u)) else u), exp),
d1show("S1:完全リスト:",out),
return(out)
)$ /* end of f2l_full() */
/*############################################################################*/
/*### ON3on3 #########2020.02.20 ### ON3() -> on3() */
/*############################################################################*/
ON3on3([args]) := block([progn:"ON3on3>",debug,wL,out],
debug:ifargd(),
if listp(args[1]) then wL:args[1] else wL : f2l_full(args[1]),
c1show(progn,"pre-wl",wL),
wL : scanmap(lambda([u],
if listp(u) and u[1]=ON3 then (
u[1] : on3, u) else u), wL),
c1show(progn,"after-WL",wL),
out : l2f(wL),
c1show(progn,out),
return(out)
)$ /* end of ON3on3() */
/*######################################################################*/
/* <f2l>: 式から得られる完全リスト表現(on3,ON3関数は除く)を返す 2020.02.22 */
/*######################################################################*/
f2l([args]) := block([progn:"<f2l>",debug,exp,fp,on3p:[],out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of f2l('help)--
機能: 関数(式)表現をリスト表現に変換する
文法: f2l(exp,...)
例示: f2l(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",[\"*\",f1*log(x),[on3,x,1,2,co]],f0]
メモ: f2l_one(exp) は式から第１層のリスト表現を返す
f2l_one(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",f1*log(x)*on3(x,1,2,co),f0]
--end of f2l('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of f2l('ex)--"),
block([progn:"<f2l_ex>", ex1, ex2, ex, L:[], out, chk],
print("---begin of f2l_ex---"),
on3ex(), /* call example */
L : copylist(Lex1),
/* start */
for ex in L do
( print("--例--"),
out:f2l(ex),
ldisplay(ex),
print(" out : f2l(ex) --->"),
ldisplay(out),
chk : if ex = l2f(out) then chk:true else chk:false,
if chk = false then print(" chk : l2f(out) is not equal to ex")
),
return("--- end of f2l_ex---")
), /* end of block */
print("--end of f2l('ex)--"),
return("--end of f2l('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
d1show("S0:入力関数:",exp),
/* 式表現から完全リストを作成する */
out: scanmap(lambda([u], if atom(u)=false
then u:cons(op(u),args(u)) else u), exp),
d1show("S1:完全リスト:",out),
/* 完全リストからon3演算子を含まない項(部分リスト)を関数化する */
out : scanmap(lambda([u],if listp(u)
and not (member(on3,flatten(u)) or member(ON3,flatten(u)))
then apply(u[1], rest(u,1)) else u ),out,bottomup),
d1show("S2:非on3部分リストの関数化:",out),
/* 積分離 [*,f1,f2,on3,f3] ---> [*,f1*f2*f3,on3] */
out: scanmap(lambda([u],
if listp(u) and u[1]="*" and length(u)>2
and (member(on3,flatten(u)) or member(ON3,flatten(u)))
and not member("+",flatten(u))
and not member("-",flatten(u))
and not member("/",flatten(u)) then
(fp:1, on3p:[], d2show(u),
for i:2 thru length(u) do (
d2show("in * :",u,i,u[i],listp(u[i])),
if listp(u[i]) and member(u[i][1],[on3,ON3])
then (d2show(u[i],u[i][1]), on3p:endcons(u[i],on3p))
else fp:fp*u[i],
d2show(i,fp,on3p)
) /* end of for-i */ ,
/* u: ["*", fp,on3p], d2show(fp,on3p), u */
u:["*",fp], u:append(u,on3p), u
) /* end of then */
else u
),out),
d1show("S3:on3部を含む積の簡素化:",out),
/* 除法 [/, a, b] ---> [*, 1/b, a] */
out : scanmap(lambda([u],
if listp(u) and u[1]="/"
and (not listp(u[3]) or not member(on3,flatten(u[3])) )
then u : ["*",1/u[3], u[2]] else u
),out),
d1show("S4:除法の簡素化:",out),
/* 減法 [-,[*,f1,f2]] ---> [*,-f1,f2], [-,[on3,...]] ---> [*,-1,[on3,...]] */
out : scanmap(lambda([u], if listp(u) and u[1]="-" and listp(u[2])
then (if u[2][1]="*" then (u[2][2]:-1*u[2][2], u[2])
else if u[2][1]=on3 then u:["*",-1,u[2]] else u ) else u
),out),
d1show("S5:減法の簡素化:", out),
/* 複合 [*,f1,[*,f2,on3,...]] ---> [*,f1*f2,on3,...] */
out : scanmap(lambda([u],
if listp(u) and u[1]="*"
and listp(u[3]) and u[3][1]="*"
and (not listp(u[3][2]) or not member(on3,flatten(u[3][2])) )
then (u[3][2] : u[2]*u[3][2], u[3]) else u
),out),
/* 変更 ["+",["*",f,[on3,x,1,2,co]],[on3,x,3,4,co]]
-> ["+",["*",f,[on3,x,1,2,co]],["*",1,[on3,x,3,4,co]]] */
if listp(out) and out[1]="+" and length(out)>1 then
for i:2 thru length(out) do (
c1show("check;", i,out[i]),
if listp(out[i]) and out[i][1]='on3
then ( out[i]:["*",1,out[i]], d1show(i,out[i]) )
),
d1show("S6:複合簡素化:",out),
d1show("return f2l:",out),
return(out)
)$ /* end of f2l() */
/*######################################################################*/
/* <f2l_old>: 式から得られる完全リスト表現を返す */
/*######################################################################*/
f2l_old([args]) := block([progn:"_old<f2l>",debug,exp,fp,on3p:[],out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of f2l('help)--
機能: 関数(式)表現をリスト表現に変換する
文法: f2l(exp,...)
例示: f2l(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",[\"*\",f1*log(x),[on3,x,1,2,co]],f0]
メモ: f2l_one(exp) は式から第１層のリスト表現を返す
f2l_one(f1*log(x)*on3(x,1,2,co)+f0)
-> [\"+\",f1*log(x)*on3(x,1,2,co),f0]
--end of f2l('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of f2l('ex)--"),
block([progn:"<f2l_ex>", ex1, ex2, ex, L:[], out, chk],
print("---begin of f2l_ex---"),
on3ex(), /* call example */
L : copylist(Lex1),
/* start */
for ex in L do
( print("--例--"),
out:f2l(ex),
ldisplay(ex),
print(" out : f2l(ex) --->"),
ldisplay(out),
chk : if ex = l2f(out) then chk:true else chk:false,
if chk = false then print(" chk : l2f(out) is not equal to ex")
),
return("--- end of f2l_ex---")
), /* end of block */
print("--end of f2l('ex)--"),
return("--end of f2l('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
d1show("S0:入力関数:",exp),
/* 式表現から完全リストを作成する */
out: scanmap(lambda([u], if atom(u)=false
then u:cons(op(u),args(u)) else u), exp),
d1show("S1:完全リスト:",out),
/* 完全リストからon3演算子を含まない項(部分リスト)を関数化する */
out : scanmap(lambda([u],if listp(u) and not member(on3,flatten(u))
then apply(u[1], rest(u,1)) else u ),out,bottomup),
d1show("S2:非on3部分リストの関数化:",out),
/* 積分離 [*,f1,f2,on3,f3] ---> [*,f1*f2*f3,on3] */
out: scanmap(lambda([u],
if listp(u) and u[1]="*" and length(u)>2
and member(on3,flatten(u))
and not member("+",flatten(u))
and not member("-",flatten(u))
and not member("/",flatten(u)) then
(fp:1, on3p:[], d2show(u),
for i:2 thru length(u) do (
d2show("in * :",u,i,u[i],listp(u[i])),
if listp(u[i]) and u[i][1]=on3
then (d2show(u[i],u[i][1]), on3p:endcons(u[i],on3p))
else fp:fp*u[i],
d2show(i,fp,on3p)
) /* end of for-i */ ,
/* u: ["*", fp,on3p], d2show(fp,on3p), u */
u:["*",fp], u:append(u,on3p), u
) /* end of then */
else u
),out),
d1show("S3:on3部を含む積の簡素化:",out),
/* 除法 [/, a, b] ---> [*, 1/b, a] */
out : scanmap(lambda([u],
if listp(u) and u[1]="/"
and (not listp(u[3]) or not member(on3,flatten(u[3])) )
then u : ["*",1/u[3], u[2]] else u
),out),
d1show("S4:除法の簡素化:",out),
/* 減法 [-,[*,f1,f2]] ---> [*,-f1,f2], [-,[on3,...]] ---> [*,-1,[on3,...]] */
out : scanmap(lambda([u], if listp(u) and u[1]="-" and listp(u[2])
then (if u[2][1]="*" then (u[2][2]:-1*u[2][2], u[2])
else if u[2][1]=on3 then u:["*",-1,u[2]] else u ) else u
),out),
d1show("S5:減法の簡素化:", out),
/* 複合 [*,f1,[*,f2,on3,...]] ---> [*,f1*f2,on3,...] */
out : scanmap(lambda([u],
if listp(u) and u[1]="*"
and listp(u[3]) and u[3][1]="*"
and (not listp(u[3][2]) or not member(on3,flatten(u[3][2])) )
then (u[3][2] : u[2]*u[3][2], u[3]) else u
),out),
/* 変更 ["+",["*",f,[on3,x,1,2,co]],[on3,x,3,4,co]]
-> ["+",["*",f,[on3,x,1,2,co]],["*",1,[on3,x,3,4,co]]] */
if listp(out) and out[1]="+" and length(out)>1 then
for i:2 thru length(out) do (
c1show("check;", i,out[i]),
if listp(out[i]) and out[i][1]='on3
then ( out[i]:["*",1,out[i]], d1show(i,out[i]) )
),
d1show("S6:複合簡素化:",out),
d1show("return f2l:",out),
return(out)
)$ /* end of f2l() */
/*######################################################################*/
/* <l2f_one>: 完全リスト表現から式表現処理を1回だけ行う */
/*######################################################################*/
l2f_one([args]) := block([progn:"<l2f_one>",debug,u,L],
debug:ifarg(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of l2f('help)--
機能: 完全リスト表現から式表現処理を1回だけ行う
文法: l2f_one(L,...)
例示: L : [\"+\",[\"*\",f1,[on3,x,3,4,co]],[on3,x,1,2,co]],
l2f(L) -> f1*on3(x,3,4,co)+on3(x,1,2,co)
メモ: l2f(L) は f2l(exp) の逆操作
--end of l2f('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of l2f_one('ex)--"),
block([progn:"<l2f_one_ex>",L0,L1,L2,L,f1,f2,x],
L0 : [on3,x,1,3,co],
L1 : ["+",["*",f1,[on3,x,3,4,co]],[on3,x,1,2,co]],
L2: ["+", ["*", f1, [on3, x, 3, 4, co]], [on3, x, 1, 2, co]],
for L in [L0] do ( c0show(L), c0show(l2f_one(L)) ),
return("--- end of l2f_one ---")
), /* end of block */
print("--end of l2f_one('ex)--"),
return("--end of l2f_one('ex)--"),
block_main, /* main ブロック ====================================*/
if listp(args[1]) then L:args[1] else return(args[1]),
u : L,
if listp(u) then apply(first(u),rest(u,1)) else u
)$ /* end of l2f_one() */
/*######################################################################*/
/* <l2f>: 完全リスト表現から式表現処理を行った結果を返す */
/*######################################################################*/
l2f([args]) := block([progn:"<l2f>",debug,Lw,out],
debug:ifarg(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of l2f('help)--
機能: リスト表現から関数(式)表現に変換する
文法: l2f(L,...)
例示: L : [\"+\",[\"*\",f1,[on3,x,3,4,co]],[on3,x,1,2,co]],
l2f(L) -> f1*on3(x,3,4,co)+on3(x,1,2,co)
メモ: l2f(L) は f2l(exp) の逆操作
--end of l2f('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of l2f('ex)--"),
block([progn:"<l2f_ex>",L1,L2,L,f1,f2,x],
L1 : ["+",["*",f1,[on3,x,3,4,co]],[on3,x,1,2,co]],
L2: ["+", ["*", f1, [on3, x, 3, 4, co]], [on3, x, 1, 2, co]],
for L in [L1,L2] do ( c0show(L), c0show(l2f(L)) ),
return("--- end of l2f ---")
), /* end of block */
print("--end of l2f('ex)--"),
return("--end of l2f('ex)--"),
block_main, /* main ブロック ====================================*/
if listp(args[1]) then Lw : args[1] else return(args[1]),
out:scanmap(lambda([u], if listp(u) then apply(first(u),rest(u,1)) else u),
Lw,bottomup),
return(out)
)$ /* end of l2f() */
/*--- fsplit: on3vars.mx -----------------------------------------------*/
/*######################################################################*/
/* <on3vars>: 完全リストからon3関数変数を取り出す
ex:[+,[*,f1,[on3,x,1,2,co]],[on3,y,3,4,co]], on3vars(ex) ---> [x,y]
ex:f1*on3(x,1,2,co)+on(y,3,4,co), on3vars(ex) ---> [x,y] */
/*######################################################################*/
on3vars([args]) := block([progn:"<on3vars>",debug,Lw:exp,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3vars('help)--
機能: 式expに含まれるon3(),またはそのリスト表現からon3関数変数を取り出す.
文法: on3vars(exp,...)
例示: ex:f1*on3(x,1,2,co)+on(y,3,4,co), on3vars(ex) ---> [x,y]
ex:[+,[*,f1,[on3,x,1,2,co]],[on3,y,3,4,co]], on3vars(ex) ---> [x,y]
--end of l2f('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3vars('ex)--"),
block([progn:"<on3vars_ex>",L1,L2,ex1,ex2,ex],
L1 : ["+",["*",f1,[on3,x,1,2,co]],[on3,x,3,4,co]],
L2 : ["+",["*",f1,[on3,x,1,2,co],[on3,y,3,4,co]],f0],
ex1 : f1*on3(x,1,2,co) + on3(x,3,4,co),
ex2 : f1*on3(x,1,2,co) + on3(y,3,4,co),
for ex in [L1,L2,ex1,ex2] do ( c0show(ex), c0show(on3vars(ex)) ),
return("--- end of on3var_ex ---")
), /* end of block */
print("--end of on3vars('ex)--"),
return("--end of on3vars('ex)--"),
block_main, /* main ブロック ====================================*/
exp:args[1],
out:[],
if listp(exp) then Lw:copylist(exp) else Lw:f2l(exp), /* call f2l */
scanmap(lambda([u],
if listp(u) and first(u)=on3
then (d2show(u), out:cons(u[2],out)) else u ), Lw),
out:unique(out),
return(out)
)$ /* end of on3vars() */
/*######################################################################*/
/* <on3lrl>: 完全リストからon3関数端点リストを取り出す
f0+f1*on3(x,1,2,co) ---> [[x],[[minf,1,2,inf]],[true]]
f0+f1*on3(x,1,2,co)*on3(y,3,4,co)
---> [[x,y],[[minf,1,2,inf],[minf,3,4,inf]],[true,true]] */
/*######################################################################*/
on3lrl([args]) := block([progn:"<on3lrl>",debug, L,
Lw,outvars,wlist,outi,outlist,outnum,number],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3lrl('help)--
機能: 式内のon3()から,またはその完全リストからon3関数端点リストを取り出す.
また,端点リストに非数値が含まれるときFALSEを含まれないときTRUEを返す.
文法: on3lrl(exp,...)
例示:
f0+f1*on3(x,1,2,co) ---> [[x],[[minf,1,2,inf]],[true]]
f0+f1*on3(x,1,2,co)*on3(y,3,4,co)
---> [[x,y],[[minf,1,2,inf],[minf,3,4,inf]],[true,true]]
--end of l2f('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3lrl('ex)--"),
block([progn:"<on3lrl_ex>",wex,Lex0,L],
on3ex(),
Lex0 : [ex1a,ex28],
L : copylist(Lex0),
/* start */
for wex in L do ( print("---<領域情報>---"),
ldisplay(wex),
c0show(on3lrl(wex)),
c0show(f2l(wex))
),
return("--- end of on3lrl_ex ---")
), /* end of block */
print("--end of on3lrl('ex)--"),
return("--end of on3lrl('ex)--"),
block_main, /* main ブロック ====================================*/
L : args[1],
outvars:[], wlist:[], outi:[], outlist:[],outnum:[],
if not listp(L) then Lw:f2l(L) else Lw:L, /* call f2l */
scanmap(lambda([u],
if listp(u) and first(u)=on3
then (d2show(u), outvars:cons(u[2],outvars),
wlist:cons([u[2],u[3],u[4]],wlist)) else u ), Lw),
outvars:unique(outvars),
c1show(wlist),
for i thru length(outvars) do (
outi : [],
for j thru length(wlist) do (
if wlist[j][1] = outvars[i]
then outi:cons([wlist[j][2],wlist[j][3]],outi)
), /* end of do-j */
outi : cons([minf,inf],outi),
c1show(outi),
if on3type='on3mono then assume(outi[2][1]<outi[2][2]),
if errcatch( outi : sort(unique(flatten(outi)),"<"), return) = []
then outi : sort(unique(flatten(outi))) else outi,
outlist : endcons(outi,outlist)
), /* end of do-i */
c1show(outlist),
/* 端点リストに非数値要素が含まれているかを検査する */
if length(outvars) > 0 then (
outnum : makelist(true,i,1,length(outvars)),
for i:1 thru length(outlist) do (
number:true,
for j:2 thru length(outlist[i])-1 do
/* if not numberp(outlist[i][j]) then number:false, */
if not constantp(outlist[i][j]) then number:false,
outnum[i] : number
) /* end of for-i */
),
return([outvars,outlist,outnum])
)$
/*--- fsplit: on3std.mx ------------------------------------------------*/
/*######################################################################*/
/* <on3typep>: 式からon3式タイプを調べ結果を返す */
/*######################################################################*/
on3typep([args]) := block([progn:"<on3typep>",debug,exp,L:[],
on3type,on3none,on3monoone,on3mono,on3inv,on3poly,on3polyinv,on3unknown],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3typep('help)--
機能: 式からon3式タイプを調べ結果を返す
on3noe(非on3式), on3monoone(on3単項式,関数部1), on3mono(on3単項式),
on3inv(on3分数式), on3poly(on3多項式), on3polyinv(on3多項式の分数式),
on3unknown(その他のon3式),
文法: on3typep(exp,...)
例示:
--end of on3typep('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3typep('ex)--"),
block([progn:"<on3typep_ex>",ex,Lex0,L],
on3ex(),
Lex0 : [ex1a,ex28],
L : copylist(Lex0),
for ex in L do ( print("---<on3タイプ情報>---"),
ldisplay(ex),
c0show(out:on3typep(ex)),
c1show(f2l(ex))
),
return("--- end of on3typep_ex ---")
), /* end of block */
print("--end of on3typep('ex)--"),
return("--end of on3typep('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
if listp(exp) then L : copylist(exp)
else L : f2l(on3simp(ev(exp,expand,infeval))),
d1show(L),
if not listp(L) or not member(on3,flatten(L))
then ( on3type:on3none, d1show("---> 非on3式") )
else if listp(L) and L[1]=on3
then ( on3type:on3monoone, d1show("---> on3単項式 かつ 関数部 1 ") )
else if L[1]="*" and member(on3,flatten(L))
then ( on3type:on3mono, d1show("---> on3単項式") )
else if L[1]="/" and member(on3,flatten(L))
then ( on3type:on3inv, d1show("---> on3分数式") )
else if L[1]="+" and member(on3,flatten(L)) and not member("/",flatten(L))
then ( on3type:on3poly, d1show("---> on3多項式") )
else if L[1]="+" and member(on3,flatten(L)) and member("/",flatten(L))
then ( on3type:on3polyinv, d1show("---> on3多項式(逆数部含む)") )
else ( on3type:on3unknown, cshow("---> on3式分類不定") ),
d1show(on3type),
return(on3type)
)$ /* end of on3typep() */
/*--- on3std_ex -------------------------------------------- */
on3std_ex([args]) := block([progn:"<on3std_ex>",debug,ex,L,exansL,out],
debug:ifargd(),
on3ex(),
/*
if length(args) > 0 then (
if listp(args[1]) then L:copylist(args[1]) else L:[args[1]]
) else L : copylist(Lex),
*/
L : copylist(Lex),
exansL :
[["f0","f0"],
["on3(x,1,2,co)","on3(x,1,2,co)"],
["-on3(x,1,2,co)","-on3(x,1,2,co)"],
["on3(x,1,2,co)+f0","f0*on3(x,minf,inf,oo)+on3(x,1,2,co)"],
["f0-f1*on3(x,1,2,co)","f0*on3(x,minf,inf,oo)-f1*on3(x,1,2,co)"],
["f1*f2*on3(x,1,2,co)+f0","f0*on3(x,minf,inf,oo)+f1*f2*on3(x,1,2,co)"],
["f1*log(x)*on3(x,1,2,co)+f0","f0*on3(x,minf,inf,oo)+f1*log(x)*on3(x,1,2,co)"],
["f1*on3(x,5,7,co)+f1*on3(x,3,5,co)","f1*on3(x,5,7,co)+f1*on3(x,3,5,co)"],
["f2*on3(x,2,5,co)+f1*on3(x,1,3,co)+f3*on3(x,0,inf,co)",
"f2*on3(x,2,5,co)+f1*on3(x,1,3,co)+f3*on3(x,0,inf,co)"],
["1/(f2*on3(x,3,7,co)+f1*on3(x,1,5,co))+f0*on3(x,3,5,co)",
sconcat("(f0*f2*on3(x,3,5,co))/(f2*on3(x,3,7,co)+f1*on3(x,1,5,co))",
"+(f0*f1*on3(x,3,5,co))/(f2*on3(x,3,7,co)+f1*on3(x,1,5,co))",
"+1/(f2*on3(x,3,7,co)+f1*on3(x,1,5,co))")],
["1/((f2*on3(x,3,7,co))/(f22*on3(x,3,5,co)+f21*on3(x,1,3,co))+f1*on3(x,1,5,co))+f0",
sconcat("(f0*f2*on3(x,3,7,co))/(f2*on3(x,3,7,co)+f1*f22*on3(x,3,5,co)",
"+f1*f21*on3(x,1,3,co))",
"+(f0*f1*f22*on3(x,3,5,co))/(f2*on3(x,3,7,co)+f1*f22*on3(x,3,5,co)",
"+f1*f21*on3(x,1,3,co))",
"+(f22*on3(x,3,5,co))/(f2*on3(x,3,7,co)+f1*f22*on3(x,3,5,co)",
"+f1*f21*on3(x,1,3,co))",
"+(f0*f1*f21*on3(x,1,3,co))/(f2*on3(x,3,7,co)+f1*f22*on3(x,3,5,co)",
"+f1*f21*on3(x,1,3,co))",
"+(f21*on3(x,1,3,co))/(f2*on3(x,3,7,co)+f1*f22*on3(x,3,5,co)",
"+f1*f21*on3(x,1,3,co))")],
["x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)+((1-x^2)*on3(x,0,1,oo))/2+sin(x)",
sconcat("sin(x)*on3(x,minf,inf,oo)+x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)",
"+(1/2-x^2/2)*on3(x,0,1,oo)")],
["x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)+((1-x^2)*on3(x,0,1,oo))/2+myfunc(x)",
sconcat("myfunc(x)*on3(x,minf,inf,oo)+x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)",
"+(1/2-x^2/2)*on3(x,0,1,oo)")],
["%e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co),f1*on3(x,a,b,co)",
"%e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co)"],
["f2*on3(x,c,d,co)+f1*on3(x,a,b,co)",
"f2*on3(x,c,d,co)+f1*on3(x,a,b,co)"],
["f1(x)*on3(x,1,2,co)","f1(x)*on3(x,1,2,co)"],
["f2(x)*on3(x,2,4,co)+f1(x)*on3(x,1,3,co)",
"f2(x)*on3(x,2,4,co)+f1(x)*on3(x,1,3,co)"],
["f1(x)*on3(x,a,b,co)",
"f1(x)*on3(x,a,b,co)"],
["f2(x)*on3(x,c,d,co)+f1(x)*on3(x,a,b,co)",
"f2(x)*on3(x,c,d,co)+f1(x)*on3(x,a,b,co)"],
["on3(x,1,2,co)*on3(y,3,4,co)+f0",
"f0*on3(x,minf,inf,oo)*on3(y,minf,inf,oo)+on3(x,1,2,co)*on3(y,3,4,co)"],
["f1*on3(x,1,2,co)*on3(y,3,4,co)+f0",
"f0*on3(x,minf,inf,oo)*on3(y,minf,inf,oo)+f1*on3(x,1,2,co)*on3(y,3,4,co)"],
["f1*f2*on3(x,1,2,co)*on3(y,3,4,co)+f0",
sconcat("f0*on3(x,minf,inf,oo)*on3(y,minf,inf,oo)",
"+f1*f2*on3(x,1,2,co)*on3(y,3,4,co)")],
["f1*log(x)*on3(x,1,2,co)*on3(y,3,4,co)+f0",
sconcat("f0*on3(x,minf,inf,oo)*on3(y,minf,inf,oo)",
"+f1*log(x)*on3(x,1,2,co)*on3(y,3,4,co)")],
["f1*on3(x,1,2,co)*on3(y,3,4,co)+f2+f0",
"(f2+f0)*on3(x,minf,inf,oo)*on3(y,minf,inf,oo)+f1*on3(x,1,2,co)*on3(y,3,4,co)"],
["f1*on3(x,5,7,co)*on3(y,2,4,co)+f1*on3(x,3,5,co)*on3(y,2,4,co)",
"f1*on3(x,5,7,co)*on3(y,2,4,co)+f1*on3(x,3,5,co)*on3(y,2,4,co)"],
["f0*on3(y,5,6,co)+f1*on3(x,1,2,co)*on3(y,3,4,co)",
"f0*on3(x,minf,inf,oo)*on3(y,5,6,co)+f1*on3(x,1,2,co)*on3(y,3,4,co)"],
["f1*on3(x,3,7,co)*on3(y,4,8,co)+f2*on3(x,1,5,co)*on3(y,2,6,co)",
"f1*on3(x,3,7,co)*on3(y,4,8,co)+f2*on3(x,1,5,co)*on3(y,2,6,co)"],
[sconcat("(y+x+5)*(on3(x,2,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)",
"+on3(x,-3,-2,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)",
"+on3(x,-2,2,co)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc)",
"+on3(x,-2,2,co)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc))"),
sconcat("on3(x,2,3,co)*(y+x+5)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)",
"+on3(x,-3,-2,co)*(y+x+5)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)",
"+on3(x,-2,2,co)*(y+x+5)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc)",
"+on3(x,-2,2,co)*(y+x+5)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc)")],
["r*on3(r,2,3,cc)*(r*sin(t)+r*cos(t)+5)*on3(t,0,2*%pi,cc)",
"on3(r,2,3,cc)*(r^2*sin(t)+r^2*cos(t)+5*r)*on3(t,0,2*%pi,cc)"],
["f2*on3(x,1,2,co)*on3(y,3,4,co)+f1*on3(x,1,2,co)*on3(y,3,4,co)",
"(f2+f1)*on3(x,1,2,co)*on3(y,3,4,co)"],
["f2*on3(x,1,2,co)*on3(y,4,6,co)+f1*on3(x,1,2,co)*on3(y,3,5,co)",
"f2*on3(x,1,2,co)*on3(y,4,6,co)+f1*on3(x,1,2,co)*on3(y,3,5,co)"],
["1/(f2*on3(x,1,2,co)*on3(y,4,6,co)+f1*on3(x,1,2,co)*on3(y,3,5,co))",
"1/(f2*on3(x,1,2,co)*on3(y,4,6,co)+f1*on3(x,1,2,co)*on3(y,3,5,co))", "on3show"],
["on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co)",
"on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co)"],
["f1*on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co)+f2*on3(y,3,4,co)*on3(z,5,6,co)",
sconcat("f2*on3(x,minf,inf,oo)*on3(y,3,4,co)*on3(z,5,6,co)",
"+f1*on3(x,1,2,co)*on3(y,3,4,co)*on3(z,5,6,co)")]
],
c1show(exansL),
print("== on3std_ex : 標準型 ==="),
/* print("ex =",ex,"--> on3typep(ex) =",on3typep(ex)), */
exchk("on3std",exansL,debug0),
/* start */
if true then (
c1show(L),
cshow("on3関数のタイプの検査"),
for ex in L do (
c0show(ex),c0show(" -->",on3typep(ex)),
c0show(on3std(ex))
)
),
return("--- end of on3std_ex ---")
)$
/*######################################################################*/
/* <on3std>: 式からon3標準型(排他的分解の出来ない状況での可)表現を返す */
/*######################################################################*/
on3std([args]) := block([progn:"<on3std>",debug, exp, L:[],LR:[],
pnum:[],pdenom:[],out,
on3type,on3none,on3monoone,on3mono,on3inv,on3poly,on3polyinv,on3unknown],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3std('help)--
機能: 式からon3標準型(排他的分解の出来ない状況での可)表現を返す
文法: on3std(exp,...)
例示:
--end of on3std('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3std('ex)--"),
on3std_ex([args]),
print("--end of on3std('ex)--"),
return("--end of on3std('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
if listp(exp) then L : copylist(L)
else L : f2l(on3simp(ev(exp,expand,infeval))),
on3type:on3typep(L), /* call on3typep */
c1show(L), c1show(on3type),
if on3type='on3mono then return(exp),
if errcatch( LR : on3lrl(L), return )=[] then return(exp) else LR,
/* call on3lrl */
/* LR : [[x,y],[[minf,x1,x2,inf],[minf,y1,y2,inf]]] */
d1show(LR),
d1show(on3type),
/*** on3decomp が利用できない局面でのon3多項式の標準化変換を行う ***/
if on3type=on3poly or on3type=on3polyinv then L:on3std_sub(L,LR),
d1show("pre",l2f(L)),
/*** 分数式部を検出し，分子，分母を整形する ***/
if on3type=on3polyinv or on3type=on3inv then (
L:scanmap(lambda([u], if listp(u) and u[1]="/" then (
pnum:u[2], pdenom:u[3],
d2show(u,pnum,pdenom),
if listp(pnum) and member(on3,flatten(pnum))
and member("+",flatten(pnum)) and not member("/",flatten(pnum))
then pnum:on3std_sub(pnum,LR),
if listp(pdenom) and member(on3,flatten(pdenom))
and member("+",flatten(pdenom)) and not member("/",flatten(pdenom))
then pdenom:on3std_sub(pdenom,LR),
u:["/",pnum,pdenom], u
) /* end of then */ else u ), L) /* end of scanmap */
) /* end of on3inv-then */,
out:l2f(L),
d1show(out),
return(out)
)$
/*######################################################################*/
/* <on3std_sub>: (内部使用) 標準化リスト表現を返す */
/*######################################################################*/
on3std_sub(LW0,LR0,[args]) := block([progn:"<on3std_sub>",debug,
LW:LW0, LR:LR0,
w:[],wone,ww,wl,fone,won3:[],lpo,out,sum,won3i,uj,ujwon3],
debug:ifargd(),
/*** [1] 不完全on3項の完全on3項化(多項式の整形) : f1*on3(x,xl,xr,lr) + ...
f0 -> f0*on3(x,minf,inf,oo),
f0*on3(y,2,3,co) -> f0*on3(x,minf,inf,oo)*on3(y,2,3,co) ***/
w:LR[1], /* on3変数の取得: call on3vars */
d1show("S1:不完全on3項の完全on3項化開始 "),
wone : 1, for i thru length(w) do wone:wone*on3(w[i],minf,inf,oo),
d1show("begin on3one",LW,w,wone),
if false then (
LW:scanmap(lambda([u],
if listp(u) and u[1]="+" then (
d1show("start scanmap:",u),
if length(u) > 1 then for i:2 thru length(u) do (
/* call on3rule5 and l2f, f2l */
d1show(u[i]),
ww :l2f(u[i])*wone,
d1show(ww),
ww : letsimp(ww,on3rule5),
d1show("--letsimp(ww)-->",ww),
wl:partition(fone*ww,on3),
d1show("--wl-->",wl),
d2show(i,wl),
if listp(u[i]) and member("/",flatten(u[i])) then u[i]
else u[i]:["*",wl[1],f2l(wl[2])]
), /* end of for-i */
d1show("end of do",u), u ) else u), LW), /* end of scanmap */
LW:ev(LW,fone=1,infeval)
),
if true then (
ww : l2f(LW)*wone,
ww : letsimp(ww,on3rule5), /* 重要 2019.12.23 */
LW : f2l(ww),
c1show(ww)
),
d1show("S1:不完全on3項の完全on3項化の結果",l2f(LW)),
/***<Part 2 begin 同一領域上の関数をまとめる>******************************/
/*** 排他処理済みon3多項式の関数部の整理した結果を返す <多変数に対応>
f1*on3(x,1,2,co)+f2*on3(x,3,4,co)+f3*on3(x,1,2,co)
---> (f1+f3)*on3(x,1,2,co) + f2*on3(x,3,4,co) ***/
d1show("S2:同一領域上の関数の合併開始",LW),
/*** 多項式部に現れるon3部を(関数形式で)取り出す ***/
won3:[],
scanmap(lambda([u],
if listp(u) and u[1]="*" and not member("/",flatten(u)) and member(on3,flatten(u))
then (d2show("won3",u,l2f(u)),
lpo:partition(fone*l2f(u),on3),
d2show(lpo),
won3:cons(lpo[2], won3) ) else u /* on3部を関数として取り出す*/
),LW,bottomup), /* end of scanmap */
won3:unique(won3),
d1show("S2-1:on3(領域)部の検出結果",won3,length(won3)),
/*** 同一のon3部をもつ関数を合併する ***/
LW:scanmap(lambda([u],
if listp(u) and u[1]="+" and not member("/",flatten(u))
and member(on3,flatten(u)) then (
d1show(u), out:0,
for i thru length(won3) do (
sum : 0, won3i:won3[i],
for j:2 thru length(u) do (
uj:l2f(u[j]), ujwon3:partition(fone*uj,on3)[2],
if ujwon3=won3i then sum:sum+partition(fone*uj,on3)[1],
d2show("<2-2",won3i) ), /* end of for-j */
d1show(won3i,sum),
out : out+sum*won3i,
d1show(i,out)
), /* end of for-i */
u : f2l(out) ) /* end of then */ else u ), LW), /* end of scanmap */
LW : ev(LW,fone=1,infeval),
d1show("S2-2: 同一領域上の関数の合併結果",out),
c1show(progn,l2f(LW)),
c1show(progn,LW),
return(LW)
)$
/*--- on3std11_ex -------------------------------------------- */
on3std11_ex([args]) := block([progn:"<on3std11_ex>",ex,L,out],
on3ex(),
if length(args) > 0 then (
if listp(args[1]) then L:copylist(args[1]) else L:[args[1]]
) else L : copylist(Lex),
/* start */
cshow("on3関数のタイプの検査"),
for ex in L do (
print("---on3std_ex---"),
ldisplay(ex),
cshow("--->",on3typep(ex)),
print("out : on3std(ex) --->"),
out : on3std(ex),
ldisplay(out)
),
return("--- end of on3std11_ex ---")
)$
/*######################################################################*/
/* <on3termsep>: 項 f*on3(x..)*on3(y,.) から on3(x,.) を分離した表現を返す */
/*######################################################################*/
on3termsep([args]) := block([progn:"<on3termsep>",debug,term,var:none,out,
L:[],ton3],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3termsep('help)--
機能: 項 f*on3(x..)*on3(y,.) から on3(x,.) を分離した表現を返す(未完成!!)
文法: on3termsep(exp,...)
例示: ex : f1*on3(x,1,2,co)*on3(y,3,4,co)$
on3termsep(ex) = [f1,on3(x,1,2,co)*on3(y,3,4,co)]
on3termsep(ex,x) = [f1*on3(y,3,4,co),on3(x,1,2,co)]
on3termsep(ex,y) = [f1*on3(x,1,2,co),on3(y,3,4,co)]
--end of on3termsep('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3termsep('ex)--"),
block([progn:"<on3termsep('ex)>",debug,ex],
debug:ifargd(),
ex : f1*on3(x,1,2,co)*on3(y,3,4,co),
print("---ex---"),
ldisplay(ex),
c0show(on3termsep(ex)),
c0show(on3termsep(ex,x)),
c0show(on3termsep(ex,y)),
return("--- end of on3termsep('ex) ---")
), /* end of block */
print("--end of on3termsep('ex)--"),
return("--end of on3termsep'ex)--"),
block_main, /* main ブロック ====================================*/
term : args[1],
if length(args) > 1 and not member(args[2], [debug1,debug2,debug3])
then var:args[2], /* 変数の取得 */
if not listp(term) then L:f2l(term) else L:copylist(term),
if var=none then ( /* on3部全体を分離する */
ton3:1,
out : scanmap(lambda([u], if listp(u) and u[1]=on3 then
(ton3:ton3*l2f(u), u:1) else u ), L),
out:l2f(out) )
else ( /* 着目変数varを伴ったon3部のみを分離する */
ton3:1,
out : scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=var then
(ton3:ton3*l2f(u), u:1) else u ), L),
out:l2f(out) ),
d1show(term,ton3,out),
return([out,ton3])
)$
/*--- fsplit: on3ev.mx ------------------------------------------------*/
/*######################################################################*/
/* <on3ev>: on3poly の各関数部を{factor,expand,ratsimp}した表現を返す */
/*######################################################################*/
on3ev([args]) := block([progn:"<on3ev>",debug,exp,L:[],
sum,ton3,func,funcL:[],
on3type,on3none,on3monoone,on3mono,on3inv,on3poly,on3polyinv,on3unknown],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3ev('help)--
機能: on3poly の各関数部を{factor,expand,ratsimp}した表現を返す
文法: on3ev(exp,...)
例示: ex : x*on3(x,3,4,co)+(x^2-2*x+1)*on3(x,1,2,co)
on3ev(ex,factor) = x*on3(x,3,4,co)+(x-1)^2*on3(x,1,2,co)
ex1e : %e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co)
out : on3integ(ex1e,x)
= (%e^-x*(4*%e^x-3*%e)*on3(x,1,inf,co))/3+(x^3*on3(x,0,1,co))/3
on3ev(out,expand) = (4/3-%e^(1-x))*on3(x,1,inf,co)+(x^3*on3(x,0,1,co))/3
--end of on3ev('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3ev('ex)--"),
block([progn:"<on3ev('ex)>",debug, cmds,
ex1,ex2,ans1,ans2,out0,out],
debug:ifargd(),
print("--- on3ev_ex ---"),
cmds : sconcat("( ",
"/* 例1. on3 多項式の関数部の因数分解 */ @",
"ex1 : (x^2-2*x+1)*on3(x,1,2,co) + x*on3(x,3,4,co), @",
"out : on3ev(ex1,factor)",
" )"),
ans1 : x*on3(x,3,4,co)+(x-1)^2*on3(x,1,2,co),
chk1show(cmds,ans1),
cmds : sconcat("( ",
"/* 例2. on3 多項式の展開 */ @",
"ex2 : %e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co), @",
"out0 : on3integ(ex2,x), print(\" out0 = \",out0), @",
"out : on3ev(out0,expand) ",
" )"),
ans2 : (4/3-%e^(1-x))*on3(x,1,inf,co)+(x^3*on3(x,0,1,co))/3 ,
chk1show(cmds,ans2),
return("--- end of on3ev('ex) ---")
), /* end of block */
print("--end of on3ev('ex)--"),
return("--end of on3ev'ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
args[1] : 'del, args:delete('del,args),
c1show(progn,exp),
if member(debug1,args) then args:delete(debug1,args),
if member(debug2,args) then args:delete(debug2,args),
if member(debug3,args) then args:delete(debug3,args),
d1show(args),
exp : on3std(exp),
if listp(exp) then L : copylist(exp) else L : f2l(exp),
c1show(progn,L),
on3type:on3typep(L), /* call on3typep */
d1show(on3type),
/*** on3poly 出ない場合は無処理とする ***/
if on3type # on3poly then return(exp),
sum : 0,
for i:2 thru length(L) do ( /* 関数部とon3部を分離する */
ton3:1,
funcL : scanmap(lambda([u], if listp(u) and u[1]=on3 then
(ton3:ton3*l2f(u), u:1) else u ), L[i]),
func : l2f(funcL), /* 関数部の因数分解 */
for j:1 thru length(args) do func : ev(func,ev(args[j])), /* !!! */
d2show(func,ton3),
sum : sum + func*l2f(ton3)
), /* end of for-i */
d1show(sum),
return(sum)
)$
/*--- fsplit: on3decomp.mx ---------------------------------------------*/
/*######################################################################*/
/* <on3decomp_reduce>: (内部使用) : 同一関数部をもつ領域の簡素化(合併) */
/*######################################################################*/
on3decomp_reduce(LWT0,[args]) := block([progn:"<on3decomp_reduce>",debug,
LWT:LWT0,out,
ton3j:[],ton3k:[],gtj,gtk,wgtj,gtl,gtr,wgtk,wgtm,wtl:[],tl,tr,tlr],
debug:ifargd(),
d2show("on3decomp_reduce start",LWT),
if not LWT[1] = "+" then
(c1show("not on3decomp_reduced",LWT), return([LWT,false])),
for j:2 thru length(LWT)-1 do (
gtj:l2f(LWT[j]),
d2show(gtj),
scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then ton3j:u else u), LWT[j]),
wgtj:ev(gtj,tvar=(ton3j[3]+ton3j[4])/2),
d2show(ton3j,wgtj),
for k:j+1 thru length(LWT) do (
gtk:l2f(LWT[k]),
scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then ton3k:u else u),LWT[k]),
wgtk:ev(gtk,tvar=(ton3k[3]+ton3k[4])/2),
d3show(ton3k,wgtk),
wtl:sort(unique([ton3j[3],ton3j[4],ton3k[3],ton3k[4]])),
d3show(gtj,gtk,wtl,wgtj,wgtk),
if length(wtl)=3 and wgtj=wgtk
and (ev(gtj,tvar=wtl[2])=wgtj or ev(gtk,tvar=wtl[2])=wgtk)
then (
tl:wtl[1], tr:wtl[3], tm:wtl[2], wgtm:wgtj,
if ton3j[3]=tl then (gtl:gtj, gtr:gtk) else (gtl:gtk, gtr:gtj),
if ev(gtl,tvar=tl) = wgtm and ev(gtr,tvar=tr) = wgtm then tlr:cc
else if ev(gtl,tvar=tl) = wgtm and ev(gtr,tvar=tr) # wgtm then tlr:co
else if ev(gtl,tvar=tl) # wgtm and ev(gtr,tvar=tr) = wgtm then tlr:oc
else tlr:oo,
out:wgtm*on3(tvar,tl,tr,tlr),
d3show("reduced:",gtj,"+",gtk,"->",out),
LWT[j]:f2l(out),
LWT:delete(LWT[k],LWT,1),
d3show(LWT),
return([LWT,true])
) /* end of then */
) /* end of for-k */
), /* end of for-j */
return([LWT,false])
)$
/*######################################################################*/
/* <on3decomp_decomp>: (内部使用) : on3多項式の排他分解処理 */
/*######################################################################*/
on3decomp_decomp(exp,[args]) := block([progn:"<on3decomp_decomp>",debug,
lpo,uj,ujwon3,
out,fone,won3:[],ww,rout:[],won3i,sum,
L0:[],LR:[],LW:[],i,j,von3,T:[],TC:[],lcont,rcont,new,fj,
LWT:[],outi,fw,gt,tvar,fsum,
tl,tr,tm,tlr,gtl,gtr,gtm,wgtl,wgtr,wgtm,ton3:[]],
debug:ifargd(),
if listp(exp) then L0:copylist(exp) else L0 : f2l(exp),
d1show(exp,L0),
if member('on3decomp_inv,flatten(L0)) then return(L0),
d1show(L0),
LR : on3lrl(exp), /* call on3lrl : 端点リストの取得 */
LW : copylist(L0),
d1show("on3decomp_decomp start:",LW),
d1show("<0>on3変数と端点リストの取得",LR),
/*** <Part 1 begin ******************************************/
for i:length(LR[1]) step -1 thru 1 do ( /* on3変数毎の処理 */
von3 : LR[1][i],
T : copylist(LR[2][i]), TC:[],
d2show("---",i,von3), d2show(T), d2show(LW),
LWT:[],
LWT:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=von3 then
(d2show(u), ev(u, u[2]=tvar)) else u ), LW),
gt : l2f(LWT),
d2show(LWT), d2show(gt),
fsum : 0,
for j:1 thru length(T)-1 do ( /* 排他的区間処理 */
tl:T[j], tr:T[j+1], tm : (tl+tr)/2,
d2show(tl,tr,tm),
gtl : ev(gt,tvar=tl), gtr : ev(gt,tvar=tr), gtm : ev(gt,tvar=tm),
d2show(gtl,gtr,gtm),
if gtl = gtm and gtr = gtm then tlr:cc
else if gtl = gtm and gtr # gtm then tlr:co
else if gtl # gtm and gtr = gtm then tlr:oc
else tlr:oo,
/* minf と inf の処理 */
if tl=minf then (if tlr=cc then tlr:oc else if tlr=co then tlr:oo),
if tr=inf then (if tlr=cc then tlr:co else if tlr=oc then tlr:oo),
fsum : fsum + gtm*on3(von3,tl,tr,tlr),
d2show(i,fsum)
), /* end of for-j */
/*** 孤立点の検査:関数比較に基づく(関数値比較は避ける) ***/
TC:makelist("none",i,1,length(T)),
if length(T) > 2 then (
for j:2 thru length(T)-1 do ( /* 孤立点の検査 */
tl : (T[j-1]+T[j])/2, tm : T[j], tr : (T[j]+T[j+1])/2,
gtl : ev(gt,tvar=tl), gtr : ev(gt,tvar=tr), gtm : ev(gt,tvar=tm),
if gtm # 0 and gtl # gtm and gtr # gtm then (
fsum : fsum + gtm*on3(von3,tm,tm,cc),
/* 関数値比較 */
if errcatch(wgtl:ev(gtl,ev(von3)=tm),
wgtr:ev(gtr,ev(von3)=tm),
wgtm:ev(gtm,ev(von3)=tm),
return) = [] then (TC[j]:none)
else (d2show(tm,wgtl,wgtm,wgtr),
if wgtr=wgtm then TC[j]:lcont /* 優先合併 */
else if wgtl=wgtm then TC[j]:rcont else TC[j]:new)
) /* end of then */
)),
LW : f2l(ev(fsum,expand,infeval)), d2show("i-end",i,LW),
/* singular point */
if member(lcont,TC) or member(rcont,TC) or member(new,TC) then (
d2show("孤立点再検査と合併",TC),
fsum : 0, ton3:[],
for j:2 thru length(LW) do (
d2show(LW[j]),
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=von3
then (ton3:u, d2show(ton3), u) else u ), LW[j]),
fj : scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=von3
then (u:1, u) else u ), LW[j]),
fj : l2f(fj),
d2show(ton3,fj),
for k:2 thru length(T)-1 do (
d2show(k,T[k],TC[k]),
if ton3[3] = T[k] and TC[k] = lcont then (
if ton3[5]=oc then ton3[5]:cc else if ton3[5]=oo then ton3[5]:co ),
if ton3[4] = T[k] and TC[k] = rcont then (
if ton3[5]=co then ton3[5]:cc else if ton3[5]=oo then ton3[5]:oc ),
if ton3[3] = T[k] and ton3[4] = T[k] and TC[k] # new then fj:0
), /* end of for-k */
d2show("after ton3",ton3,fj),
fsum : fsum + fj * funmake(on3,delete(on3,ton3))
), /* end of for-j */
LW : f2l(fsum)
), /* end of member then */
d2show("孤立点再検査と合併処理後",LW)
), /* end of for-i */
d1show("<1> 排他的領域上の関数表現",l2f(LW)),
/***<Part 2 begin 同一領域上の関数をまとめる>******************************/
/*** 排他処理済みon3多項式の関数部の整理した結果を返す <多変数に対応>
f1*on3(x,1,2,co)+f2*on3(x,3,4,co)+f3*on3(x,1,2,co)
---> (f1+f3)*on3(x,1,2,co) + f2*on3(x,3,4,co) ***/
d1show("S2:同一領域上の関数の合併開始",LW),
/*** 多項式部に現れるon3部を(関数形式で)取り出す ***/
won3:[],
scanmap(lambda([u],
if listp(u) and u[1]="*" and not member("/",flatten(u)) and member(on3,flatten(u))
then (d2show("won3",u,l2f(u)),
lpo:partition(fone*l2f(u),on3),
d2show(lpo),
won3:cons(lpo[2], won3) ) else u /* on3部を関数として取り出す*/
),LW,bottomup), /* end of scanmap */
won3:unique(won3),
won3:ev(won3,fone=1,infeval),
d1show("S2-1:on3(領域)部の検出結果",won3,length(won3)),
/*** 同一のon3部をもつ関数を合併する ***/
LW:scanmap(lambda([u],
if listp(u) and u[1]="+" and not member("/",flatten(u))
and member(on3,flatten(u)) then (
d1show(u), out:0,
for i thru length(won3) do (
sum : 0, won3i:won3[i],
for j:2 thru length(u) do (
uj:l2f(u[j]), ujwon3:partition(fone*uj,on3)[2],
if ujwon3=won3i then sum:sum+partition(fone*uj,on3)[1],
d2show("<2-2",won3i) ), /* end of for-j */
d1show(won3i,sum),
out : out+sum*won3i,
d1show(i,out)
), /* end of for-i */
u : f2l(out) ) /* end of then */ else u ), LW), /* end of scanmap */
LW : ev(LW,fone=1,infeval),
d1show("S2-2: 同一領域上の関数の合併結果",out),
/***<Part 3 bigen> 同一関数部をもつ領域の簡素化 *******************/
/*** f1*on3(x,1,3,co)+f1*on3(x,3,5,co) -> f1*on3(x,1,5,co)
f1*on3(x,1,3,cC)+f1*on3(x,3,5,co) -> f1*on3(x,1,5,co)
f1*on3(x,1,3,co)*on3(y,2,4,co)+f1*on3(x,3,5,co)*on3(y,2,4,co)
-> f1:on3(x,1,5,co)*on3(y,2,4,co)
****/
L0 : f2l(out), d2show("<3>",L0),
LR : on3lrl(out), /* call on3lrl : 端点リストの取得 */
LW : copylist(L0),
d2show("<3a>on3変数と端点リストの取得",LR),
for i:length(LR[1]) step -1 thru 1 do ( /* on3変数毎の処理 */
von3 : LR[1][i],
LWT:[],
LWT:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=von3 then
(d2show(u), ev(u, u[2]=tvar)) else u ), LW),
d2show(LWT), d2show(l2f(LWT)),
/*** loop for on3decomp_reduce ***/
rout:[],
loop, rout:on3decomp_reduce(LWT),
if rout[2]=true then (LWT:rout[1], go(loop)) else LWT:rout[1],
d2show(LWT),
LW:[],
LW:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=tvar then
(d2show(u), ev(u, u[2]=von3)) else u ), LWT),
d2show(l2f(LW))
), /* end of for-i */
out : l2f(LW),
d1show("<3> 同一関数部をもつ領域の簡素化",out),
return(out)
)$
/*######################################################################*/
/* <on3decomp_inv>: （内部使用) : on3多項式の逆数の処理 */
/*######################################################################*/
on3decomp_inv(u,[args]) := block([progn:"<on3decomp_inv>",debug,uw:u,w:[],fone],
debug:ifargd(),
if not listp(u) then uw:f2l(u),
if member('on3decomp_decomp,flatten(uw)) then return(uw),
d2show("before on3decomp_inv:",uw),
for i:2 thru length(uw) do (
w : partition(fone*l2f(uw[i]), on3),
w : ev(w,fone=1),
uw[i] : ["*", ratsimp(1/w[1]), f2l(w[2])]
), /* end of do */
d2show(uw),
/* uw : ev(uw), */
d2show("after on3decomp_inv:",uw),
d1show("--->",l2f(uw)),
return(l2f(uw))
)$
/*############################################################################*/
/*### chk2show : 入力履歴と結果の検証 #########################################*/
/*############################################################################*/
chk2show([args]) := block([progn:"<chk2show>",debug,cmds,ans, hlp,hlpL,
cmdsansL,cmdsL,out,outL, chk,chkm],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
block([cmds,Fans],
printf(true,"
--begin of chk2show('help)--
機能: 入力履歴と結果の検証
文法: chk2show(cmds,ans,...), chk2show([[cmds1,ans1]])
chk2show([[cmds1,ans1],[cmds2.ans2],...])
例示:
cmds : sconcat(\"(\",
\"/* chk2showの使用例 */ @\",
\"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @\",
\"F : on3integ19(f,x), \",
\"F : on3decomp(F) \",
\")\"
),
Fans : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)
+2*f1*on3(x,3,4,co)+f1*(x-1)*on3(x,1,3,co),
chk2show(cmds,Fans),
--end of chk1show('help')--
"
)),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of chk2show('ex)--"),
chk2show_ex(),
print("--end of chk2show('ex)--"),
return("--end of chk2show('ex)--"),
block_main, /* main ブロック ====================================*/
/* cmdsansL : [[cmds1,ans1],[cmds2,ans2],...] */
if listp(args[1])=false then cmdsansL:[[args[1],args[2]]]
else if listp(args[1][1])=false then cmdsansL:[args[1]]
else cmdsansL:args[1],
c1show(progn,cmdsansL), outL : [],
for k:1 thru length(cmdsansL) do (
cmds : cmdsansL[k][1], ans : cmdsansL[k][2],
cmdsL : split(cmds,"@"),
cmds : sremove("@",cmds),
for i thru length(cmdsL) do
if i=1 then print("★ ",cmdsL[1]) else print(" ",cmdsL[i]),
out : eval_string(cmds), /* 入力履歴(文字列)の一括評価 */
if ans="" then return("no check of ans"),
if listp(out) and is(equal(out,ans)) then (chk:true, chkm:"◎ ")
else (chk:false, chkm:"❌ ", chkerrsum : chkerrsum + 1),
if listp(out)=false then (
if numberp(out) and abs(out-ans) < 1.0E-8
then (chk:true, chkm:"◎ ")
else if is(equal(expand(out),expand(ans))) then (chk:true, chkm:"◎ ")
else (chk:false, chkm:"❌ ", chkerrsum : chkerrsum + 1)
),
if slength(sconcat(out)) < 500
then print(chkm,"out =",out)
else print(chkm,"reveal(out,6) =", reveal(out,6)),
if chk=false then print(" <- ans =",ans),
outL : endcons(out, outL)
), /* end of for-k */
return(outL)
)$ /* end of chkshow */
/*+++ chk2show_ex +++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
chk2show_ex([args]) := block([progn:"<chk2show_ex>",debug,cmds1,Fans1,cmds2,Fans2,outL],
cmds1 : sconcat("(",
"/* chk2showの使用例1 */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @",
"F : on3integ19(f,x), ",
"F : on3decomp(F) ",
")"),
Fans1 : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)+2*f1*on3(x,3,4,co)
+f1*(x-1)*on3(x,1,3,co),
cmds2 : sconcat("(",
"/* chk2showの使用例2 */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,2,6,co), /* fの定義 */ @",
"F : on3integ19(f,x), ",
"F : on3decomp(F) ",
")"),
Fans2 : 2*(2*f2+f1)*on3(x,6,inf,co)+(f2*x-2*f2+2*f1)*on3(x,3,6,co)
+(f2*x+f1*x-2*f2-f1)*on3(x,2,3,co)+f1*(x-1)*on3(x,1,2,co),
chk2show(cmds1,Fans1),
c0show("===2例の場合===="),
outL : chk2show([[cmds1,Fans1],[cmds2,Fans2]]),
cshow(outL),
for i:1 thru length(outL) do (
display2d:true, on3show(outL[i]), display2d:false
),
return("--end of chk2show_ex--")
)$ /* end of chk1show_ex */
/*#########################################################################*/
/** on3_same_var():同一変数varに関するon3()関数の積の項の検査 2020.07.18 **/
/*#########################################################################*/
on3_same_var([args]) := block([progn:"<on3_same_var>",debug,var,wL,Lon3,ic,icmax],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3_same_var('help)--
機能: 同一変数varに関するon3()関数の積の項が存在する(返り値2以上)か否(2未満)かを検査する
文法: on3_same_var(on3func,var) or on3r(on3funcL,var)
例示: on3_same_var(on3(x,1,3,co)*on3(x,a,b,co),x) -> 2
--end of on3_same_var('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3_same_var('ex)--"),
block([ex,ex1,ex2,ex3],
ex1 : on3(x,1,3,co)+on3(x,2,5,co)*on3(x,4,6,co),
ex2 : on3(x,1,3,co)+on3(x,2,5,co)*on3(x,a,b,co),
ex3 : on3(x,1,3,co)+on3(x,2,5,co),
for ex in [ex1,ex2,ex3] do (
c0show("例 ",ex),
on3_same_var(ex,x,'debug1)
)
),
print("--end of on3_same_var('ex)--"),
return("--end of on3_same_var('ex)--"),
block_main, /* main ブロック ====================================*/
c2show(args[1]),
if listp(args[1]) then wL:args[1] else wL:f2l(args[1]),
c1show(progn,wL),
var : args[2],
/* 同一変数のon3関数の積 on3(x,..)*on3(x,..)の個数を調べる */
ic:0, icmax:0, Lon3:[],
wL:scanmap(lambda([u],
if listp(u) and u[1] = "*" then (
ic:0, Lon3 : [],
u:scanmap(lambda([v],
if listp(v) and v[1]=on3 and freeof(ev(var),v[2]) = false
then (ic:ic+1,c2show("** find ",ic,v),
Lon3 : append(Lon3,[v]),
v:sconcat("<<here-",ic,">>"),v)
else v),u), /* end of u-scanmap */
icmax : max(icmax,ic),
if ic > 1 then (
c1show(Lon3),
c1show(on3rngm_new(Lon3[1],Lon3[2]))
),
u
) else u), wL), /* end of wL-scanmap */
c1show(wL),
if icmax < 2 then (
c1show(icmax," <- 2未満より続行可能")
),
if icmax > 1 then (
c1show("ERROR: 同一変数varのon3関数の積 on3(var,..)*on3(var,..)を検出した -> 実行停止")
),
return(icmax)
)$ /* end of on3_same_var() */
/*#########################################################################*/
/** on3byon3():同一変数varに関するon3()関数の積の評価 2020.08.05 **/
/*#########################################################################*/
on3byon3([args]) := block([progn:"<on3byon3>",debug,
func, x,xw, wL, xli,xri,lri, xlj,xrj,lrj, il,ir,jl,jr, wl,wr,wlr,wout],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3byon3('help)--
機能: 同一変数varに関するon3()関数の積を評価する
文法: on3byon3(on3func) or on3r(on3funcL)
例示: on3byon3(on3(x,1,3,co)*on3(x,2,4,co)) -> on3(x,2,3,co)
on3byon3([[on3,x,1,3,co],[on3,x,2,4,co]],debug1) -> on3(x,2,3,co)
--end of on3byon3('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3byon3('ex)--"),
block([exL,ansL,sc,sansL,x,ex,ans,exundef,a,b,c,d,title,out,
cond,c1,c2,c3,c4,c5,c6],
exL : makelist(null,3), ansL : makelist(null,3),
exL[1] : on3(x,2,5,co)*on3(x,4,6,co), ansL[1]: on3(x,4,5,co),
exL[2] : on3(x,2,5,co)*on3(x,a,b,co), ansL[2]: unknown,
exL[3] : on3(x,minf,inf,oo)*on3(x,a,b,co), ansL[3]: on3(x,a,b,co),
exundef : on3(x,a,b,co)*on3(x,c,d,co),
/* 注意: "c1: assume(a<=b,b<=c,c<=d)" とするとエラーとなる */
sc[1] : "c1: assume(a<=b,b<c,c<=d)", sansL[1]: 0,
sc[2] : "c2: assume(a<c,c<b,b<d)", sansL[2]: on3(x,c,b,co),
sc[3] : "c3: assume(a<c,c<d,d<b)", sansL[3]: on3(x,c,d,co),
sc[4] : "c4: assume(c<a,a<=b,b<d)", sansL[4]: on3(x,a,b,co),
sc[5] : "c5: assume(c<a,a<d,d<b)", sansL[5]: on3(x,a,d,co),
sc[6] : "c6: assume(c<=d,d<a,a<=b)", sansL[6]: 0,
if true then (
print("== 未定端点とon3積 =="),
for exans in [[exL[1],ansL[1]],[exL[2],ansL[2]],[exL[3],ansL[3]]] do (
ex : exans[1], ans : exans[2],
c0show("例 ",ex),
chkshow("on3byon3(ex)",on3byon3(ex),ans)
) /* end of for-exans */
),
if true then (
print("== 仮定とon3積 =="),
for cL in [[sc[1],c1,sansL[1]],[sc[2],c2,sansL[2]],
[sc[3],c3,sansL[3]],[sc[4],c4,sansL[4]],
[sc[5],c5,sansL[5]],[sc[6],c6,sansL[6]]] do (
c0show("例 : 仮定",cL[1]),
if false then kill(a,b,c,d),
c1show(stringp(cL[1])),
eval_string(cL[1]),
c1show(cL[1]), cashow(sort([a,b,c,d],"<=")),
out: on3byon3(exundef),
title : sconcat("on3byon3(on3(x,a,b,co)*on3(x,c,d,co)) with ",cL[1]),
chkshow(title,out,cL[3]),
c1show(cL[2],ev(cL[2])),
forget(ev(cL[2])),
c1show(facts())
) /* end of for-cL */
), /* end of if */
print("--end of on3byon3('ex)--")
),
return("--end of on3byon3('ex)--"),
block_main, /* main ブロック ====================================*/
/* args[1] = on3(x,xli,xri,lri) * on3(x,xlj,xrj,lrj), */
/* args[1] = [[on3,x,xli,xri,lri],[on3,x,xlj,xrj,lrj]] */
if listp(args[1]) and listp(args[1][1]) and args[1][1][1]='on3 then (
[func,x,xli,xri,lri] : args[1][1],
[func,xw,xlj,xrj,lrj] : args[1][2]
),
if listp(args[1]) = false then (
wL : f2l(args[1]),
c1show(wL),
[func,x,xli,xri,lri] : wL[3],
[func,xw,xlj,xrj,lrj] : wL[4]
),
c1show(x,xw,is(x # xw)),
if is(x # xw) then (
c0show(progn,"Error: Not same variable in two on3() functions"),
return(args[1])
),
c1show(xli,xri,lri,xlj,xrj,lrj),
assume(xli<=xri, xlj<=xrj),
wl : max(xli, xlj), wr : min(xri,xrj),
c1show(wl,wr,is(wl<=wr)),
if member(is(wl<=wr), [false]) then (
wout:0, c1show(progn,wout," ← 積の結果"), return(wout)),
if member(is(wl<=wr), [unknown]) then (
wout: unknown, cshow(progn,wout," ← 積の結果"), return(wout)),
/* 開閉 */
il : if member(lri, [co,cc]) then "c" else "o",
ir : if member(lri, [oc,cc]) then "c" else "o",
jl : if member(lrj, [co,cc]) then "c" else "o",
jr : if member(lrj, [oc,cc]) then "c" else "o",
if is(wl=xli) and is(wr=xri) then wlr:eval_string(sconcat(il,ir)),
if is(wl=xli) and is(wr=xrj) then wlr:eval_string(sconcat(il,jr)),
if is(wl=xlj) and is(wr=xri) then wlr:eval_string(sconcat(jl,ir)),
if is(wl=xlj) and is(wr=xrj) then wlr:eval_string(sconcat(jl,jr)),
wout : funmake(on3, [x,wl,wr,wlr]),
c1show(progn,wout," ← 積の結果"),
forget(xli<=xri, xlj<=xrj),
return(wout)
)$ /* end of on3byon3() */
/*############################################################################*/
/*### on3info #########2020.02.23 ###*/
/* expr に含まれる変数varの関数on3(var...)の情報を表示する */
/*############################################################################*/
on3info([args]) := block([progn:"<on3info>",debug,
expr,var, wL,ic,Lon3,Lon3lr0,Lon3lr, on3v,on3f,on3coef,
Lon3v,Lon3f,Lon3coef, undefpnts,outL,outf],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3info('help)--
機能: expr に含まれる変数varの関数on3(var...)の情報をリストで返す
結果のリストはoutLev()
on3多項式を前提とするため,定数項が存在する合も考慮されている(変数毎のon3stdの機能を有する)
引数に'std がある場合は指定された変数に関する標準化の結果を返す
文法: on3info(expr,x,...) or on3info(expr)
on3info(exp,x,'factor)
例示: on3info(f1*log(x)*on3(x,1,2,co)+f0, x,'std)
-> f0*on3(x,minf,1,oo) + (f0+f1)*on3(x,1,2,co) + f0*on3(x,2,inf,co) (標準化)
--end of on3info('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3info('ex)--"),
block([progn:"<on3info_ex>", ex0, ex1, ex2, ex, L:[], out, chk],
print("---begin of on3info_ex---"),
ex0 : f1*log(x)*on3(x,1,2,co)+f0,
c0show("◆ 例0",ex0," <- on3std未処理の場合"),
c0show(on3info(ex0, x)),
c0show("◆ ",on3info(ex0,x,'std)," <- 'std 指定の場合"),
ex1 : on3info(f1*log(x)*on3(x,1,2,co)+f0,x,'std),
c0show("◆ 例1",ex1," <- on3std処理済みの場合"),
c0show(on3info(ex1, x)),
ex2 : f*on3(x,1,3,co)/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)),
c0show("◆ 例2",ex2," <- 有理式の分母に適用した場合"),
c0show(ratdenom(ex2)),
c0show(on3info(ratdenom(ex2),x)),
c0show("◆ 例3",ex3," 第1引数が単変数でない場合"),
ex3 : f1*on3(t-u,1,3,co)+f2*on3(t-u,u,inf,co),
c0show(ex3),
c0show(on3info(ex3,t)),
return("--- end of on3info_ex---")
), /* end of block */
print("--end of on3info('ex)--"),
return("--end of on3info('ex)--"),
block_main, /* main ブロック ====================================*/
expr : args[1],
if length(args) < 2 then var : listofvars(expr)[1] else var : args[2],
if on3_same_var(expr,var) > 1 then (
c0show(progn," ERROR: 同一変数のon3関数の積を検出した"), return("Error in on3info")
),
c2show(progn,"-----"),
retry, /*### retry point ###*/
c1show(progn,expr,var),
wL : f2l(expr),
ic : 0, Lon3 : [], Lon3lr0 : [],
wL : scanmap(lambda([u],
if listp(u) and u[1]=on3 and freeof(ev(var),u[2])=false then (
ic:ic+1, c1show("** find ",ic,u),
Lon3 : append(Lon3,[u]),
Lon3lr0 : append(Lon3lr0,[u[3],u[4]]),
u:sconcat("<<here-",ic,">>"), u) else u), wL),
/* on3検出関数リスト Lon3 とその端点リストLon3lrからon3変数化リストLon3v,on3関数リストLon3fを生成 */
Lon3 : unique(Lon3),
Lon3lr0: unique(Lon3lr0), Lon3lr0 : sort(Lon3lr0, ordermagnitudep),
Lon3lr : delete(minf,Lon3lr0), Lon3lr : delete(inf,Lon3lr),
Lon3v : [], Lon3f : [], Lon3coef : [], undefpnts : [], outf : expr,
if length(Lon3)=0 then (
outL : ['expr=expr,'var=var,
'Lon3=Lon3,'Lon3v=Lon3v,'Lon3f=Lon3f,'Lon3coef=Lon3coef,
'Lon3lr0=Lon3lr0, 'Lon3lr='Lon3lr, 'undefpnts=undefpnts, 'outf=outf],
if member('std, args) then return(outf) else return(outL)
),
outf : 0,
if length(Lon3)>0 then for ic:1 thru length(Lon3) do (
on3v : eval_string(sconcat("on3v_",ic)), /* on3() の変数化 */
Lon3v : endcons(on3v,Lon3v),
on3f : funmake(first(Lon3[ic]),rest(Lon3[ic],1)), /* [on3,x,xl,xr,,xlr] の関数化 */
Lon3f : endcons(on3f,Lon3f),
on3coef : ratcoef(expr,Lon3f[ic]), c1show(on3coef),
if member('factor, args) then on3coef : factor(on3coef), /* add 2020.06.03 */
Lon3coef : endcons(on3coef,Lon3coef),
outf : outf + on3coef * on3f
), /* end of if */
c1show(progn,is(equal(outf,expr))),
if member(is(equal(outf,expr)),[false,unknown]) then (
c1show(progn,"-> on3多項式に定数項が存在 -> 標準化し再試行する"),
expr : outf + (expr-outf)*on3(ev(var),minf,inf,oo),
go(retry)
),
undefpnts : map(numberp,Lon3lr), undefpnts : delete(true,undefpnts),
c1show(Lon3), c1show(Lon3v), c1show(Lon3f), c1show(Lon3coef),
c1show(Lon3lr0), c1show(Lon3lr), c1show(outf), c1show(map(numberp,Lon3lr)),
c1show("端点リスト内の非数値の個数",length(undefpnts)),
outL : ['expr=expr, 'var=var,
'Lon3=Lon3, 'Lon3v=Lon3v, 'Lon3f=Lon3f, 'Lon3coef=Lon3coef,
'Lon3lr0=Lon3lr0, 'Lon3lr=Lon3lr, 'undefpnts=undefpnts, 'outf=outf],
c1show(progn,outL),
c1show(progn,"return---",outf),
if member('std, args) then return(outf) else return(outL)
)$ /* end of on3info */
/*############################################################################*/
/*### outLev #########2020.02.18 ###*/
/* L : [L1=[l11,l12],L2=[l21,l22]]
-> outLev_L1=[l11,l12], outLev_L2=[l21,l22] として参照出来るようにする. */
/*############################################################################*/
outLev([args]) := block([progn:"<outLev>",debug,L,Ll,Lr,prestr,str],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of outLev('help)--
機能: 名前付きリストを展開する
文法: outLev(outL,\"test_\")
例示: outL : [L1=[l11,l12],L2=[l21]]
outLev(outL,\"test_\") -> test_L1=[l11,l12], test_L2=[l21]
--end of outLev('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of outLev('ex)--"),
/* on3predecomp_ex(), */
block([progn:"<outLev('ex)>",debug,ex,x,outL],
debug: ifargd(),
cmds : sconcat("(",
"/* outLev() の実行例 */ @",
"ex : on3(x,a,b,co)*on3(y,yl,yr,oo) + x*on3(x,c,d,cc), @",
"outL : on3info(ex,x), /* on3info()の結果(名前付きリスト)を得る */ @",
"c0show(outL), /* outL の内容確認 */ @",
"outLev(outL,\"test_\"), /* 変数test_* の形で展開 */ @",
"cshow(values) /* 変数一覧で確認する */ @",
")"),
chk2show(cmds,""),
return("-- end of outLev_ex --")
), /* end of block */
print("--end of outLev('ex)--"),
return("--end of outLev('ex)--"),
block_main, /* main ブロック ====================================*/
L : args[1], if length(args)<2 then prestr : "outLev_" else prestr : args[2],
c1show(progn,L),
Ll : map(lhs,L),
Lr : map(rhs,L),
for i:1 thru length(L) do (
str : sconcat(prestr,string(Ll[i])," : ",Lr[i]),
c1show(i,str),
eval_string(str),
c1show(eval_string(str))
), /* end of for */
c1show(progn,values)
)$ /* end of outLev() */
/*############################################################################*/
/* ON3on3 : ON3() -> on3() の変換 2020.02.20 */
/*############################################################################*/
ON3on3([args]) := block([progn:"<ON3on3>",debug,wL,out],
debug:ifargd(),
if listp(args[1]) then wL:args[1] else wL : f2l_full(args[1]),
c1show(progn,"pre-wl",wL),
wL : scanmap(lambda([u],
if listp(u) and u[1]=ON3 then (
u[1] : on3, u) else u), wL),
c1show(progn,"after-WL",wL),
out : l2f(wL),
c1show(progn,out),
return(out)
)$ /* end of ON3on3() */
/*=============================================================================
| num_undef=0 | num_undef=1...2 | num_undef=3...
denom_undef
=0 | denom_decomp | denom_decomp | denom_decomp
num_decomp | num_pre | num_std
=1,2 | denom_pre | denom_pre | denom_pre
| num_decomp | num_pre | num_std
>=3 | denom_X | denom_X | denom_X
===============================================================================*/
/*############################################################################*/
/*### on3undef12 #########2020.03.04 ###*/
/* 指定変数varに関するon3(var,,,,)を含む式(未定端点を含む場合)の排他的区間分解 */
/*############################################################################*/
on3undef12([args]) := block([progn:"<on3undef12>",debug,on3func,var,inv,
w,non3_w,nundef_w,llr,rlr,outL],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3undef12('help)--
機能: 指定変数varに関するon3(var,,,,)を含む式(未定端点を含む場合)の排他的区間分解
引数に'invが指定されると,結果の逆数を返す
条件: on3(var,...):2個, on3(var,minf,inf,oo) を含む,
on3(var,a,b,lr), on3(var,a,{num|inf},...), on3(var,{num|minf},b,lr)
文法: on3undef12(on3func,var,...)
例示:
ex : f0 + f1*on3(x,a,b,co)$
on3undef12(ex,x); /* 1変数の場合は変数xは省略可 */
-> 標準化 f0*on3(x,minf,inf,oo) + f1*on3(x,a,b,co)
-> 分解 f0*on3(x,minf,a,oo) + (f0+f1)*on3(x,a,b,co) + f0*on3(x,b,inf,co)
on3undef12(ex,x,'inv)
-> 1/f0*on3(x,minf,a,oo) + 1/(f0+f1)*on3(x,a,b,co) + 1/f0*on3(x,b,inf,co)
--end of on3undef12('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3undef12('ex)--"),
/* on3predecomp_ex(), */
block([progn:"<on3undef12('ex)>",debug,Lin,f0,f1,a,b,cmds,ans,ex,x,yl,yr],
debug: ifargd(),
Lin : [
[f0+f1*on3(x,a,b,co),
f0*on3(x,minf,a,oo)+(f0+f1)*on3(x,a,b,co)+f0*on3(x,b,inf,co)],
[f0+f1*on3(x,a,3,co),
f0*on3(x,minf,a,oo)+(f0+f1)*on3(x,a,3,co)+f0*on3(x,3,inf,co)],
[f0+f1*on3(x,3,b,co),
f0*on3(x,minf,3,oo)+(f0+f1)*on3(x,3,b,co)+f0*on3(x,b,inf,co)],
[f0+f1*on3(x,minf,b,oo),
(f0+f1)*on3(x,minf,b,oo)+f0*on3(x,b,inf,co)],
[f0+f1*on3(x,a,inf,co),
f0*on3(x,minf,a,oo)+(f0+f1)*on3(x,a,inf,co)]
],
for ic:1 thru length(Lin) do (
cmds : sconcat("(","/* ◆ 例",string(ic)," */ @ ",
"ex : ",string(Lin[ic][1]),",@ ","out : on3undef12(ex,x)",")"),
ans : Lin[ic][2],
chk2show([cmds,ans])
), /* end of for-ic */
ex : f0 + f1*on3(x,a,b,co)*on3(y,yl(x),yr(x),co),
ans : f0*on3(y,minf,yl(x),oo) + (f0+f1*on3(x,a,b,co))*on3(y,yl(x),yr(x),co)
+ f0*on3(y,yr(x),inf,co),
cmds : sconcat("(", "/* ◆ 例 M1 2変量の場合(変数 y に関して) */ @ ",
"ex : ",string(ex),",@ ","out : on3undef12(ex,y) ", ")"),
chk2show([cmds,ans],debug0),
/* M2 */
ex : f0*on3(y,minf,yl(x),oo) + (f0+f1*on3(x,a,b,co))*on3(y,yl(x),yr(x),co)
+ f0*on3(y,yr(x),inf,co),
ans : on3(x,a,b,co)*(f0*on3(y,yr(x),inf,co)+(f1+f0)*on3(y,yl(x),yr(x),co)
+f0*on3(y,minf,yl(x),oo))
+on3(x,b,inf,co)*(f0*on3(y,yr(x),inf,co)+f0*on3(y,yl(x),yr(x),co)
+f0*on3(y,minf,yl(x),oo))
+on3(x,minf,a,oo)*(f0*on3(y,yr(x),inf,co)+f0*on3(y,yl(x),yr(x),co)
+f0*on3(y,minf,yl(x),oo)),
cmds : sconcat("(", "/* ◆ 例 M2 2変量の場合(変数 x に関して) */ @ ",
"ex : ",string(ex),",@ ","out : on3undef12(ex,x) ", ")"),
chk2show([cmds,ans],debug0),
return("-- end of on3undef12_ex --")
), /* end of block */
print("--end of on3undef12('ex)--"),
return("--end of on3undef12('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1],
inv : false, if member('inv, args) then inv:true,
c1show(progn,"◆ ",on3func," ◆"),
c1show(on3typep(on3func), on3vars(on3func), listofvars(on3func)),
if (length(args)=1) and (length(on3vars(on3func))=0) /* 非on3関数 */
then return(ratsimp(on3func))
else if (length(args)=1) and (length(on3vars(on3func))=1) /* 1変数on3関数で変数省略 */
then var : on3vars(on3func)[1]
else if (length(args) > 1) and member(args[2],listofvars(on3func))
then var : args[2] /* 2変数on3関数,変数指定 */
else (c0show("Error in ",progn),return(ratsimp(on3func))),
c1show(var),
/* wdenom に対して,次の分解処理が必要
f0*on3(x,minf,inf,oo)+f1*on3(x,a,b,co)
-> f0*on3(x,minf,a,oo)+(f0+f1)*on3(x,a,b,co)+f0*on3(x,b,inf,co)
f0*on3(x,minf,inf,oo)+f1*on3(x,a,3,co)
-> f0*on3(x,minf,a,oo)+(f0+f1)*on3(x,a,3,co)+f0*on3(x,3,inf,co)
f0*on3(x,minf,inf,oo)+f1*on3(x,3,b,co)
-> f0*on3(x,minf,3,oo)+(f0+f1)*on3(x,3,b,co)+f0*on3(x,b,inf,co)
f0*on3(x,minf,inf,oo)+f1*on3(x,minf,b,oo)
-> (f0+f1)*on3(x,minf,b,oo)+f0*on3(x,b,inf,co)
f0*on3(x,minf,inf,oo)+f1*on3(x,a,inf,co)
-> f0*on3(x,minf,a,oo)+(f0+f1)*on3(x,a,inf,co)
*/
outL : on3info(on3func,var), c1show(outL),
/* on3info(on3func,var) は on3標準化形
f0+f1*on3(var,a,b,co) -> f0*on3(var,minf,inf,oo) + f1*on3(var,a,b,co)
形を outL:(on3func,var),outLev(outL,"w_"),w_outf で返す */
outLev(outL,"w_"),
w : w_outf, out : w, /* w_outf にはon3funcの標準化形が代入される */
non3_w : length(w_Lon3), nundef_w : length(w_undefpnts),
/* 条件: on3(var,...):2個, on3(var,minf,inf,oo) を含む,
on3(var,a,b,lr), on3(var,a,{num|inf},...), on3(var,{num|minf},b,lr)
*/
if non3_w = 2 and member(nundef_w, [1,2])
and member([on3,ev(var),minf,inf,oo],w_Lon3) then (
c1show(progn,"==on3関数:2個, 未定端点数:2個以内, minf,infを含む場合==="),
on3decomp_flag : "done",
for ww in w_Lon3 do (
if member(ww[3],w_Lon3lr) or member(ww[4],w_Lon3lr) then (
if member(ww[5],[cc,co]) then llr:oo,
if member(ww[5],[oc,oo]) then llr:oc,
if member(ww[5],[cc,oc]) then rlr:oo,
if member(ww[5],[co,oo]) then rlr:co,
w : ratsubst(on3(ev(var),minf,ww[3],llr)
+on3(ev(var),ww[3],ww[4],ww[5])
+on3(ev(var),ww[4],inf,rlr),
on3(ev(var),minf,inf,oo),w)
) /* end of if member(ww...) */
), /* end of for */
w : ratexpand(w), /* 2020.12.24 */
outL : on3info(w,var), /* call on3info() */
c1show(progn,outL),
outLev(outL,"out_"),
c1show(out_Lon3f), c1show(out_Lon3coef),
out : 0,
for ic:1 thru length(out_Lon3) do (
if inv=true then out : out + 1/out_Lon3coef[ic] * out_Lon3f[ic]
else out : out + out_Lon3coef[ic] * out_Lon3f[ic]
)
), /* end if no3_w=2 ... */
killvars(["w_","out_"]),
return(out)
)$ /* end of on3udef12() */
/*#######################################################################*/
/*### on3varfix0: on3関数on3(x,xl,xr,xlr)の第1引数xをx_fixに変更する（2019.04.19）###*/
/*#######################################################################*/
on3varfix0([args]) := block([progn:"<on3varfix0>", debug,
on3func,L,on3varsL,var,fix, var_fix, one,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3varfix0('help)--
機能: fix='onのとき on3関数on3(v,vl,vr,vlr)の第1引数vをv_fixに変更する
fix='offのとき 逆の操作を行う.
文法: on3varfix(on3func,var,fix,...)
例示: CS: ex = a*x+b
CS: -> out_on = a*x+b
CS: -> out_off = a*x+b
CS: ex = on3(x,a,b,co)
CS: -> out_on = on3(x_fix,a,b,co)
CS: -> out_off = on3(x,a,b,co)
CS: ex = a*on3(x,a,b,co)*on3(y,c,d,co)
CS: -> out_on = a*on3(x_fix,a,b,co)*on3(y,c,d,co)
CS: -> out_off = a*on3(x,a,b,co)*on3(y,c,d,co)
--end of on3ftrue('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3varfix('ex)--"),
/* ???_ex(), */
block([proogn:"<on3varfix_ex>",debug,ex0,ex1,ex2],
debug:ifargd(),
ex0 : a*x+b,
ex1 : on3(x,a,b,co),
ex2 : a*on3(x,a,b,co)*on3(y,c,d,co),
for ex in [ex0,ex1,ex2] do (
c0show(ex),
out_on : on3varfix0(ex,x,'on),
c0show(" -> ", out_on),
out_off : on3varfix0(out_on,x,'off),
c0show(" -> ", out_off)
),
return("-- end of on3varfix_ex --")
), /* end of block */
print("--end of on3varfix0('ex)--"),
return("--end of on3varfix('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1], var : args[2], fix : args[3],
on3varsL : on3vars(on3func),
c2show(progn, var, fix, on3varsL),
if length(on3varsL) = 0 then return(on3func),
L:f2l(on3func), c1show(L), /* change 2012.01.25, 2019.04.14 */
if L[1] = on3 then L : f2l(one*on3func),
var_fix : eval_string(sconcat(var,"_fix")),
c1show(progn,var,var_fix,fix),
c2show(properties(var),properties(var_fix)),
c1show(progn,"before",L),
if fix='on then (
/* on3(x,xl,xr,xlr)-> on3(x_fix,xl,xr,xlr)とし,積分に反応しないようにする */
L:scanmap(lambda([u],if listp(u) and u[1]='on3 and u[2]=ev(var)
then (u[2]:ev(var_fix), u) else u),L)
) else (
/* on3(x_fix,xl,xr,xlr) -> on3(x,xl,xr,xlr)とする */
L:scanmap(lambda([u],if listp(u) and u[1]='on3 and u[2]=ev(var_fix)
then (u[2]:ev(var), u) else u),L)
/* out1 : ev(l2f(L), ev(var_fix)=ev(var)), cshow(out1) */
),
c1show(progn,"after",L),
out : l2f(L),
c1show(out),
return(out)
)$ /* end of on3varfix0() */
/*############################################################################*/
/*### on3decomp_one ###### 2020.03.06 ###*/
/* 特定変数に着目したon3()関数の排他的領域分解を行う: 変数毎の逐次排他的領域分解
f1(x,y)*on3(x,x1,x2,xlr1)*on3(y,y1,y2,ylr1) の多項式を特定変数xf=xのon3(xf,...)の
{f1(x,y)*on3(y,y1,y2,ylr1)} * on3(xf,x1,x2,xlr1)
の多項式と見なし,それを排他的区分分解を試みる.
条件: 指定した特定変数に関する端点はすべて数値で大小関係は既知とする.
on3info(expr,var,'std)処理済み
例 ex : f1(x)*on3(x,1,3,co) + f2(x)*on3(x,2,5,co)
-> f(x,xf) : f1(x)*on3(xf,1,3,co) + f2(x)*on3(xf,2,5,co)
端点 minf---1---2---3---5---inf
-> f1(x)*on3(xf,1,2,co) + (f1(x)+f2(x))*on3(xf,2,3,co) + f2(x)*on3(xf,3,5,co)
端点の開閉
ev(f(x,xf),xf=1)=f1(x), ev(f(x,xf,xf=1.5)=f1(x), ev(f(x,xf),xf=2)=f1(x)+f2(x)
-> on3(xf,1,2,co)
ev(f(x,xf),xf=2)=f1(x)+f2(x), ev(f(x,xf,xf=2.5)=f1(x)+f2(x), ev(f(x,xf),xf=3)=f2(x)
-> on3(xf,2,3,co)
ev(f(x,xf),xf=3)=f2(x), ev(f(x,xf,xf=4)=f2(x), ev(f(x,xf),xf=5)=0
-> on3(xf,3,5,co)
*/
on3decomp_one([args]) := block([progn:"<on3decomp_one>",debug,
infunc0,inv,var,var_fix,infunc,outL,lrL, ic,evl,evm,evr,wl,wr,wlr,out],
debug : ifargd(), c1show(progn,debug),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3decomp_one('help)--
機能: 変数毎の逐次排他的領域分解:特定変数に着目したon3()関数の排他的領域分解を行う.
引数に'invが指定されると結果の逆数が返される.
条件: 指定した特定変数に関する端点はすべて数値で大小関係は既知とする.
on3info(expr,var,'std)処理済み
文法: on3decomp_one(on3func,var,...)
例示:
ex : f1(x)*on3(x,1,3,co) + f2(x)*on3(x,2,5,co)
-> f(x,xf) : f1(x)*on3(xf,1,3,co) + f2(x)*on3(xf,2,5,co)
端点 minf---1---2---3---5---inf
-> f1(x)*on3(xf,1,2,co) + (f1(x)+f2(x))*on3(xf,2,3,co) + f2(x)*on3(xf,3,5,co)
-> 1/f1(x)*on3(xf,1,2,co) + 1/(f1(x)+f2(x))*on3(xf,2,3,co) + 1/f2(x)*on3(xf,3,5,co)
('inv が指定された場合)
端点の開閉
ev(f(x,xf),xf=1)=f1(x), ev(f(x,xf,xf=1.5)=f1(x), ev(f(x,xf),xf=2)=f1(x)+f2(x)
-> on3(xf,1,2,co)
ev(f(x,xf),xf=2)=f1(x)+f2(x), ev(f(x,xf,xf=2.5)=f1(x)+f2(x), ev(f(x,xf),xf=3)=f2(x)
-> on3(xf,2,3,co)
ev(f(x,xf),xf=3)=f2(x), ev(f(x,xf,xf=4)=f2(x), ev(f(x,xf),xf=5)=0
-> on3(xf,3,5,co)
--end of on3decomp_one('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3decomp_one('ex)--"),
block([progn:"<on3decomp_one('ex)>",cmds,ans,ex,f,f1,f2,f20,f0,fy,fyx,vL],
cmds : sconcat("(","/* 例1. 排他的区分分解 */ @",
"ex : f1(x)*on3(x,minf,3,co) + f2(x)*on3(x,2,5,cc), @",
"f : on3decomp_one(ex,x) @",
")"),
ans : f1(x)*on3(x,minf,2,oo)+f2(x)*on3(x,3,5,cc)+(f2(x)+f1(x))*on3(x,2,3,co),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例2-1. 2変量関数を変数yで分解 */ @",
"f20 : f1(x,y)*on3(x,1,8,co)*on3(y,minf,3,oo) + f2(x,y)*on3(y,2,5,cc), @",
"fy : on3decomp_one(f20,y) @",
")"),
/*
ans : on3(x,1,8,co)*f1(x,y)*on3(y,minf,2,oo)
+on3(x,minf,inf,oo)*f2(x,y)*on3(y,3,5,cc)
+(on3(x,minf,inf,oo)*f2(x,y)+on3(x,1,8,co)*f1(x,y))*on3(y,2,3,co),
*/
ans : on3(x,1,8,co)*f1(x,y)*on3(y,minf,2,oo)
+f2(x,y)*on3(y,3,5,cc)
+(f2(x,y)+on3(x,1,8,co)*f1(x,y))*on3(y,2,3,co),
chk2show(cmds,ans),
cmds : sconcat("(",
"/* 例2-2. fy を変数xで分解 */ @",
"fy : ratexpand(fy), fyx : on3decomp_one(fy,x) @",
")"),
ans : on3(x,1,8,co)
*(f1(x,y)*on3(y,minf,2,oo)+f2(x,y)*on3(y,3,5,cc)
+f2(x,y)*on3(y,2,3,co)+f1(x,y)*on3(y,2,3,co))
+on3(x,minf,1,oo)*(f2(x,y)*on3(y,3,5,cc)+f2(x,y)*on3(y,2,3,co))
+on3(x,8,inf,co)*(f2(x,y)*on3(y,3,5,cc)+f2(x,y)*on3(y,2,3,co)) ,
chk2show(cmds,ans),
c0show("●",ev(fy,y=2)),
return("-- end of on3decomp_one('ex) --")
), /* end of block */
print("--end of on3decomp_one('ex)--"),
return("--end of on3decomp_one('ex)--"),
block_main, /* main ブロック ====================================*/
infunc0 : args[1], var : args[2],
inv : false, if member('inv, args) then inv : true,
c1show("▶ ",progn," START ", var, inv),
c2show(infunc0),
if true then infunc0 : on3info(infunc0,var,'std),
if true then (c1show(progn,on3typep(infunc0),on3vars(infunc0)) ),
var_fix : eval_string(sconcat(var,"_fix")),
c1show(var_fix),
c1show(on3varfix0(infunc0,ev(var),'on)), /* ??? */
infunc : on3varfix0(infunc0,ev(var),'on),
c1show(progn,infunc0,var,var_fix),
c1show(progn,infunc),
outL : on3info(infunc,ev(var_fix)),
c1show(progn,outL),
outLev(outL,"w_"),
lrL : sort(w_Lon3lr0, ordermagnitudep),
killvars("w_"),
c1show(progn,lrL),
out : 0,
for ic:1 thru length(lrL)-1 do (
evl : ev(infunc,ev(var_fix)=lrL[ic]),
evm : ev(infunc,ev(var_fix)=(lrL[ic]+lrL[ic+1])/2),
evr : ev(infunc,ev(var_fix)=lrL[ic+1]),
wlr : "xx",
if member(is(equal(evm,evl)),[true]) and is(equal(lrL[ic],minf))=false
then wl:"c" else wl:"o",
if member(is(equal(evm,evr)),[true]) and is(equal(lrL[ic+1],inf))=false
then wr:"c" else wr:"o",
wlr : eval_string(sconcat(wl,wr)),
c1show(ic,lrL[ic],lrL[ic+1],evl,evm,evr,wl,wr,wlr),
c1show(is(equal(evm,evl)),is(equal(evm,evr)) ),
if inv=true then out : out + 1/evm * on3(ev(var),lrL[ic],lrL[ic+1],wlr)
else out : out + evm * on3(ev(var),lrL[ic],lrL[ic+1],wlr)
),
c1show(progn,"結果 ◆",var,inv,out),
return(out)
)$ /* end of on3decomp_one() */
/*############################################################################*/
/*### killvars #########2020.03.11 ###*/
/* values; で表示される変数リストからkeysで指定された変数を(一括)削除する */
/*############################################################################*/
killvars([args]):=block([progn:"<killvars>",debug,keys,key,str,svL],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of killvars('help)--
機能: values; で表示される変数リストからkeysで指定された変数を(一括)削除する
文法: killvars([\"denom_\",\"numer_\",\"w_\",\"out_\"],...)
例示:
values;
killvars([\"denom_\",\"numer_\",\"w_\",\"out_\"]);
values;
--end of killvars('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of killvars('ex)--"),
block([progn:"<killvars('ex)>",debug],
debug: ifargd(),
c0show("現在の変数リスト:",values),
c0show(killvars(["denom_","numer_","w_","out_"])),
c0show("上記処理後の変数リスト:",values),
return("-- end of killvars_ex --")
), /* end of block */
print("--end of killvars('ex)--"),
return("--end of killvars('ex)--"),
block_main, /* main ブロック ====================================*/
if listp(args[1])=false then keys:[args[1]] else keys:args[1],
svL : [], /* keys:["denom_","numer_","w_","out_"], */
for i:1 thru length(keys) do (
key : keys[i],
for j:1 thru length(values) do (
if ssearch(key,string(values[j])) > 0 then svL:endcons(string(values[j]),svL)
),
c1show(svL),
for j:1 thru length(svL) do (
str : sconcat("kill(",svL[j],")"), eval_string(str)
)
),
c1show(progn,"after",values),
return(values)
)$ /* end of killvars() */
/*=== on3関数式の分類と排他的領域分解 =================================================
1. 非on3式 f1*(x-1)/(f2*(x^2-1)) -> f1/(f2*(x+1))
2. on3多項式 f0 + f1*on3(x,1,3,co) + f2*on3(x,a,b,co) + ...
ただし f0 = f0*on3(x,minf,inf,oo), a,b:未定端点(暗黙仮定:a<=b)
2-1. on3多項式(未定端点なし)
f0 + f1*on3(x,1,3,co) + f2*on3(x,2,5,co)
-> f0*on3(x,minf,1,oo) + (f0+f1)*on3(x,1,2,co) + (f01+f1+f2)*on3(x,2,3,co)
+ (f0+f2)*on3(x,3,5,co) + f0*on3(x,5,inf,co)
2-2. on3多項式(on3関数:2個以内,未定端点:2個以内)
f0 + f1*on3(x,a,b,co)
-> f0*on3(x,minf,a,oo) + (f0+f1)*on3(x,a,b,co) + f0*on3(x,b,inf,co)
3. on3有理式(分子:非on3式)
3-1. 分母:on3多項式(未定端点なし)
1/(f0 + f1*on3(x,1,3,co))
-> 1/f0*on3(x,minf,1,oo) + 1/(f0+f1)*on3(x,1,3,co) + 1/f0*on3(x,3,inf,co)
3-2. 分母:on3多項式(on3関数:2個以内,未定端点:2個以内)
1/(f0 + f1*on3(x,a,b,co))
-> 1/f0*on3(x,minf,a,oo) + 1/(f0+f1)*on3(x,a,b,co) + 1/f0*on3(x,b,inf,co)
4. on3有理式(分子,分母ともon3多項式)
4-1. 分母:未定端点なし,分子:未定端点なし
(f10 + f11*on3(x,1,3,co)) / (f20 + f21*on3(x,2,4,co))
-> ( f10*on3(x,minf,1,oo) + (f10+f11)*on3(x,1,3,co) + f10*on3(x,3,inf,co) ) *
( 1/f20*on3(x,minf,2,oo) + 1/(f20+f21)*on3(x,2,4,co) + 1/f20*on3(x,4,inf,co) )
-> f10/f20*on3(x,minf,1,oo) + f10/(f20+f21)*on3(x,1,2,co)
+ (f10+f11)/(f20+f21)*on3(x,2,3,co) + f10/(f20+f21)*on3(x,3,4,co)
+ f10/f20*on3(x,4,inf,co)
4-2. 分母:未定端点なし,分子:未定端点あり (あり:on3関数:2個以内,未定端点:2個以内)
(f10 + f11*on3(x,a,b,co)) / (f20 + f21*on3(x,2,4,co))
-> ( f10*on3(x,minf,a,oo) + (f10+f11)*on3(x,a,b,co) + f10*on3(x,b,inf,co) ) *
( 1/f20*on3(x,minf,2,oo) + 1/(f20+f21)*on3(x,2,4,co) + 1/f20*on3(x,4,inf,co) )
4-3. 分母:未定端点あり,分子:未定端点なし (あり:on3関数:2個以内,未定端点:2個以内)
(f10 + f11*on3(x,1,3,co)) / (f20 + f21*on3(x,a,b,co))
-> ( f10*on3(x,minf,1,oo) + (f10+f11)*on3(x,1,3,co) + f10*on3(x,3,inf,co) ) *
( 1/f20*on3(x,minf,a,oo) + 1/(f20+f21)*on3(x,a,b,co) + 1/f20*on3(x,b,inf,co) )
4-4. 分母:未定端点あり,分子:未定端点あり (あり:on3関数:2個以内,未定端点:2個以内)
(f10 + f11*on3(x,a,b,co)) / (f20 + f21*on3(x,c,d,co))
-> ( f10*on3(x,minf,a,oo) + (f10+f11)*on3(x,a,b,co) + f10*on3(x,b,inf,co) ) *
( 1/f20*on3(x,minf,c,oo) + 1/(f20+f21)*on3(x,c,d,co) + 1/f20*on3(x,d,inf,co) )
=============================================================================*/
/*############################################################################*/
/*### on3predecomp #########2020.01.31 ###*/
/* 指定変数Varに関するon3(var,,,,)関数式の排他的区分分解を試みる */
/*############################################################################*/
on3predecomp([args]) := block([progn:"<on3predecomp>",debug,on3func,var,
wdenom,wnumer,outL,non3_denom,non3_numer,nundef_denom,nundef_numer,
on3decomp_flag,winv,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3predecomp('help)--
機能: 指定変数varに関するon3(var,,,,)関数式の排他的区分分解を変数var毎に試みる
on3有理式,未定端点(2個以内)に対応する
比較 : on3decomp()は未定端点無しの場合に多変数領域の排他的領域分解を与える
文法: on3predecomp(on3func,var,...)
例示:
ex : f0 + f1*on3(x,a,b,co),
on3predecomp(ex,x),
-> f0*on3(x,minf,a,oo) + (f0+f1)*on3(x,a,b,co) + f0*on3(x,b,inf,co)
on3predecomp(1/(f0 + f1*on3(x,1,3,co)), x),
-> 1/f0*on3(x,minf,1,oo) + 1/(f0+f1)*on3(x,1,3,co) + 1/f0*on3(x,3,inf,co)
on3predecomp(1/(f0 + f1*on3(x,a,b,co)), x),
-> 1/f0*on3(x,minf,a,oo) + 1/(f0+f1)*on3(x,a,b,co) + 1/f0*on3(x,b,inf,co)
--end of on3predecomp('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3predecomp('ex)--"),
/* on3predecomp_ex(), */
block([progn:"<on3predecomp('ex)>",debug,ex2,ex3,ex,x,out],
debug: ifargd(),
ex2 : 1/(f0+f1*on3(x,a,b,co)),
ex3 : f*on3(x,a,b,co)/(f0+f1*on3(x,1,3,co)),
for ex in ['ex2,'ex3] do (
c0show(" ◆ 例: ",ex,ev(ex)), ex:ev(ex),
c0show(on3predecomp(ex,x))
),
return("-- end of on3predecomp_ex --")
), /* end of block */
print("--end of on3predecomp('ex)--"),
return("--end of on3predecomp('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1],
c2show(progn,"◆ ",on3func,"◆"),
c2show(on3typep(on3func), on3vars(on3func), listofvars(on3func)),
if (length(args)=1) and (length(on3vars(on3func))=0) /* 非on3関数 */
then return(ratsimp(on3func))
else if (length(args)=1) and (length(on3vars(on3func))=1) /* 1変数on3関数で変数省略 */
then var : on3vars(on3func)[1]
else if (length(args) > 1) and member(args[2],listofvars(on3func))
then var : args[2] /* 2変数on3関数,変数指定 */
else (c0show(" ◆◆◆ Error in ",progn),return(ratsimp(on3func))),
c2show(var),
/* on3func を分子,分母に分け,分母に変数varに関する関数on3(var,...)が含まれているかを検査する */
wdenom : ratdenom(on3func), c1show(wdenom), wdenom : on3info(wdenom,var,'std),
cshow(progn,wdenom),
wnumer : ratnumer(on3func), c1show(wnumer), wnumer : on3info(wnumer,var,'std),
wnumer : ratdisrep(wnumer), wdenom : ratdisrep(wdenom),
c2show(progn,wdenom),
c2show(progn,wnumer),
/* 分母のon3info */
outL : on3info(wdenom,var), /* call on3info() */
cshow(progn,"分母",outL),
c2show(progn,"分母",outL),
outLev(outL,"denom_"), /* 名前付きリストからその内容リストを生成する */
c3show(progn,values),
c3show(denom_undefpnts),
/* 分子のon3info() */
outL : on3info(wnumer,var),
cshow(progn,"分子",outL),
/*
if is(rhs(outL[3])=[]) then return(" ◆◆◆ Error in 分子のon3info()"),
*/
c2show(progn,"分子",outL),
outLev(outL,"numer_"),
c3show(numer_undefpnts),
/* non3_denom, non3_numer : 変数var に関する on3(var,...)の個数 */
/* nundef_denom, nundef_numer : 変数var に関するon3関するの未定な端点の個数 */
non3_denom : length(denom_Lon3), nundef_denom : length(denom_undefpnts),
non3_numer : length(numer_Lon3), nundef_numer : length(numer_undefpnts),
c2show(progn,"分母: ",non3_denom,nundef_denom),
c2show(progn,"分子: ",non3_numer,nundef_numer),
c2show(progn,"分母: ",wdenom),
c2show(progn,"分子: ",wnumer),
if (nundef_denom > 2) or (nundef_numer > 2) then (
cshow(progn,"-> (0) 分母または分子に3個以上の未定端点が存在する->無処理"),
killvars(["denom_","numer_"]),
return(on3func)
),
if (non3_denom=0) and (non3_numer=0) then (
cshow(progn,"◆ --> (1) 非on3関数"),
out : ratsimp(on3func),
c1show(progn,"◆ 結果(1)->",out),
killvars(["denom_","numer_"]),
return(out)
),
if (non3_denom=0) and (non3_numer>0) then (
cshow(progn,"◆ --> (2) 非on3関数(分母) -> on3多項式"),
if nundef_numer=0 then (
c2show(progn,"(2-1) on3decomp_one(wnumer,var)"),
wnumer : on3decomp_one(wnumer,var),
c2show("->",wnumer),
out : ev(wnumer/wdenom, on3simp),
c1show(progn,"◆ 結果(2-1)->",out),
killvars(["denom_","numer_"]),
return(out)
),
if (non3_numer=2) and member(nundef_numer,[1,2]) then (
out : on3undef12(wnumer,var),
c2show("(2-2) on3udef12(wnumer,var):",out),
out : out / wdenom,
c1show(progn,"◆ 結果(2-2)->",out),
killvars(["denom_","numer_"]),
return(out)
), /* end of (2-2) */
if nundef_numer > 2 then (
c1show("結果(2-3x) 分子の未定端点数が3個以上存在する -> 無処理"),
killvars(["denom_","numer_"]),
return(on3func)
),
c1show("(2) 想定外のケースを検出 -> 無処理"), return(on3func)
), /* end of (2) */
if (non3_denom > 0) and (non3_numer = 0) then (
c2show(progn,"◆ --> (3) 非on3関数(分子), on3多項式(分母)"),
if nundef_denom=0 then (
c2show(progn,"(3-1) on3decomp_one(wdenom,var,'inv')"),
wdenom : on3decomp_one(wdenom,var,'inv),
c2show("->",wdenom),
out : ev(wnumer*wdenom, ratexpand, on3simp),
c1show(progn,"◆ 結果(3-1)->",out),
killvars(["denom_","numer_"]),
return(out)
),
if (non3_denom=2) and member(nundef_denom,[1,2])
and (length(denom_Lon3lr)=2) then (
winv : on3undef12(wdenom,var,'inv),
c2show("(3-2) on3udef12(wdenom,'inv):",winv),
out : ev(wnumer * winv),
c1show(progn,"◆ 結果(3-2)->",out),
killvars(["denom_","numer_"]),
return(out)
), /* end of (3-2) */
if nundef_numer > 2 then (
c1show("結果(3-3x) 分子の未定端点数が3個以上存在する -> 無処理"),
killvars(["denom_","numer_"]),
return(on3func)
),
c1show("結果(3) サポート外のケースを検出 -> 無処理"), return(on3func)
), /* end of (3) */
if (non3_denom > 0) and (non3_numer > 0) then (
c2show(progn,"◆ --> (4) on3多項式(分子), on3多項式(分母)"),
if (nundef_denom=0) and (nundef_numer=0) then (
c1show(progn,"(4-1) on3decomp_one(wnumer,var) * on3decomp_one(wdenom,var,'inv)"),
/**********************/
wnumer : on3decomp_one(wnumer,var), outL: on3info(wnumer,var),
c2show(outL), outLev(outL,"numer_"),
wdenom : on3decomp_one(wdenom,var,'inv), outL: on3info(wdenom,var),
c2show(outL), outLev(outL,"denom_"), c1show(outL, denom_outf),
/* out : ev(wnumer * wdenom, ratexpand, on3std, ratexpand), ?? */
out : wnumer * wdenom,
/* out : ev(wnumer * wdenom, ratexpand, on3std), */
c1show("wnumer*wdenom-inv ->",out),
out : letsimp(out,on3rule2),
out : on3info(out,var,'std),
c1show("---",on3info(out,var,'std)),
c1show(progn,"◆ 結果(4-1)->",out),
killvars(["denom_","numer_"]),
return(out)
),
if (nundef_denom=0) and member(nundef_numer,[1,2]) then (
c2show(progn,"(4-2) on3decomp_one(wdenom,var,'inv) and on3undef12(wnumer,var)"),
c2show(wdenom,var),
winv : on3decomp_one(wdenom,var,'inv),
out : on3undef12(wnumer,var),
c2show("(2-2) on3udef12(wnumer,var):",out),
out : out * winv,
c1show(progn,"◆ 結果(4-2)->",out),
killvars(["denom_","numer_"]),
return(out)
),
if (nundef_numer=0) and member(nundef_denom,[1,2]) and (non3_denom=2) then (
c2show(progn,"(4-3) on3decomp_one(wnumer,var) and on3undef12(wdenom,var,'inv)"),
wnumer : on3decomp_one(wnumer,var),
winv : on3undef12(wdenom,var,'inv),
c2show(winv,wnumer),
out : ev(wnumer * winv),
c2show("->",out),
out : ev(out, on3simp),
c1show(progn,"◆ 結果(4-3)->",out),
killvars(["denom_","numer_"]),
return(out)
),
if member(nundef_numer,[1,2]) and member(nundef_denom,[1,2]) and (non3_denom=2) then (
c2show(progn,"(4-4) on3undef12(wnumer,var) and on3undef12(wdenom,var,'inv)"),
wnumer : on3undef12(wnumer,var),
winv : on3undef12(wdenom,var,'inv),
c2show(winv,wnumer),
out : ev(wnumer * winv),
killvars(["denom_","numer_"]),
out : ev(out, on3simp),
c1show(progn,"◆ 結果(4-4)->",out),
return(out)
),
cshow("◆ 結果(4) 想定外のケースを検出 -> 無処理"), return(on3func)
), /* end of (4) */
return(on3func)
)$ /* end of on3predecomp() */
/*############################################################################*/
/*### on3predecomp_ex #########2020.03.24 ###*/
/*############################################################################*/
on3predecomp_ex([args]) := block([progn:"<on3predecomp_ex>",debug,Lin,cmds,ans],
debug : ifargd(),
c0show("/* on3関数式の分類と排他的領域分解 */"),
Lin : [
["/* on3関数式の分類と排他的領域分解 */"],
["/* 1. 非on3式 */", f1*(x-1)/(f2*(x^2-1)), f1/(f2*(x+1))],
["/* 2. on3多項式 f0 + f1*on3(x,1,3,co) + f2*on3(x,a,b,co) + ... @",
" ただし f0 = f0*on3(x,minf,inf,oo), a,b:未定端点(暗黙仮定:a<=b) */ "],
["/* 2-1. on3多項式(未定端点なし) */ @",
f0 + f1*on3(x,1,3,co) + f2*on3(x,2,5,co),
f0*on3(x,minf,1,oo) + (f0+f1)*on3(x,1,2,co) + (f0+f1+f2)*on3(x,2,3,co)
+ (f0+f2)*on3(x,3,5,co) + f0*on3(x,5,inf,co)],
["/* 2-2. on3多項式(on3関数:2個以内,未定端点:2個以内) */ @",
f0 + f1*on3(x,a,b,co),
f0*on3(x,minf,a,oo) + (f0+f1)*on3(x,a,b,co) + f0*on3(x,b,inf,co)],
["/* 3. on3有理式(分子:非on3式) */ @"],
["/* 3-1. 分母:on3多項式(未定端点なし) */ @",
1/(f0 + f1*on3(x,1,3,co)),
1/f0*on3(x,minf,1,oo) + 1/(f0+f1)*on3(x,1,3,co) + 1/f0*on3(x,3,inf,co)],
["/* 3-2. 分母:on3多項式(on3関数:2個以内,未定端点:2個以内) */ @",
1/(f0 + f1*on3(x,a,b,co)),
1/f0*on3(x,minf,a,oo) + 1/(f0+f1)*on3(x,a,b,co) + 1/f0*on3(x,b,inf,co)],
["/* 4. on3有理式(分子,分母ともon3多項式) */ @"],
["/* 4-1. 分母:未定端点なし,分子:未定端点なし */ @",
(f10 + f11*on3(x,1,3,co)) / (f20 + f21*on3(x,2,4,co)),
f10/f20*on3(x,minf,1,oo) + (f10+f11)/f20*on3(x,1,2,co)
+ (f10+f11)/(f20+f21)*on3(x,2,3,co) + f10/(f20+f21)*on3(x,3,4,co)
+ f10/f20*on3(x,4,inf,co)],
["/* 4-2. 分母:未定端点なし,分子:未定端点あり (あり:on3関数:2個以内,未定端点:2個以内) */ @",
(f10 + f11*on3(x,a,b,co)) / (f20 + f21*on3(x,2,4,co)),
( f10*on3(x,minf,a,oo) + (f10+f11)*on3(x,a,b,co) + f10*on3(x,b,inf,co) ) *
( 1/f20*on3(x,minf,2,oo) + 1/(f20+f21)*on3(x,2,4,co) + 1/f20*on3(x,4,inf,co) )],
["/* 4-3. 分母:未定端点あり,分子:未定端点なし (あり:on3関数:2個以内,未定端点:2個以内) */ @",
(f10 + f11*on3(x,1,3,co)) / (f20 + f21*on3(x,a,b,co)),
( f10*on3(x,minf,1,oo) + (f10+f11)*on3(x,1,3,co) + f10*on3(x,3,inf,co) ) *
( 1/f20*on3(x,minf,a,oo) + 1/(f20+f21)*on3(x,a,b,co) + 1/f20*on3(x,b,inf,co) )],
["/* 4-4. 分母:未定端点あり,分子:未定端点あり (あり:on3関数:2個以内,未定端点:2個以内) */ @",
(f10 + f11*on3(x,a,b,co)) / (f20 + f21*on3(x,c,d,co)),
( f10*on3(x,minf,a,oo) + (f10+f11)*on3(x,a,b,co) + f10*on3(x,b,inf,co) ) *
( 1/f20*on3(x,minf,c,oo) + 1/(f20+f21)*on3(x,c,d,co) + 1/f20*on3(x,d,inf,co) )]
],
c1show(Lin),
for i:1 thru 13 do (
if length(Lin[i]) = 3 then (
cmds : sconcat("(",Lin[i][1]," ex : ", string(Lin[i][2]),
", on3predecomp(ex, x, debug1)",")"),
ans: Lin[i][3],
chk2show(cmds,ans)
)
else c0show("★★ ",Lin[i])
),
return("end of on3predecomp_ex()")
)$ /* end of on3predecomp_ex() */
/*############################################################################*/
/*### on3predecomp_ex2 #########2020.03.24 ###*/
/*############################################################################*/
on3predecomp_ex2([args]) := block([progn:"<on3predecomp_ex2>",debug,
ex,outy,ansy0,ansy,ansx_inv,exy,outyx,cmds,ans,outL],
debug : ifargd(),
ex : (fy1*on3(y,minf,yr(x),oc)*on3(x,a,inf,co))/(fx0+fx1*on3(x,a,inf,co)),
ansy0 : fy1*on3(y,minf,yr(x),oc)*on3(x,a,inf,co),
ansy : ex,
ansx_inv : 1/fx0*on3(x,minf,a,oo) + 1/(fx0+fx1)*on3(x,a,inf,co),
ans : ansy0 * ansx_inv,
cmds : sconcat("(",
"/* 2変数の場合 */ @",
"ex : ", string(ex), ", @",
"outy : on3predecomp(ex, y, debug1) @",
")"),
chk2show(cmds,ansy),
cshow(outy),
cmds : sconcat("(",
"/* outy */ @",
"exy : ",string(ex), ", @",
"outyx : on3predecomp(exy, x, debug1) @",
")"),
chk2show(cmds,ans),
/* エラー
on3(x,a,inf,co) * on3(x,a,inf,co) -> on3(x,a,inf,co)
on3(x,minf,a,oo) * on3(x,a,inf,co) -> 0
*/
return("end of on3predecomp_ex2")
)$ /* end of on3predecomp_ex2 */
/*############################################################################*/
/*### on3predecomp_ex3 #########2020.03.24 ###*/
/*############################################################################*/
on3predecomp_ex3([args]) := block([progn:"<on3predecomp_ex3>",debug,
ex,ansy0,ansy,ansx_inv,outy,cmds,exy,outyx,ans],
debug : ifargd(),
ex : (fy0+fy1*on3(y,yl(x),yr(x),co))/(fx0+fx1*on3(x,a,b,co)),
ansy0 : (fy0*on3(y,minf,yl(x),oo) + (fy0+fy1)*on3(y,yl(x),yr(x),co) +
fy0*on3(y,yr(x),inf,co)),
ansy : ansy0 / (fx0*on3(x,minf,inf,oo)+fx1*on3(x,a,b,co)),
ansx_inv : 1/fx0*on3(x,minf,a,oo) + 1/(fx0+fx1)*on3(x,a,b,co) +1/fx0*on3(x,b,inf,co),
ans : ansy0 * ansx_inv,
cmds : sconcat("(",
"/* 2変数の場合 */ @",
"ex : ", string(ex), ", @",
"outy : on3predecomp(ex, y, debug1) @",
")"),
chk2show(cmds,ansy),
cshow(outy),
cmds : sconcat("(",
"/* outy */ @",
"exy : ",string(outy), ", @",
"outyx : on3predecomp(exy, x, debug1) @",
")"),
chk2show(cmds,ans),
c1show(outyx),
return("end of on3predecomp_ex3")
)$
/*#####################################################################*/
/* on3decomp : on3一般式の排他的分解処理全般 */
/*#####################################################################*/
on3decomp([args]) := block([progn:"<on3decomp>",debug,nonum,exp0,
Lw:[],LR:[],wone,ww,w:[],wl:[],fone,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3decomp('help)--
機能: on3一般式の排他的分解処理全般
文法: on3decomp(exp,...)
例示: on3decomp(on3(x,1,2,co)+f0) =
f0*on3(x,minf,1,oo)+f0*on3(x,2,inf,co)+(f0+1)*on3(x,1,2,co)
on3decomp(1/(on3(x,1,2,co)+f0)) =
on3(x,minf,1,oo)/f0+on3(x,2,inf,co)/f0+on3(x,1,2,co)/(f0+1)
--end of on3decomp('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3decomp('ex)--"),
block([progn:"<on3decomp('ex)>",Lex0,L,out],
on3ex(),
Lex0 : [ex14,1/ex14,ex18,ex19, ex1m7, ex1m8,
f1*on3(x,1,2,co),ex1a,ex1b,ex27],
if length(args) > 0 then (
if listp(args[1]) then L:copylist(args[1]) else L:[args[1]]
) else L : copylist(Lex0),
exansL :
[["on3(x,1,2,co)+f0",
"f0*on3(x,minf,1,oo)+f0*on3(x,2,inf,co)+(f0+1)*on3(x,1,2,co)"],
["1/(on3(x,1,2,co)+f0)",
"on3(x,minf,1,oo)/f0+on3(x,2,inf,co)/f0+on3(x,1,2,co)/(f0+1)", "on3show"],
["f1*on3(x,5,7,co)+f1*on3(x,3,5,co)",
"f1*on3(x,3,7,co)", "領域結合"],
["f2*on3(x,2,5,co)+f1*on3(x,1,3,co)+f3*on3(x,0,inf,co)",
sconcat("f3*on3(x,5,inf,co)+(f3+f2)*on3(x,3,5,co)+(f3+f2+f1)*on3(x,2,3,co)",
"+(f3+f1)*on3(x,1,2,co)+f3*on3(x,0,1,co)")],
["on3(x,3,10,co)/(f2*on3(x,2,8,co)+f1*on3(x,1,5,co))",
"on3(x,5,8,co)/f2+on3(x,3,5,co)/(f2+f1)", "on3show"],
["f2*on3(x,2,8,co)+f1*on3(x,1,5,co)",
"f2*on3(x,5,8,co)+(f2+f1)*on3(x,2,5,co)+f1*on3(x,1,2,co)"],
["1/(f2*on3(x,3,7,co)+f1*on3(x,1,5,co))+f0*on3(x,3,5,co)",
"on3(x,5,7,co)/f2+((f0*f2+f0*f1+1)*on3(x,3,5,co))/(f2+f1)+on3(x,1,3,co)/f1",
"on3show"],
["1/((f2*on3(x,3,7,co))/(f22*on3(x,3,5,co)+f21*on3(x,1,3,co))+f1*on3(x,1,5,co))+f0",
sconcat("f0*on3(x,minf,1,oo)+f0*on3(x,5,inf,co)",
"+((f0*f1*f22+f22+f0*f2)*on3(x,3,5,co))/(f1*f22+f2)",
"+((f0*f1+1)*on3(x,1,3,co))/f1"),
"on3show"],
["f0*on3(y,5,6,co)+f1*on3(x,1,2,co)*on3(y,3,4,co)",
sconcat("f0*on3(x,minf,1,oo)*on3(y,5,6,co)+f0*on3(x,1,inf,co)*on3(y,5,6,co)",
"+f1*on3(x,1,2,co)*on3(y,3,4,co)")]
],
print("== on3decomp_ex : 排他的領域分解 =="),
exchk("on3decomp",exansL,debug0),
/* start */
if false then (
cshow(L),
for ex in L do (
print("---<例 排他的領域分解>---"),
ldisplay(ex),
print("---> out:on3decomp(ex,show)"),
out:on3decomp(ex,show),
ldisplay(out)
)
),
return("--- end of on3decomp('ex) ---")
), /* end of block */
print("--end of on3decomp('ex)--"),
return("--end of on3decomp'ex)--"),
block_main, /* main ブロック ====================================*/
exp0 : args[1],
if numberp(exp0) then return(exp0),
if listp(exp) then Lw:copylist(exp0)
else Lw:f2l(ev(exp0,expand,infeval)),
d1show(Lw),
exp : l2f(Lw),
/*** [0] 本処理の適用可能性を調べる ***/
LR:on3lrl(exp), d2show(LR), /* call on3lrl */
for i thru length(LR[1]) do (
nonum:false,
for j:2 thru length(LR[2][i])-1 do
/* if not numberp(LR[2][i][j]) then nonum:true */
if not constantp(LR[2][i][j]) then nonum:true
),
if Lw[1]="+" and nonum then
( cshow("---> on3多項式で領域が未定のため無処理とする"),
if member(show,args) then on3show(exp),
return(exp)),
/*** [1] 不完全on3項の完全on3項化(多項式の整形) : f1*on3(x,xl,xr,lr) + ...
f0 -> f0*on3(x,minf,inf,oo),
f0*on3(y,2,3,co) -> f0*on3(x,minf,inf,oo)*on3(y,2,3,co) ***/
w:LR[1], /* on3変数の取得: call on3vars */
d1show("S1:不完全on3項の完全on3項化開始 "),
wone : 1, for i thru length(w) do wone:wone*on3(w[i],minf,inf,oo),
d1show("begin on3one",Lw,w,wone),
Lw:scanmap(lambda([u],
if listp(u) and u[1]="+" then (
d2show("start scanmap:",u),
for i:2 thru length(u) do (
/* call on3rule2 and l2f, f2l */
d2show(l2f(u[i])),
ww :l2f(u[i])*wone,
ww : letsimp(ww,on3rule2), /*** on3rule5 ではない!!***/
/* ww : ratsubst(on3,ON3,ww), */ ww : ON3on3(ww),
d1show("--letsimp(ww)-->",ww),
wl:partition(fone*ww,on3),
d2show(i,wl),
if listp(u[i]) and member("/",flatten(u[i])) then u[i]
else u[i]:["*",wl[1],f2l(wl[2])]
), /* end of for-i */
d2show("end of do",u), u ) else u), Lw), /* end of scanmap */
Lw : ev(Lw,fone=1,infeval),
d1show("S1:不完全on3項の完全on3項化の結果",l2f(Lw)),
/*** [2] 排他的区間処理(on3decomp_decomp)と
逆数処理(on3decomp_inv)の必要箇所をマーキング ***/
d2show("before attempt",Lw),
Lw:scanmap(lambda([u],
if listp(u) and (u[1]="+" or u[1]="-") and member(on3,flatten(u)) then (
u : ['('on3decomp_decomp),u], d2show(u), u
) else u), Lw, bottomup),
Lw:scanmap(lambda([u],
if listp(u) and u[1]="/" and member(on3,flatten(u[3])) then (
u : ["*", u[2], ['('on3decomp_inv), u[3]]]
) else u), Lw, bottomup),
d1show("S2:マーキングの結果",Lw,l2f(Lw)),
/*** [3] on3decomp_decomp と on3decomp_inv の評価 ***/
out : ev(l2f(Lw),fone=1,infeval),
out : on3ev(on3simp(out),factor), /* <------------------- */
d2show(out),
/*** 出力形式の指定 ***/
if member(show,args) then on3show(out),
if member(list,args) then return(f2l(out)) else return(out)
)$
/*--- on3decomp_ex -------------------------------------------- */
on3decomp_ex([args]) := block([progn:"<on3decomp_ex>",Lex0,L,out],
on3ex(),
Lex0 : [ex14,1/ex14,ex18,ex19, ex1m7, ex1m8,
f1*on3(x,1,2,co),ex1a,ex1b,ex27],
if length(args) > 0 then (
if listp(args[1]) then L:copylist(args[1]) else L:[args[1]]
) else L : copylist(Lex0),
exansL :
[["on3(x,1,2,co)+f0",
"f0*on3(x,minf,1,oo)+f0*on3(x,2,inf,co)+(f0+1)*on3(x,1,2,co)"],
["1/(on3(x,1,2,co)+f0)",
"on3(x,minf,1,oo)/f0+on3(x,2,inf,co)/f0+on3(x,1,2,co)/(f0+1)", "on3show"],
["f1*on3(x,5,7,co)+f1*on3(x,3,5,co)",
"f1*on3(x,3,7,co)", "領域結合"],
["f2*on3(x,2,5,co)+f1*on3(x,1,3,co)+f3*on3(x,0,inf,co)",
sconcat("f3*on3(x,5,inf,co)+(f3+f2)*on3(x,3,5,co)+(f3+f2+f1)*on3(x,2,3,co)",
"+(f3+f1)*on3(x,1,2,co)+f3*on3(x,0,1,co)")],
["on3(x,3,10,co)/(f2*on3(x,2,8,co)+f1*on3(x,1,5,co))",
"on3(x,5,8,co)/f2+on3(x,3,5,co)/(f2+f1)", "on3show"],
["f2*on3(x,2,8,co)+f1*on3(x,1,5,co)",
"f2*on3(x,5,8,co)+(f2+f1)*on3(x,2,5,co)+f1*on3(x,1,2,co)"],
["1/(f2*on3(x,3,7,co)+f1*on3(x,1,5,co))+f0*on3(x,3,5,co)",
"on3(x,5,7,co)/f2+((f0*f2+f0*f1+1)*on3(x,3,5,co))/(f2+f1)+on3(x,1,3,co)/f1",
"on3show"],
["1/((f2*on3(x,3,7,co))/(f22*on3(x,3,5,co)+f21*on3(x,1,3,co))+f1*on3(x,1,5,co))+f0",
sconcat("f0*on3(x,minf,1,oo)+f0*on3(x,5,inf,co)",
"+((f0*f1*f22+f22+f0*f2)*on3(x,3,5,co))/(f1*f22+f2)",
"+((f0*f1+1)*on3(x,1,3,co))/f1"),
"on3show"],
["f0*on3(y,5,6,co)+f1*on3(x,1,2,co)*on3(y,3,4,co)",
sconcat("f0*on3(x,minf,1,oo)*on3(y,5,6,co)+f0*on3(x,1,inf,co)*on3(y,5,6,co)",
"+f1*on3(x,1,2,co)*on3(y,3,4,co)")]
],
print("== on3decomp_ex : 排他的領域分解 =="),
exchk("on3decomp",exansL,debug0),
/* start */
if false then (
cshow(L),
for ex in L do (
print("---<例 排他的領域分解>---"),
ldisplay(ex),
print("---> out:on3decomp(ex,show)"),
out:on3decomp(ex,show),
ldisplay(out)
)
),
return("--- end of on3decomp_ex ---")
)$
/*--- fsplit: on3show.mx -----------------------------------------------*/
/*#####################################################################*/
/* <on3show>: on3関数式の表示 */
/*######################################################################*/
on3show([args]) ::= block([debug, funcs, u, out:[]],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3show('help)--
機能: on3関数式の表示
文法: on3show(funcs)
例示: display2d_old:display2d$ display2d:true$
on3show(on3decomp(f0+f1*on3(x,1,3,co)));
display2d:display2d_old$
on3show(''ex)$ <- 注意
--end of on3show('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3show('ex)--"),
on3show_ex(),
/*
block([],
return('normal_return)
), /* end of block */
*/
print("--end of on3show('ex)--"),
return("--end of on3show('ex)--"),
block_main, /* main ブロック ====================================*/
funcs : args[1],
out : append(out,[""]),
out : append(out,buildq([u:funcs],['u,"=",on3show_sub(u)])), /* on3show_sub */
/* display2d_old:display2d, display2d:true, */
buildq([u:out],print(splice(u)))
/* display2d:display2d_old */
)$ /* end of on3show() */
/*** 副関数 ***/
on3show_sub(funcs,[args]) := block([progn:"<on3show_sub>",debug,
won3:[],out:[],sum,lp:[],lpf,lpo,fone,won3i,
L:[],Lout:[],wi:[],wj:[],wjout,workh,M],
debug:ifargd(),
L:f2l(funcs), d1show(L),
/*** S1: 前処理 *************************************************/
if not listp(L) or not member(on3,flatten(L)) then return(funcs),
if listp(L) and L[1]="*" and listp(L[2]) and not member(on3,L[2])
and on3typep(L[3])=on3poly
then ( for i:2 thru length(L[3]) do L[3][i][2] : L[3][i][2]*L[2],
L : L[3], d2show(L), funcs : l2f(L) ),
if not L[1] = "+" then return(funcs),
/*** S2: 排他処理済みon3多項式の関数部の整理した結果を返す ***/
/*-----------------------------------------------------------
f0*on3(x,2,inf,co) + (f1+f0)*on3(x, 1, 2, co)
-> [[f1+f3,[[x,1,2,co]]], [f2, [[on3,x,3,4,co]]]]
f1*on3(x,1,3,co)*on3(y,2,6,co)+f2*on3(x,3,5,co)*on3(y,2,4,co)
-> [[f1,[[x,1,3,co],[y,2,6,co]]],[f2,[[x,3,5,co],[y,2,4,co]]]]
-----------------------------------------------------------------*/
won3:[], out:[],
for i:2 thru length(L) do (
won3 : cons(cons("*",partition(L[i],on3)[2]), won3) ),
won3:unique(won3),
d2show(won3,length(won3)),
out:["+"],
for i:1 thru length(won3) do (
sum :0, won3i : l2f(won3[i]),
for j:2 thru length(L) do (
lp : partition(fone*l2f(L[j]),on3),
lpf : ev(l2f(lp[1]),fone=1), lpo : l2f(lp[2]),
if lpo*won3i = lpo then sum : sum + lpf
), /* end of for j */
out : endcons(["*",sum,won3[i]],out),
d2show(i,out)
), /* end of for i */
d2show(out),
/* 演算子を削除 */
out:scanmap(lambda([u],if listp(u) then u:rest(u,1) else u), out),
/*** S3: 表示処理 *****************************************************/
L : copylist(out), Lout : copylist(out),
d2show(Lout),
for i thru length(L) do (
Lout[i][1] : L[i][1], wi:sconcat(""),
for j thru length(L[i][2]) do ( /* on変数に亘る繰り返し */
wj : L[i][2][j],
d2show(wj,wj[4]),
if wj[4]=cc then wjout:sconcat("(",wj[2]," <= ",wj[1]," <= ",wj[3],")")
else if wj[4]=co then wjout:sconcat("(",wj[2]," <= ",wj[1]," < ",wj[3],")")
else if wj[4]=oc then wjout:sconcat("(",wj[2]," < ",wj[1]," <= ",wj[3],")")
else if wj[4]=oo then wjout:sconcat("(",wj[2]," < ",wj[1]," < ",wj[3],")")
else wjout:"",
wi:sconcat(wi,wjout),
if j < length(L[i][2]) then wi:sconcat(wi," & "),
d2show(wi)
), /* end of for-j */
Lout[i][2] : sconcat(wi), d2show(Lout[i])
), /* end of for-i */
Lout : endcons([0, sconcat("( otherwise )")], Lout),
d2show(Lout),
workh[i,j] := Lout[i][j],
M : genmatrix(workh,length(Lout),2),kill(workh),
return(ev(M))
)$ /* end of on3show_sub() */
/*--- on3show_ex -------------------------------------------- */
on3show_ex([args]) := block([progn:"<on3show_ex>",ex,Lex0,L,out],
on3ex(),
Lex0 : [ex14,ex28,ex1c,ex1d],
if length(args) > 0 then (
if listp(args[1]) then L:copylist(args[1]) else L:[args[1]]
) else L : copylist(Lex0),
/* start */
display2d_old:display2d, display2d:true,
for ex in L do ( print("---<例 表示>---"),
ldisplay(ex),
print("---> out : on3show(on3decomp(ex))"),
out : on3show(on3decomp(ex))
),
print("--- another use by on3decomp(ex18,show) ---"),
on3decomp(ex18,show),
display2d:display2d_old,
return("--- end of on3show_ex ---")
)$ /* end of on3showex() */
/*### --- fsplit: on3diff.mx --- #######################################*/
/* <on3diff> : on3 関数の微分(多変数関数の1変数に関するp階偏微分) */
/*######################################################################*/
on3diff([args]) := block(
[progn:"<on3diff>",debug,exp,var,p, same,type,number,out,z,zl,zr,zlr,
exp0,func,dfunc,fL:[],dfL:[],fl,fr,dfl,dfr,vp,chk,
LR,T,on3v,fLT,dfLT,ft,dft,tl,tm,tr,ftl,ftm,ftr,wftl,wftm,wftr,fcontinue,
dftl,dftr,wdftl,wdtfl,wdftr,dfok,val,im,ip,err:false],
debug:ifargd(), /*** デバッグモードの判定 ***/
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3diff('help)--
機能: on3 関数の微分(多変数関数の1変数に関するp階偏微分)を求める
文法: on3diff(exp,var,p,...)
例示: on3diff(exp,var) <- p=1 として1階偏微分を返す
★ ◎ on3diff(sin(x),x) = cos(x)
★ ◎ on3diff(x^2*on3(x,0,1,co) + %e^(1-x)*on3(x,1,inf,co), x, 1)
= 2*x*on3(x,0,1,co)-%e^(1-x)*on3(x,1,inf,oo)
--end of on3diff('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3diff('ex)--"),
on3diff_ex(),
/*
block([],
return('normal_return)
), /* end of block */
*/
print("--end of on3diff('ex)--"),
return("--end of on3diff('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1], var : args[2],
if (length(args) > 2)
and (not member(args[3],[debug1,debug2,debug3,show,list]))
then (p: args[3]) else p:1 ,
if debug > 0 then
print("on3diff(func,var,p): 区間で異なる関数の",var,"に関する",p,"次導関数を求める"),
/*** start ***/
if listp(exp) then exp0:l2f(exp) else exp0:ev(exp,expand,infeval),
/* タイプの検査 */
type:on3typep(exp0),
LR : on3lrl(exp),
d1show("タイプの検査",type),
d1show("端点検査",LR),
if type='on3none then return(diff(exp,x,p)), /* 非on3式のとき */
number:true,
for i thru length(LR[1]) do if LR[3][i]=false then number:false,
if (type=on3inv or type=on3polyinv) and number=false then
( print(" ---> on3分数式かつ非数値領域のため処理を中止する"),
return("Not Evaluated")),
func : on3decomp(exp0), /* call on3decomp : 排他的領域分解 */
d1show("S0: on3decompの結果 :",func),
gradef(on3(z,zl,zr,zlr),0,0,0,0), /* 関数微分を定義する */
if not integerp(p) then (cshow("p is not integer",p), return("No Action")),
/* 1階微分する毎に端点検査を行う必要がある */
for k:1 thru p do ( /* 1階微分の繰り返し */
dfunc : diff(func,var,1),
dfunc: ev(dfunc,expand,infeval),
if dfunc = 0 then return(out:0),
fL:f2l(func), dfL:f2l(dfunc),
d2show("S2: 関数部の形式的微分結果:",k,dfunc),
d2show(dfL),
LR : on3lrl(func), T:[],
for i thru length(LR[1]) do if LR[1][i]=var then T:LR[2][i],
d2show(var,T),on3v:var,
/* 端点での微分係数の存在を検査（接線の有無を調べる）*/
fLT : scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var then
(d2show(u), u:ev(u,u[2]=tvar), u) else u ), fL),
ft:l2f(fLT),
dfLT : scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var then
(d2show(u), u:ev(u,u[2]=tvar), u) else u ), dfL),
dft:l2f(dfLT),
d2show("S3: 関数部と定義域部を分離する関数の生成"),
d2show(ft),
d2show(dft),
/**** oo cahnge ***/
dfL:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var then
(d2show(u), u[5]:oo, u) else u ), dfL),
for i thru length(dfL) do (
same:false,
scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var
and u[3]=u[4] then
(d2show(u), same:true, same) else u ), dfL[i]),
if same then dfL:delete(dfL[i],dfL)
),
d2show("S4:導関数の定義域を一旦[oo]に変更する: ",dfL),
/* 端点での微分可能性を調べる
(端点x0での関数f(x)の連続性と導関数f'(x)の両極限の一致性に基づく) */
for i:2 thru length(T)-1 do (
tl:(T[i-1]+T[i])/2, tm:T[i], tr:(T[i]+T[i+1])/2,
/* f(x) errcatch */
ftl:ev(ft,tvar=tl), ftm:ev(ft,tvar=tm), ftr:ev(ft,tvar=tr), /* 関数抽出 */
/* 関数値 */
if errcatch(wftl:ev(ftl,ev(var)=tm),
wftm:ev(ftm,ev(var)=tm),
wftr:ev(ftr,ev(var)=tr),return)=[]
then (print("---> 端点での連続性が評価不能でした"), return("error") ),
wftl:ev(ftl,ev(var)=tm), wftm:ev(ftm,ev(var)=tm), wftr:ev(ftr,ev(var)=tm),
d2show("---端点での微分可能性検査---",i,tm),
d2show(tl,tm,tr), d2show(ftl,ftm,ftr), d2show(wftl,wftm,wftr),
if wftl=wftm and wftr=wftm
then (chsow("f-continue"), fcontinue:true) else fcontinue:false,
if fcontinue then (
/* f'(x) */
d2show(fcontinue),
if errcatch(
dftl:ev(dft,tvar=tl), dftr:ev(dft,tvar=tr), /* 関数抽出 */
wdftl:ev(dftl,ev(var)=tm), wdftr:ev(dftr,ev(var)=tm), /* 関数値 */
return)=[]
then (print("---> 端点での微分係数が評価不能でした"),
return("Not Evauated") ),
dftl:ev(dft,tvar=tl), dftr:ev(dft,tvar=tr), /* 関数抽出 */
wdftl:ev(dftl,ev(var)=tm), wdftr:ev(dftr,ev(var)=tm), /* 関数値 */
d2show(tm,dftl,dftr),
d2show(tm,wdftl,wdftr),
if wdftl=wdftr then (d2show("df-ok"), dfok:true) else dfok:false ,
d2show(i,tm,fcontinue,dfok),
if fcontinue and dfok then ( /* 再考の必要あるかも */
dfL:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=var
then (d2show(u),chk:fase,
if u[3]=tm then (u[5]:co, chk:true)
else if u[4]=tm and chk=false then u[5]:oc, u)
else u
),dfL)
) /* 端点変更 の終わり */
) /* end of fcontinue then */
), /* end of for-i */
out:l2f(dfL),out:on3std(out),d2show("S5:1階微分の結果:",k,out),
func:out
), /* end of for-k */
d2show("Diff",out),
/*** 出力形式の指定 ***/
if member(show,args) then on3show(out),
if member(list,args) then return(f2l(out)) else return(out)
)$
/*--- on3diff_ex ------------------------------------------------------*/
on3diff_ex([args]) := block([progn:"<on3diff_ex",p,x,ex,ex1,ex2,ex3,df,Lex0,L],
ex1 : x^2 * on3(x,0,1,co) + %e^(1-x) * on3(x,1,inf,co),
ex2 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo),
ex3 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo) + sin(x)*on3(x,minf,inf,oo),
exansL : [["微分"],
["on3diff(sin(x),x)", "cos(x)"],
["on3diff(x^2*on3(x,0,1,co) + %e^(1-x)*on3(x,1,inf,co), x, 1)",
"2*x*on3(x,0,1,co)-%e^(1-x)*on3(x,1,inf,oo)", "on3show"],
[sconcat("on3diff(x^2*on3(x,minf,0,oo)+1/2*(1-x^2)*on3(x,0,1,oo)",
"+(1-x)*on3(x,1,inf,oo)",", x, 1)"),
"2*x*on3(x,minf,0,oo)-on3(x,1,inf,co)-x*on3(x,0,1,oo)", "on3show"],
[sconcat("on3diff(x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo)",
" + (1-x)*on3(x,1,inf,oo) + sin(x)*on3(x,minf,inf,oo)",
", x, 1)"),
sconcat("(cos(x)+2*x)*on3(x,minf,0,oo)+(cos(x)-1)*on3(x,1,inf,co)",
"+(cos(x)-x)*on3(x,0,1,oo)"), "on3show"]
],
print("== on3diff : 微分 =="),
c1show(exansL),
exchk("",exansL),
if false then (
p:1,
Lex0 : [ex1,ex2,ex3],
if length(args) > 0 then (
if listp(args[1]) then L:copylist(args[1]) else L:[args[1]]
) else L : copylist(Lex0),
/* start */
for ex in L do ( print("◆ 例 微分 "),
ldisplay(ex),
print(" ---> df : on3diff(ex,x,",p,",show)"),
df : on3diff(ex,x,p,show),
ldisplay(df)
) /* end of do */
),
return("--- end of on3diff_ex ---")
)$
/*### --- fsplit: on3integ.mx --- #######################################*/
/* <on3integ> : on3 関数の積分(多変数関数の1重不定積分関数/定積分を返す) */
/*######################################################################*/
on3integ([args]) := block(
[progn:"<on3integ>",debug,exp,var,p,same,type,number,out,z,zl,zr,zlr,
exp0,func,dfunc,fL:[],dfL:[],fl,fr,dfl,dfr,vp,chk,
LR,T,on3v,fLT,dfLT,ft,dft,tl,tm,tr,ftl,ftm,ftr,wftl,wftm,wftr,fcontinue,
dftl,dftr,wdftl,wdtfl,wdftr,dfok,val,im,ip,err:false],
debug:ifargd(), /*** デバッグモードの判定 ***/
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3integ('help)--
機能: on3 関数の積分(多変数関数の1重不定積分関数/定積分を返す)
文法: on3integ(exp,var,...)
例示: on3integ(sin(x)*on3(x,0,1,co),x);
-> (-(cos(1)-1)*on3(x,1,inf,co))-(cos(x)-1)*on3(x,0,1,co)
on3integ(sin(x)*on3(x,%pi/4,%pi/2,co),x,minf,inf);
-> 1/sqrt(2)
--end of on3integ('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3integ('ex)--"),
on3integ_ex(),
print("--end of on3integ('ex)--"),
return("--end of on3integ('ex)--"),
block_main, /* main ブロック ====================================*/
exp :args[1], var : args[2],
if (length(args) > 2)
and (not member(args[3],[debug1,debug2,debug3,show,list]))
and (not member(args[4],[debug1,debug2,debug3,show,list]) )
then (t_defint:true, val_l : args[3], val_r : args[4] ) else t_defint:false ,
/*** start ***/
c1show(progn,exp,var),
if listp(exp) then exp0:l2f(exp) else exp0:exp,
exp0 : ev(on3std(exp0),expand,infeval), /* call on3std 式の標準化 */
c1show(progn,exp0),
fL:f2l(exp0),
c1show(progn,fL),
if not listp(fL) or not member(on3,flatten(fL))
then return(integrate(exp,var)), /* 非on3式の場合 */
LR : on3lrl(exp0), T:[],
for i:1 thru length(LR[1]) do if LR[1][i]=var then T:LR[2][i],
c1show(progn,T),
/* 端点リストの要素がすべて数値であるかを調べる nonumber */
for i:2 thru length(T)-1 do if not numberp(T[i]) then number:false,
d2show(var,T,number),
type:on3typep(exp0), /* call on3type on3関数タイプを取得する */
if (type=on3inv or type=on3polyinv) and number=false then
( print(" ---> on3分数多項式かつ非数値領域のため処理を中止する"),
return("Not evaluated")),
/* 端点に変数が含まれる場合の処理(on3decompが利用できない局面の対応) */
d1show("端点に変数が含まれる場合の処理",fL),
/* 着目区間上での関数を取り出す (蜃気楼:mirage) */
fLT : scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var then
(d2show(u), u:ev(u,u[2]=tvar), u) else u ), fL),
ft:l2f(fLT),
c1show(progn,fLT,ft),
if not (fLT[1]="+") and fLT[1]=on3 then fLT:["+",["*",1,fLT]], /*単項式&関数部1*/
if fLT[1]="*" then fLT:["+",fLT], /* 単項式の処理->多項式化 */
d2show(fLT,length(fLT)),
Fsum:0,
for i:2 thru length(fLT) do (
d2show(i,fLT[i]), ton3:[],
/* 多項式の各項毎にon3部と間数部を切り出す */
scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then (ton3:u, d2show("on3-part:",ton3), u) else u ),fLT[i]),
func : scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then (d2show("func-part:",u), u:1) else u ),fLT[i]),
/*** func : f(x,y)*on3(y,y1(x),y2(x)) を避ける ***/
scanmap(lambda([u],if listp(u) and u[1]=on3
and not (freeof(var,u[3]) or freeof(var,u[4])) then
(print("---> on3部が積分変数に依存するため処理を中止する"),chk:true)
else u),func),
d2show("--->",chk),
if chk=true then return("Not Evaluated"),
func : l2f(func),
d2show(func),
if ton3=[] then ton3:[on3,tvar,minf,inf,oo],
d2show(ton3),
tlr:ton3[5], if ton3[5]=co or ton3[5]=oo then tlr:co else tlr:oo,
ton3[2]:ev(var),
F0 : integrate(func,var), /* 間数部の不定積分関数を求める */
c1show(F0,ton3),
if ton3[3]=minf then Fl:0 else Fl : at(F0,ev(var)=ton3[3]),
if ton3[4]=inf then Fr:0 else Fr : at(F0,ev(var)=ton3[4]),
F : (F0 - Fl)*funmake(on3,delete(on3,ton3))
+ (Fr - Fl)*funmake(on3,[ev(var),ton3[4],inf,tlr]),
if t_defint=true and val_l = minf and val_r = inf then
F : Fr-Fl,
Fsum : Fsum + F,
c1show(progn,F)
), /* end of for-i */
if chk=true then return("Not Evaluated"),
d1show(Fsum),
if number=false then Fsum:on3std(Fsum),
if number=true then Fsum:on3decomp(ev(Fsum,expand,infeval)),
/*** 出力形式の指定 ***/
if t_defint=true and val_l = minf and val_r = inf then (
d2show("全定積分:",Fsum), return(ratsimp(Fsum)) ),
d2show(args),
if (length(args) > 3)
and (not member(args[3],[show,list]))
and (not member(args[4],[show,list]) )
then (val_l : args[3], val_r : args[4],
if val_l = minf then out:ev(Fsum,ev(var)=val_r)
else (
out: ev(Fsum,ev(var)=val_r) - ev(Fsum,ev(var)=val_l),
out: ratsimp(out) ),
d1show("定積分",val_l,val_r,out),
return(out)),
if member(show,args) then on3show(Fsum),
if member(list,args) then return(f2l(Fsum)) else return(Fsum)
)$ /* end of on3integ() */
/*#######################################################################*/
/*--- on3integ_ex ------------------------------------------------------*/
/*#######################################################################*/
on3integ_ex([args]) := block([progn:"<on3integ_ex",
x,ex,F,Fx,Lex0,ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8,
cmds,ans],
ex1 : x^2 * on3(x,0,1,co) + %e^(1-x) * on3(x,1,inf,co),
ex2 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo),
ex3 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo) + sin(x),
ex4 : x*y*on3(x,1,4,co)*on3(y,2,4,co)+ x^2*on3(x,3,4,co)*on3(y,6,8,co),
ex5 : f1*on3(x,a,b,co)+f2*on3(x,c,d,co),
ex6 : f1*on3(x,0,1,co)*on3(y,x,1,co) + f2*on3(x,0,1,co)*on3(y,x,2,co),
ex7 : f1*on3(x,1,2,co)*on3(y,y1(x),y2(x),co),
ex8 : f0+1/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)),
cmds : sconcat("( ",
"/* 例1. 不定積分 */ @",
" ex : %e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co), @",
" F : on3integ(ex,x) @",
" )"),
ans : (%e^-x*(4*%e^x-3*%e)*on3(x,1,inf,co))/3+(x^3*on3(x,0,1,co))/3,
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
c0show(F),
cmds : sconcat("( ",
"/* 例2. 不定積分 */ @",
" ex : x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)+((1-x^2)*on3(x,0,1,oo))/2, @",
" F : on3integ(ex,x) @",
" )"),
ans : (x^3*on3(x,minf,0,oo))/3-((3*x^2-6*x+1)*on3(x,1,inf,co))/6
-(x*(x^2-3)*on3(x,0,1,oo))/6 ,
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例3. 不定積分 */ @",
" ex : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) ",
" + (1-x)*on3(x,1,inf,oo) + sin(x), @",
" F : on3integ(ex,x) @",
" )"),
ans : (-((3*cos(x)-x^3)*on3(x,minf,0,oo))/3)
-((6*cos(x)+3*x^2-6*x+1)*on3(x,1,inf,co))/6
-((6*cos(x)+x^3-3*x)*on3(x,0,1,co))/6,
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例4. 不定積分 */ @",
" ex : x^2*on3(x,3,4,co)*on3(y,6,8,co)+x*on3(x,1,4,co)*y*on3(y,2,4,co), @",
" F : on3integ19(ex,x) @",
" )"),
ans : (37*on3(x,4,inf,co)*on3(y,6,8,co))/3
+((x-3)*(x^2+3*x+9)*on3(x,3,4,co)*on3(y,6,8,co))/3
+(15*on3(x,4,inf,co)*y*on3(y,2,4,co))/2
+((x-1)*(x+1)*on3(x,1,4,co)*y*on3(y,2,4,co))/2,
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例5. 不定積分 */ @",
" ex : f1*on3(x,a,b,co)+f2*on3(x,c,d,co), @",
" F : on3integ(ex,x) @",
" )"),
ans : (d*f2-c*f2)*on3(x,d,inf,co)+(f2*x-c*f2)*on3(x,c,d,co)
+(b*f1-a*f1)*on3(x,b,inf,co) +(f1*x-a*f1)*on3(x,a,b,co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例6. 不定積分 */ @",
" ex : f1*on3(x,a,b,co)+f2*on3(x,c,d,co), @",
" F : on3integ(ex,x) @",
" )"),
ans : (d*f2-c*f2)*on3(x,d,inf,co)+(f2*x-c*f2)*on3(x,c,d,co)
+(b*f1-a*f1)*on3(x,b,inf,co) +(f1*x-a*f1)*on3(x,a,b,co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例7. 不定積分 */ @",
" ex : f0+1/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)), @",
" F : on3integ(ex,x) @",
" )"),
ans : "on3分数多項式かつ非数値領域のため処理を中止する",
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例8. 不定積分関数 (y に関して) */ @",
" ex : f2*on3(x,0,1,co)*on3(y,x,2,co)+f1*on3(x,0,1,co)*on3(y,x,1,co), @",
" F : on3integ(ex,y) @",
" )"),
ans : on3(x,0,1,co)*(f2*y-f2*x)*on3(y,x,2,co)
+on3(x,0,1,co)*(f1*y-f1*x)*on3(y,x,1,co)
+(2*f2-f2*x)*on3(x,0,1,co)*on3(y,2,inf,co)
+(f1-f1*x)*on3(x,0,1,co)*on3(y,1,inf,co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例9. 不定積分関数 (y に関して) */ @",
" ex : f1*on3(x,1,2,co)*on3(y,y1(x),y2(x),co), @",
" F : on3integ(ex,y) @",
" )"),
ans : (f1*y2(x)-f1*y1(x))*on3(x,1,2,co)*on3(y,y2(x),inf,co)
+on3(x,1,2,co)*(f1*y-f1*y1(x))*on3(y,y1(x),y2(x),co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例10. 2重定積分 */ @",
" ex : (y+x+5)*(on3(x,2,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc) @",
" +on3(x,-3,-2,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc) @",
" +on3(x,-2,2,co)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc) @",
" +on3(x,-2,2,co)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc)), @",
" Fx : on3integ(ex,y,minf,inf), print(\" Fx = \",Fx), @",
" F : on3integ(Fx,x,minf,inf)",
" )"),
ans : 25*%pi,
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
return("--end of on3integ_ex--")
)$
/*#######################################################################*/
/*--- on3integ_new19_ex -------------------------------------------------*/
/*#######################################################################*/
on3integ_new19_ex([args]) := block([progn:"<on3integ_new19_ex",
x,ex,F,Fx,Lex0,ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8,
cmds,ans],
ex1 : x^2 * on3(x,0,1,co) + %e^(1-x) * on3(x,1,inf,co),
ex2 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo),
ex3 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo) + sin(x),
ex4 : x*y*on3(x,1,4,co)*on3(y,2,4,co)+ x^2*on3(x,3,4,co)*on3(y,6,8,co),
ex5 : f1*on3(x,a,b,co)+f2*on3(x,c,d,co),
ex6 : f1*on3(x,0,1,co)*on3(y,x,1,co) + f2*on3(x,0,1,co)*on3(y,x,2,co),
ex7 : f1*on3(x,1,2,co)*on3(y,y1(x),y2(x),co),
ex8 : f0+1/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)),
cmds : sconcat("( ",
"/* 例1. 不定積分 */ @",
" ex : %e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co), @",
" F : on3integ19(ex,x) @",
" )"),
ans : (%e^-x*(4*%e^x-3*%e)*on3(x,1,inf,co))/3+(x^3*on3(x,0,1,co))/3,
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
cmds : sconcat("( ",
"/* 例2. 不定積分 */ @",
" ex : x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)+((1-x^2)*on3(x,0,1,oo))/2, @",
" F : on3integ19(ex,x) @",
" )"),
ans : (x^3*on3(x,minf,0,oo))/3-((3*x^2-6*x+1)*on3(x,1,inf,co))/6
-(x*(x^2-3)*on3(x,0,1,oo))/6 ,
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
cmds : sconcat("( ",
"/* 例3. 不定積分 */ @",
" ex : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) ",
" + (1-x)*on3(x,1,inf,oo) + sin(x), @",
" F : on3integ19(ex,x) @",
" )"),
ans : (-((3*cos(x)-x^3)*on3(x,minf,0,oo))/3)
-((6*cos(x)+3*x^2-6*x+1)*on3(x,1,inf,co))/6
-((6*cos(x)+x^3-3*x)*on3(x,0,1,co))/6,
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例4. 不定積分 */ @",
" ex : x^2*on3(x,3,4,co)*on3(y,6,8,co)+x*on3(x,1,4,co)*y*on3(y,2,4,co), @",
" F : on3integ19(ex,x) @",
" )"),
ans : (37*on3(x,4,inf,co)*on3(y,6,8,co))/3
+((x-3)*(x^2+3*x+9)*on3(x,3,4,co)*on3(y,6,8,co))/3
+(15*on3(x,4,inf,co)*y*on3(y,2,4,co))/2
+((x-1)*(x+1)*on3(x,1,4,co)*y*on3(y,2,4,co))/2,
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
cmds : sconcat("( ",
"/* 例5. 不定積分 */ @",
" ex : f1*on3(x,a,b,co)+f2*on3(x,c,d,co), @",
" F : on3integ19(ex,x) @",
" )"),
ans : (d*f2-c*f2)*on3(x,d,inf,co)+(f2*x-c*f2)*on3(x,c,d,co)
+(b*f1-a*f1)*on3(x,b,inf,co) +(f1*x-a*f1)*on3(x,a,b,co),
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
cmds : sconcat("( ",
"/* 例6. 不定積分 */ @",
" ex : f1*on3(x,a,b,co)+f2*on3(x,c,d,co), @",
" F : on3integ19(ex,x) @",
" )"),
ans : (d*f2-c*f2)*on3(x,d,inf,co)+(f2*x-c*f2)*on3(x,c,d,co)
+(b*f1-a*f1)*on3(x,b,inf,co) +(f1*x-a*f1)*on3(x,a,b,co),
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
cmds : sconcat("( ",
"/* 例7. 不定積分 */ @",
" ex : f0+1/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)), @",
" F : on3integ19(ex,x) @",
" )"),
ans : "on3分数多項式かつ非数値領域のため処理を中止する",
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例8. 不定積分関数 (y に関して) */ @",
" ex : f2*on3(x,0,1,co)*on3(y,x,2,co)+f1*on3(x,0,1,co)*on3(y,x,1,co), @",
" F : on3integ19(ex,y) @",
" )"),
ans : on3(x,0,1,co)*(f2*y-f2*x)*on3(y,x,2,co)
+on3(x,0,1,co)*(f1*y-f1*x)*on3(y,x,1,co)
+(2*f2-f2*x)*on3(x,0,1,co)*on3(y,2,inf,co)
+(f1-f1*x)*on3(x,0,1,co)*on3(y,1,inf,co),
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例9. 不定積分関数 (y に関して) */ @",
" ex : f1*on3(x,1,2,co)*on3(y,y1(x),y2(x),co), @",
" F : on3integ19(ex,y) @",
" )"),
ans : (f1*y2(x)-f1*y1(x))*on3(x,1,2,co)*on3(y,y2(x),inf,co)
+on3(x,1,2,co)*(f1*y-f1*y1(x))*on3(y,y1(x),y2(x),co),
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例10. 2重定積分 */ @",
" ex : (y+x+5)*(on3(x,2,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc) @",
" +on3(x,-3,-2,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc) @",
" +on3(x,-2,2,co)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc) @",
" +on3(x,-2,2,co)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc)), @",
" Fx : on3integ19(ex,y,minf,inf), print(\" Fx = \",Fx), @",
" F : on3integ19(Fx,x,minf,inf)",
" )"),
ans : 25*%pi,
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
return("--end of on3integ_new19_ex--")
)$
/*#######################################################################*/
/*### on3integ19 : on3多項式の数式積分 2019.06.28 ##########################*/
/*#######################################################################*/
/*
f1(x,y)*on3(x,xl,xr,xlr)*on3(y,yl,yr,ylr) を x で不定積分する
-> { (F1(x,y)-F1(xl,y))*on3(x,xl,xr,xlr)
+ (F1(xr,y)-F1(xl,y))*on3(x,xr,inf,xlr1) } * on3(y,yl,yr,ylr)
where F1(x,y) = integral(f1(x,y), x)
xlr=cc or oc then xlr1=oo, xlr=co or oo then xlr1=co
-> (F1(xr,y)-F1(xl,y)) * on3(y,yl,yr,ylr) を xの区間[xl,xr]での定積分とする
f1(x,y)*on3(y,yl,yr,ylr) を x で不定積分する
-> f1(x,y)*on3(x,minf,inf,oo)*on3(y,yl,yr,ylr) を x で不定積分する
F1(minf,y), F1(inf,y) が有限確定のときのみ意味をもつ
*/
on3integ19([args]) :=
block([progn:"<on3integ19>",debug,on3func,var,vl0,vr0, var_fix,one,L,
Li,vl,vr,lr,lr1,f,wl,wr,F,definteg,Findef,Fdef,Findef_sum,Fdef_sum,
Lif,Fif,var_fix_on,Frest],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3integ19('help)--
機能: on3()関数を含む式の不定積分,定積分を返す.(on3decomp()を必要としない)
文法: on3integ19(on3func,var,{vl,vr},...)
F_i(x) = (F_i(x)-F_i(xl))*on3(x,xl,xr,lr)
+(F_i(xr)-F_i(xl))*on3(x,xr,inf,lr1),
where if xl=minf then F_i(xl)=0 (積分定数の定義),
lr=cc or oc then lr1=oo, lr=co or oo then lr1=co
例示: on3integ19(on3func,x) 変数xに関する不定積分
on3integ19(2*x, x) -> x^2
on3integ19(2*x + on3(x,1,3,co), x)$
-> x^2 + (x-1)*on3(x,1,3,co) + (3-1)*on3(x,3,inf,co)
f2 : 2*on3(x,0,%pi/2,cc)*sin(2*x)+cos(x)*on3(x,0,%pi/2,cc)$
on3integ19(f2,x) ->
(-on3(x,0,%pi/2,cc)*cos(2*x))+3*on3(x,%pi/2,inf,oo)
+(sin(x)+1)*on3(x,0,%pi/2,cc)
f4 : 2*on3(x,0,%pi/4,cc)*sin(2*x)+cos(x)*on3(x,0,%pi/2,cc)
on3integ19(f4,x) ->
(on3(x,0,%pi/4,cc)*(1-cos(2*x))+on3(x,%pi/4,inf,oo)
+sin(x)*on3(x,0,%pi/2,cc)+on3(x,%pi/2,inf,oo)
on3integ19(on3func,x,xl,xr) 変数xに関する区間[xl,xr]の定積分
on3integ19(f4,x,minf,inf) -> 2
ev(out4,x = inf) -> 2
on3integ19(exp(-x)*on3(x,0,inf,co),x,0,inf); -> 1
--end of on3integ19('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3integ19('ex)--"),
on3integ19_ex(),
/*
block([proogn:"<on3varfix_ex>",debug],
return("-- end of on3varfix_ex --")
), /* end of block */
*/
print("--end of on3integ19('ex)--"),
return("--end of on3integ19('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1], var : args[2],
on3func:expand(on3func),
if length(args)>=4 then (definteg:true, vl0 : args[3], vr0 :args[4])
else definteg:false,
/*
if length(args)>=4 and member(minf, args) and member(inf, args)
then definteg:true else definteg:false,
*/
c1show(progn,definteg),
c1show(progn, on3typep(on3func), on3vars(on3func)),
if on3typep(on3func)='on3none then (
/* on3none:on3関数を含まない場合 */
Findef_sum : integrate(on3func,var),
c1show(Findef_sum),
if definteg then (
Fdef_sum : integrate(on3func,var,vl0,vr0),
cshow(Fdef_sum)
),
if definteg then return(Fdef_sum) else return(Findef_sum)
),
if member(on3typep(on3func),['on3inv,'on3polyinv,'on3unknown]) then (
c0show(progn,on3typep(on3func),"->",
"被積分関数の簡素化を検討して下さい(see on3decomp)"),
return("Error return")
),
/* change 2012.01.25, 2019.04.14 */
on3func : on3std(on3func), /* ratsimp, factor の障害を防ぐ */
on3func:expand(on3func),
L : f2l(on3func),
if L[1] = on3 then (
L : [f2l(one*on3func)], /* on3monoone */
L : ev(L, one=1)
),
/* on3(積分変数,.. -> on3(var_fix とし,積分に反応しないようにする */
L:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var
then (u[2]:var_fix, u) else u),L),
if L[1]="+" then L:delete(L[1],L) else if L[1]="*" then L:[L],
c1show(progn,L),
Findef_sum :0, Fdef_sum:0,
for i thru length(L) do (
c1show("**",i,L[i]),
/* 積分変数に関する定義関数on3()の存在有無と存在時の境界点vl,vrを見出す */
vl:null, vr:null, var_fix_on:false, Li:L[i],
Li:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var_fix
then (var_fix_on:true, vl:u[3], vr:u[4], lr:u[5], u) else u
) ,Li),
/* Li:delete(null,Li), */
c1show(Li,var_fix_on),
c1show(var,vl,vr, Li[2]),
ratprint:false,
/* on3(var_fix,..)を除いた関数部を取り出す */
Lif : Li,
Lif:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var_fix
then (u:1, u) else u
) ,Lif),
f : l2f(Lif), /* 積分変数に関するon3式のみを除いた被積分関数関数 */
c1show(f),
F : integrate(f,var), /* 被積分関数部 f の不定積分 indefinite integral */
c1show(F),
Findef : F,
if var_fix_on then (
if is(vl=minf) then wl : 0 else wl : ev(F, ev(var)=vl),
Findef : (F - wl)*on3(var,vl,vr,lr)
),
c1show(Findef),
Frest : 0, Fdef:0,
if var_fix_on then (
if is(vl=minf) then wl : 0 else wl : ev(F, ev(var)=vl),
/* if is(vr=inf) then wr : 0 else wr : ev(F, ev(var)=vr), */
if is(vr=inf) then wr : limit(F,ev(var),inf) /* 極限値 */
else wr : ev(F, ev(var)=vr),
Fdef : wr - wl, /* 定積分 definite integral */
if lr=cc or lr=oc then lr1:oo,
if lr=co or lr=oo then lr1:co,
Frest : (wr - wl)*on3(var,vr,inf,lr1)
),
c1show(Frest),
Fdef_sum : Fdef_sum + Fdef,
Findef_sum : Findef_sum + Findef + Frest
), /* end of for-i */
/* Findef_sum : on3decomp(Findef_sum), */
/* Fdef_sum : on3decomp(Fdef_sum), */
c1show(Fdef_sum),
Fdef_sum : ratsimp(Fdef_sum), Findef_sum : ratsimp(Findef_sum),
if member('view,args) and (length(listofvars(on3func)) = 1) then (
c1show("Plot of f(x) and F(x)"),
g1 : gr2v([explicit(on3func,ev(var),0,%pi/2)],'title="f(x)",'noview),
g2 : gr2v([explicit(Findef_sum,ev(var),0,%pi/2)],'title="F(x)",'noview),
mk_draw([g1,g2],
['file_name=sconcat(figs_dir,"/","fig-fandF"),
'columns=2, 'dimensions=[1000,500]],
'view)
), /* end of if-TRUE */
if definteg then return(Fdef_sum) else return(Findef_sum)
)$ /* end of on3integ19() */
/*#######################################################################*/
/*+++ 2019.04.19 +++++++++++++++++++++++++++++++++++++++++++++++++++*/
/*#######################################################################*/
on3integ19_ex([args]) :=
block([progn:"<on3integ19_ex>",debug,c11,c12,c21,c22,ex,cmds,dF,out,outsum,
f,F,Fans],
debug:ifargd(),
c11 : on3(t,0,1,co)*on3(u,0,t,cc)*on3(v,0,t-u,cc),
c12 : on3(t,1,2,co)*on3(u,t-1,1,cc)*on3(v,0,t-u,cc),
c21 : on3(t,1,2,co)*on3(u,0,t-1,cc)*on3(v,t-u-1,1,cc),
c22 : on3(t,2,3,cc)*on3(u,t-2,1,cc)*on3(v,t-u-1,1,cc),
/*------------------------------------------
◆ 3個の和の分布
[ 2 ]
[ t ]
[ -- (0 <= t < 1) ]
[ 2 ]
[ ]
[ 2 ]
[ 2 t - 6 t + 3 ]
f3(t) = [ - -------------- (1 <= t < 2) ]
[ 2 ]
[ ]
[ 2 ]
[ (t - 3) ]
[ -------- (2 <= t < 3) ]
[ 2 ]
[ ]
[ 0 ( otherwise ) ]
-------------------------------------------------*/
if false then (
outsum : 0,
for ex in [c11,c12,c21,c22] do (
cshow("========================================="),
out : on3integ19(ex,v,minf,inf), cshow(out),
out : on3integ19(out,u,minf,inf), cshow(ratsimp(out)),
outsum : outsum + ratsimp(out)
),
cshow(on3decomp(outsum))
), /* end of if-false */
cmds : sconcat("( ",
"/* 例1. 不定積分 */ @",
"f : f0, cashow(on3typep(f)), @",
"F : on3integ19(f,x) ",
" )"),
Fans : f0*x,
chk1show(cmds,Fans),
cmds : sconcat("( ",
"/* 例2. 不定積分 */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), @",
"F : on3integ19(f,x), F : on3decomp(F)",
" )"),
Fans : 2*(f2+f1)*on3(x,6,inf,co) + (f2*x-4*f2+2*f1)*on3(x,4,6,co)
+2*f1*on3(x,3,4,co) + f1*(x-1)*on3(x,1,3,co),
chk1show(cmds,Fans),
cmds : sconcat("( ",
"/* 例3. 不定積分 */@",
"f : 2*sin(2*x)*on3(x,0,%pi/2,cc) + 3*cos(3*x)*on3(x,0,%pi/3,cc),@",
"F : on3integ19(f,x)",
" )"),
Fans : on3(x,0,%pi/3,cc)*sin(3*x)+on3(x,0,%pi/2,cc)*(1-cos(2*x))+2*on3(x,%pi/2,inf,oo),
chk1show(cmds,Fans),
cashow(on3ev(F,factor)),
print("例4a: 微分関数の積分"),
f : exp(x-1)*on3(x,minf,1,oo) + exp(1-x)*on3(x,1,inf,co),
c0show(f),
df : on3diff(f,x),
c0show("df:on3diff(f,x) ->",df),
out : on3integ19(df,x),
c0show("out : on3integ19(df,x) ->",out),
out1 : on3ev(out,expand),
c0show("out1 : on3ev(out,expand) ->",out1),
c0show(is(equal(out1,f))),
chk1 : on3(x,1,inf,co)-on3(x,1,inf,oo)-on3(x,1,1,cc),
c0show(on3ev(chk1,expand)),
gr2v_fdf(f,df),
print("例4b: 積分関数の微分"),
f : exp(x-1)*on3(x,minf,1,oo) + exp(1-x)*on3(x,1,inf,co),
c0show(f),
F : on3integ19(f,x),
c0show("F : on3integ19(f,x) ->",F),
F : on3ev(F,expand),
c0show("F : on3ev(F,expand) ->",F),
dF : on3diff(F,x),
c0show("dF : on3diff(F,x) ->",dF),
c0show(is(equal(dF,f))),
cmds : sconcat("( ",
"/* F (直前の結果) の微分 on3diff(F,x) と f の比較(端点を除いて一致する)*/ @",
"dF : on3diff(F,x) @",
" )"),
chk1show(cmds,on3decomp(f)),
return("--end of on3integ19_ex--")
)$ /* end of on3integ19_ex() */
/*#######################################################################*/
/*+++ 2020.07.09 +++++++++++++++++++++++++++++++++++++++++++++++++++*/
/*#######################################################################*/
on3integ20_ex([args]) :=
block([progn:"<on3integ20_ex>",debug,c11,c12,c21,c22,ex,cmds,dF,out,outsum,
f,F,Fans],
debug:ifargd(),
c11 : on3(t,0,1,co)*on3(u,0,t,cc)*on3(v,0,t-u,cc),
c12 : on3(t,1,2,co)*on3(u,t-1,1,cc)*on3(v,0,t-u,cc),
c21 : on3(t,1,2,co)*on3(u,0,t-1,cc)*on3(v,t-u-1,1,cc),
c22 : on3(t,2,3,cc)*on3(u,t-2,1,cc)*on3(v,t-u-1,1,cc),
/*------------------------------------------
◆ 3個の和の分布
[ 2 ]
[ t ]
[ -- (0 <= t < 1) ]
[ 2 ]
[ ]
[ 2 ]
[ 2 t - 6 t + 3 ]
f3(t) = [ - -------------- (1 <= t < 2) ]
[ 2 ]
[ ]
[ 2 ]
[ (t - 3) ]
[ -------- (2 <= t < 3) ]
[ 2 ]
[ ]
[ 0 ( otherwise ) ]
-------------------------------------------------*/
if true then (
outsum : 0,
for ex in [c11,c12,c21,c22] do (
cshow("========================================="),
out : on3integ20(ex,v,minf,inf), cshow(out),
out : on3integ20(out,u,minf,inf), cshow(ratsimp(out)),
outsum : outsum + ratsimp(out)
),
cshow(on3decomp(outsum))
), /* end of if-false */
cmds : sconcat("( ",
"/* 例1. 不定積分 */ @",
"f : f0, cashow(on3typep(f)), @",
"F : on3integ20(f,x) ",
" )"),
Fans : f0*x,
chk1show(cmds,Fans),
cmds : sconcat("( ",
"/* 例2. 不定積分 */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), @",
"F : on3integ20(f,x), F : on3decomp(F)",
" )"),
Fans : 2*(f2+f1)*on3(x,6,inf,co) + (f2*x-4*f2+2*f1)*on3(x,4,6,co)
+2*f1*on3(x,3,4,co) + f1*(x-1)*on3(x,1,3,co),
chk1show(cmds,Fans),
cmds : sconcat("( ",
"/* 例3. 不定積分 */@",
"f : 2*sin(2*x)*on3(x,0,%pi/2,cc) + 3*cos(3*x)*on3(x,0,%pi/3,cc),@",
"F : on3integ20(f,x)",
" )"),
Fans : on3(x,0,%pi/3,cc)*sin(3*x)+on3(x,0,%pi/2,cc)*(1-cos(2*x))
+2*on3(x,%pi/2,inf,oo),
chk1show(cmds,Fans),
cashow(on3ev(F,factor)),
print("例4a: 微分関数の積分"),
f : exp(x-1)*on3(x,minf,1,oo) + exp(1-x)*on3(x,1,inf,co),
c0show(f),
df : on3diff(f,x),
c0show("df:on3diff(f,x) ->",df),
out : on3integ20(df,x),
c0show("out : on3integ20(df,x) ->",out),
out1 : on3ev(out,expand),
c0show("out1 : on3ev(out,expand) ->",out1),
c0show(is(equal(out1,f))),
chk1 : on3(x,1,inf,co)-on3(x,1,inf,oo)-on3(x,1,1,cc),
c0show(on3ev(chk1,expand)),
gr2v_fdf(f,df),
print("例4b: 積分関数の微分"),
f : exp(x-1)*on3(x,minf,1,oo) + exp(1-x)*on3(x,1,inf,co),
c0show(f),
F : on3integ20(f,x),
c0show("F : on3integ20(f,x) ->",F),
F : on3ev(F,expand),
c0show("F : on3ev(F,expand) ->",F),
dF : on3diff(F,x),
c0show("dF : on3diff(F,x) ->",dF),
c0show(is(equal(dF,f))),
cmds : sconcat("( ",
"/* F (直前の結果) の微分 on3diff(F,x) と f の比較(端点を除いて一致する)*/ @",
"dF : on3diff(F,x) @",
" )"),
chk1show(cmds,on3decomp(f)),
return("--end of on3integ20_ex--")
)$ /* end of on3integ20_ex() */
/*#######################################################################*/
/*--- on3integ20_new_ex -------------------------------------------------*/
/*#######################################################################*/
on3integ20_new_ex([args]) := block([progn:"<on3integ20_new_ex",
x,ex,F,Fx,Lex0,ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8,
cmds,ans],
ex1 : x^2 * on3(x,0,1,co) + %e^(1-x) * on3(x,1,inf,co),
ex2 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo),
ex3 : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) +
(1-x)*on3(x,1,inf,oo) + sin(x),
ex4 : x*y*on3(x,1,4,co)*on3(y,2,4,co)+ x^2*on3(x,3,4,co)*on3(y,6,8,co),
ex5 : f1*on3(x,a,b,co)+f2*on3(x,c,d,co),
ex6 : f1*on3(x,0,1,co)*on3(y,x,1,co) + f2*on3(x,0,1,co)*on3(y,x,2,co),
ex7 : f1*on3(x,1,2,co)*on3(y,y1(x),y2(x),co),
ex8 : f0+1/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)),
cmds : sconcat("( ",
"/* 例1. 不定積分 */ @",
" ex : %e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co), @",
" F : on3integ20(ex,x) @",
" )"),
ans : (%e^-x*(4*%e^x-3*%e)*on3(x,1,inf,co))/3+(x^3*on3(x,0,1,co))/3,
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
cmds : sconcat("( ",
"/* 例2. 不定積分 */ @",
" ex : x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)+((1-x^2)*on3(x,0,1,oo))/2, @",
" F : on3integ20(ex,x) @",
" )"),
ans : (x^3*on3(x,minf,0,oo))/3-((3*x^2-6*x+1)*on3(x,1,inf,co))/6
-(x*(x^2-3)*on3(x,0,1,oo))/6 ,
chk1show(cmds,ans),
display2d:true, on3show(F), display2d:false,
cmds : sconcat("( ",
"/* 例3. 不定積分 */ @",
" ex : x^2 * on3(x,minf,0,oo) + 1/2*(1-x^2)*on3(x,0,1,oo) ",
" + (1-x)*on3(x,1,inf,oo) + sin(x), @",
" F : on3integ20(ex,x) @",
" )"),
ans : (-((3*cos(x)-x^3)*on3(x,minf,0,oo))/3)
-((6*cos(x)+3*x^2-6*x+1)*on3(x,1,inf,co))/6
-((6*cos(x)+x^3-3*x)*on3(x,0,1,co))/6,
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例4. 不定積分 */ @",
" ex : x^2*on3(x,3,4,co)*on3(y,6,8,co)+x*on3(x,1,4,co)*y*on3(y,2,4,co), @",
" F : on3integ20(ex,x) @",
" )"),
ans : (37*on3(x,4,inf,co)*on3(y,6,8,co))/3
+((x-3)*(x^2+3*x+9)*on3(x,3,4,co)*on3(y,6,8,co))/3
+(15*on3(x,4,inf,co)*y*on3(y,2,4,co))/2
+((x-1)*(x+1)*on3(x,1,4,co)*y*on3(y,2,4,co))/2,
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false,*/
cmds : sconcat("( ",
"/* 例5. 不定積分 */ @",
" ex : f1*on3(x,a,b,co)+f2*on3(x,c,d,co), @",
" F : on3integ20(ex,x) @",
" )"),
ans : (d*f2-c*f2)*on3(x,d,inf,co)+(f2*x-c*f2)*on3(x,c,d,co)
+(b*f1-a*f1)*on3(x,b,inf,co) +(f1*x-a*f1)*on3(x,a,b,co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例6. 不定積分 */ @",
" ex : f1*on3(x,a,b,co)+f2*on3(x,c,d,co), @",
" F : on3integ20(ex,x) @",
" )"),
ans : (d*f2-c*f2)*on3(x,d,inf,co)+(f2*x-c*f2)*on3(x,c,d,co)
+(b*f1-a*f1)*on3(x,b,inf,co) +(f1*x-a*f1)*on3(x,a,b,co),
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
cmds : sconcat("( ",
"/* 例7. 不定積分 */ @",
" ex : f0+1/(f1*on3(x,a,b,co)+f2*on3(x,c,d,co)), @",
" F : on3integ20(ex,x) @",
" )"),
ans : "on3分数多項式かつ非数値領域のため処理を中止する",
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例8. 不定積分関数 (y に関して) */ @",
" ex : f2*on3(x,0,1,co)*on3(y,x,2,co)+f1*on3(x,0,1,co)*on3(y,x,1,co), @",
" F : on3integ20(ex,y) @",
" )"),
ans : on3(x,0,1,co)*(f2*y-f2*x)*on3(y,x,2,co)
+on3(x,0,1,co)*(f1*y-f1*x)*on3(y,x,1,co)
+(2*f2-f2*x)*on3(x,0,1,co)*on3(y,2,inf,co)
+(f1-f1*x)*on3(x,0,1,co)*on3(y,1,inf,co),
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例9. 不定積分関数 (y に関して) */ @",
" ex : f1*on3(x,1,2,co)*on3(y,y1(x),y2(x),co), @",
" F : on3integ20(ex,y) @",
" )"),
ans : (f1*y2(x)-f1*y1(x))*on3(x,1,2,co)*on3(y,y2(x),inf,co)
+on3(x,1,2,co)*(f1*y-f1*y1(x))*on3(y,y1(x),y2(x),co),
chk1show(cmds,ans),
if false then (display2d:true, on3show(F), display2d:false),
cmds : sconcat("( ",
"/* 例10. 2重定積分 */ @",
" ex : (y+x+5)*(on3(x,2,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc) @",
" +on3(x,-3,-2,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc) @",
" +on3(x,-2,2,co)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc) @",
" +on3(x,-2,2,co)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc)), @",
" Fx : on3integ20(ex,y,minf,inf), print(\" Fx = \",Fx), @",
" F : on3integ20(Fx,x,minf,inf)",
" )"),
ans : 25*%pi,
chk1show(cmds,ans),
/* display2d:true, on3show(F), display2d:false, */
return("--end of on3integ20_new_ex--")
)$
/*#######################################################################*/
/*### on3integ20 : on3多項式の数式積分 2020.07.09 ##########################*/
/*#######################################################################*/
on3integ20([args]) :=
block([progn:"<on3integ20>",debug,on3func,var,vl0,vr0,out,
vl,vr,lr,lr1,f,wl,wr,F,definteg,Findef,Fdef,wFdef,wFdef_sum,
Findef_sum,Fdef_sum,Frest,Fl,Fr,Frf],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3integ20('help)--
機能: on3()関数を含む式の不定積分,定積分を返す.(on3decomp()を必要としない)
文法: on3integ20(on3func,var,{vl,vr},...)
F_i(x) = (F_i(x)-F_i(xl))*on3(x,xl,xr,lr)
+(F_i(xr)-F_i(xl))*on3(x,xr,inf,lr1),
where if xl=minf then F_i(xl)=0 (積分定数の定義),
lr=cc or oc then lr1=oo, lr=co or oo then lr1=co
例示: on3integ20(on3func,x) 変数xに関する不定積分
on3integ20(2*x, x) -> x^2
on3integ20(2*x + on3(x,1,3,co), x)$
-> x^2 + (x-1)*on3(x,1,3,co) + (3-1)*on3(x,3,inf,co)
f2 : 2*on3(x,0,%pi/2,cc)*sin(2*x)+cos(x)*on3(x,0,%pi/2,cc)$
on3integ20(f2,x) ->
(-on3(x,0,%pi/2,cc)*cos(2*x))+3*on3(x,%pi/2,inf,oo)
+(sin(x)+1)*on3(x,0,%pi/2,cc)
f4 : 2*on3(x,0,%pi/4,cc)*sin(2*x)+cos(x)*on3(x,0,%pi/2,cc)
on3integ20(f4,x) ->
(on3(x,0,%pi/4,cc)*(1-cos(2*x))+on3(x,%pi/4,inf,oo)
+sin(x)*on3(x,0,%pi/2,cc)+on3(x,%pi/2,inf,oo)
on3integ20(on3func,x,xl,xr) 変数xに関する区間[xl,xr]の定積分
on3integ20(f4,x,minf,inf) -> 2
ev(out4,x = inf) -> 2
on3integ20(exp(-x)*on3(x,0,inf,co),x,0,inf); -> 1
--end of on3integ20('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3integ20('ex)--"),
if false then on3integ20_ex(),
if true then on3integ20_new_ex(),
print("--end of on3integ20('ex)--"),
return("--end of on3integ20('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1], var : args[2],
c1show(progn,on3func,var),
/* on3func:expand(on3func), */
if length(args)>=4 then (definteg:true, vl0 : args[3], vr0 :args[4])
else definteg:false,
c2show(progn,definteg),
c1show(progn, on3typep(on3func), on3vars(on3func)),
if on3typep(on3func)='on3none then (
/* on3none:on3関数を含まない場合 */
Findef_sum : integrate(on3func,ev(var)),
c2show(Findef_sum),
if definteg then (
Fdef_sum : integrate(on3func,ev(var),vl0,vr0),
c2show(Fdef_sum)
),
if definteg then return(Fdef_sum) else return(Findef_sum)
),
if member(on3typep(on3func),['on3unknown]) then (
c0show(progn,on3typep(on3func),"->",
"被積分関数の簡素化を検討して下さい(see on3decomp)"),
return("Error return")
),
c2show(progn,"first",on3func),
if member(on3typep(on3func),['on3inv,'on3polyinv]) then (
out:on3predecomp(on3func,ev(var)),
if is(out=on3func) # true then (
on3func : out,
c1show(progn,"入力式on3funcをon3predecomp()で標準化 ->",on3func)
)
),
outLev(on3info(on3func,ev(var)),"w_"),
c2show(progn,w_Lon3),
c2show(progn,w_Lon3coef),
/* 不定積分関数を生成する */
Findef_sum:0, wFdef_sum:0,
for i:1 thru length(w_Lon3coef) do (
f : w_Lon3coef[i], vl : w_Lon3[i][3], vr : w_Lon3[i][4], lr:w_Lon3[i][5],
F : integrate(f,ev(var)),
c2show(progn,i,f,F),
if is(vl=minf) then wl:0 else wl:ev(F,ev(var)=vl),
Findef : (F-wl)*w_Lon3f[i],
if is(vr=inf) then wr: limit(F,ev(var),inf)
else wr: ev(F,ev(var)=vr),
wFdef : wr - wl,
if lr=cc or lr=oc then lr1:oo,
if lr=co or lr=oo then lr1:co,
Frest : (wr - wl)*on3(ev(var),vr,inf,lr1),
c2show(i,Findef), c2show(i,Frest),
Findef_sum : Findef_sum + Findef + Frest,
wFdef_sum : wFdef_sum + wFdef
),
c2show("不定積分関数 ",Findef_sum),
c2show("全区間定積分 ",wFdef_sum),
/*
out:on3predecomp(Findef_sum,ev(var)),
if is(out=Findef_sum) # true then (
Findef_sum : out,
c1show(progn,"Findef_sumをon3predecomp()で標準化 ->",Findef_sum)
),
*/
outLev(on3info(Findef_sum,ev(var)),"w_"),
c2show(w_Lon3f),c2show(w_Lon3coef),
/* 定積分を求める */
if definteg then (
if is(vl0=minf) then Fl:0 else Fl:ev(Findef_sum,ev(var)=vl0),
if is(vr0=inf) then Fr: ev(Findef_sum,ev(var)=0.999*inf)
else Fr: ev(Findef_sum,ev(var)=vr0),
c2show("定積分(不定積分関数より)==",var,ev(var),vl0,vr0),
c2show(Fl),c2show(Fr),
Fdef_sum : Fr - Fl,
c2show("定積分(不定積分関数より) ",Fdef_sum),
if is(vl0=minf) and is(vr0=inf) then Fdef_sum : wFdef_sum,
c2show("定積分",Fdef_sum)
),
if member('view,args) and (length(listofvars(on3func)) = 1) then (
c1show("Plot of f(x) and F(x)"),
g1 : gr2v([explicit(on3func,ev(var),0,%pi/2)],'title="f(x)",'noview),
g2 : gr2v([explicit(Findef_sum,ev(var),0,%pi/2)],'title="F(x)",'noview),
mk_draw([g1,g2],
['file_name=sconcat(figs_dir,"/","fig-fandF"),
'columns=2, 'dimensions=[1000,500]],
'view)
), /* end of if-TRUE */
killvars(["w_"]),
if definteg then return(Fdef_sum) else return(Findef_sum)
)$ /* end of on3integ20() */
/*--- fsplit: on3solve.mx ---------------------------------------------*/
/*#####################################################################*/
/* <on3solve> on3 関数方程式の求解 (多変数対応版) */
/*#####################################################################*/
on3solve([args]) := block([progn:"<on3solve>",debug,
eqns:[],eqvars:[],wind:[],type,tlr:[],
tvlist:[tv1,tv2,tv3,tv4,tv5,tv6],
teqns:[],teqnsm:[],LR:[],fL:[],fLT:[],w,w1,w2,
var,tl,tm,tr,ftm,wftml,wftmr,wfl,wfr,
eqsum,teqsum,number,tvar,wans:[],wansk,chk,ans:[]],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3solve('help)--
機能: on3 関数方程式の求解 (多変数対応版)
文法: on3solve(funcs,vars,...)
例示:
例1. 不等式の求解
eq1 : x^2 * on3(x,minf,0,oo) + (1-x^2)/2 * on3(x,0,1,co)
+ (1-x) * on3(x,1,inf,co) - 1/8$
out : on3solve(eq1, x);
-> [x = -1/2^(3/2),x = sqrt(3)/2]
例2. 連立不等式の求解
eq21 : (x^2+y^2-2)*on3(y,0,inf,co) + (x^2+y^2-9)*on3(y,minf,0,oo)$
eq22 : (x-y)*on3(x,1,inf,co) + (3*x-2*y)*on3(x,0,1,co)
+ (2*x-y)*on3(x,minf,0,oo)$
out : on3solve([eq21,eq22],[x,y]);
-> [[x = -3/sqrt(5),y = -6/sqrt(5)],
[x = 2^(3/2)/sqrt(13),y = (3*sqrt(2))/sqrt(13)],
[x = 1,y = 1]]
--end of on3integ('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3solve('ex)--"),
on3solve_ex(),
print("--end of on3solve('ex)--"),
return("--end of on3solve('ex)--"),
block_main, /* main ブロック ====================================*/
funcs :args[1], vars : args[2],
d1show("--- enter on3solve ---"),
d2show(funcs), d2show(vars),
/*** S1 ******************************************************/
d1show("S1: 前処理:端点情報を得る"),
d1show("LR : [[x,y],[[minf,x1,...,inf],[minf,y1,...,inf]],[true,false]]---"),
eqns:[false], eqvars:[false],
if not listp(funcs) then eqns[1]:funcs else eqns:copylist(funcs),
if not listp(vars) then eqvars[1]:vars else eqvars:copylist(vars),
eqsum : 0,
for k thru length(eqns) do ( /* タイプの検査 */
type:on3typep(eqns[k]),
LR : on3lrl(eqns[k]),
d2show("タイプの検査",type), d2show("端点検査",LR),
number:true,
for i thru length(LR[1]) do if LR[3][i]=false then number:false,
if (type=on3inv or type=on3polyinv) and number=false then
( print(" ---> on3分数式かつ非数値領域のため処理を中止する"),
return("Not Evaluated")),
eqns[k] : on3decomp(eqns[k]),
eqsum : eqsum + eqns[k] ), /* end of for-k */
d2show(eqns),
LR : on3lrl(eqsum),
d2show(LR),
/***** S2 ****************************************************/
d1show("S2: 関数部とon3部を分離する"),
teqns:copylist(eqns),
teqsum:0,
for i thru length(eqns) do (
fL : f2l(eqns[i]),
for j thru length(LR[1]) do (
var : LR[1][j], tvar:tvlist[j],
d2show(var,tvar),
fLT : scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var then
(d2show(u), u:ev(u,u[2]=tvar), u) else u ), fL),
fL : fLT ), /* end of for-j */
teqns[i]:l2f(fL),
teqsum : teqsum + teqns[i]
), /* end of for-i */
d1show(teqns),
/***** S3 ***************************************************************/
d1show("S3: 変数の個数による次元処理を回避する方策"),
d2show(LR),
wind : makelist([],i,1,length(LR[1])),
for i:1 thru length(LR[1]) do wind[i] : makelist(j,j,1,length(LR[2][i])-1),
d2show(ind),
if length(LR[1]) = 1 then (
out : outermap(h,wind[1],1),
h(i) := [[LR[2][1][i],LR[2][1][i+1]]],
out: makelist(h(i),i,1,length(LR[2][1])-1),
out : ev(out), d2show(out) ) /* end of 1-var */
else if length(LR[1]) > 1 then (
/**** 以下の関数を自動生成する
--- for LR[1]=2
out : flatten(outermap(h, wind[1], wind[2])),
h(i1,i2) :=
[ [LR[2][1][i1],LR[2][1][i1+1]], [LR[2][2][i2],LR[2][2][i2+1]] ],
--- for LR[1]=3
out : flatten(outermap(h, wind[1], wind[2], wind[3])),
h(i1,i2,i3) :=
[ [LR[2][1][i1],LR[2][1][i1+1]], [LR[2][2][i2],LR[2][2][i2+1]],
[LR[2][3][i3],LR[2][3][i3+1]] ],
***/
w : "flatten(outermap(h",
for i:1 thru length(LR[1]) do w:sconcat(w,", wind[",i,"]"),
w : sconcat(w,"))"),
d2show(w),
out : eval_string(w),
w1 : "h(i1",
for i:2 thru length(LR[1]) do w1:sconcat(w1,",i",i), w1:sconcat(w1,") :="),
d2show(w1),
w2 : "[ [LR[2][1][i1],LR[2][1][i1+1]]",
for i:2 thru length(LR[1]) do
w2 : sconcat(w2,", [LR[2][",i,"][i",i,"],LR[2][",i,"][i",i,"+1]]"),
w2 : sconcat(w2," ]"),
d2show(w2),
w : sconcat(w1,w2),
eval_string(w),
out:ev(out), d2show(out) ), /* end of else-if */
kill(h),
/**** S4 **************************************/
d1show("S4: 排他的領域毎の求解処理"),
for i thru length(out) do ( /* 排他的領域毎の処理 */
teqnsm : copylist(teqns),
tlr : makelist(0,j,1,length(LR[1])),
for j thru length(LR[1]) do ( /* 変数毎の処理 */
tl : out[i][j][1],
tm : (out[i][j][1]+out[i][j][2])/2,
tr : out[i][j][2],
d2show(tl,tm,tr),
ftm:ev(teqsum,ev(tvlist[j])=tm), /* 関数抽出(mirage) */
d2show(tm,ftm),
wftml : ev(ftm,ev(LR[1][j])=tl),
wftmr : ev(ftm,ev(LR[1][j])=tr),
for jj thru length(LR[1]) do (
if jj # j then wftml:ev(wftml,tvlist[jj]=ev(LR[1][jj])),
if jj # j then wftmr:ev(wftmr,tvlist[jj]=ev(LR[1][jj]))
) /* end of for-jj */ ,
wfl:ev(eqsum,ev(LR[1][j])=tl), wfr:ev(eqsum,ev(LR[1][j])=tr),
if wfl = wftml and wfr = wftmr then tlr[j]:cc
else if wfl = wftml and wfr # wftmr then tlr[j]:co
else if wfl # wftml and wfr=wftmr then tlr[j]:oc
else tlr[j]:oo,
d2show(tlr),
teqnsm : ev(teqnsm, ev(tvlist[j])=tm),
d2show(teqnsm)
), /* end of for-j 変数 */
wans:[],
d1show(teqnsm),
wans : solve(teqnsm,LR[1]), /*** 求解処理 ***/
d1show(wans),
if not listp(wans) then return(),
for k:1 thru length(wans) do (
chk : 1,
for j thru length(LR[1]) do (
tl : out[i][j][1], tr : out[i][j][2],
if length(LR[1])=1 then wansk : rhs(wans[k])
else wansk : rhs(wans[k][j]),
d2show(tl,tr,tlr[j],wansk,on3(wansk,tl,tr,tlr[j])),
chk : chk * on3(wansk,tl,tr,tlr[j])
), /* end of for-j */
d1show(chk,wans[k]),
if chk = 1 then ans : endcons(wans[k],ans),
d2show(ans) ) /* end of for-k */
), /* end of for-i */
return(ans)
)$
/*#######################################################################*/
/*--- on3solve_ex ------------------------------------------------------*/
/*#######################################################################*/
on3solve_ex([args]) := block([progn:"<on3solve_ex>",
eq1, out, eq21, eq22, ans],
print("--begin of on3solve_ex--"),
cmds : sconcat("( ",
"/* 例1. 不等式の求解 */ @",
"eq1 : x^2 * on3(x,minf,0,oo) + (1-x^2)/2 * on3(x,0,1,co) ",
"+ (1-x) * on3(x,1,inf,co) -1/8, @",
"out : on3solve(eq1, x)",
" )"),
ans : [x = -1/2^(3/2),x = sqrt(3)/2],
chk1show(cmds,ans),
cmds : sconcat("( ",
"/* 例2. 連立不等式の求解 */ @",
"eq21 : (x^2+y^2-2)*on3(y,0,inf,co) + (x^2+y^2-9)*on3(y,minf,0,oo), @",
"eq22 : (x-y)*on3(x,1,inf,co) + (3*x-2*y)*on3(x,0,1,co) ",
" + (2*x-y)*on3(x,minf,0,oo), @",
"out : on3solve([eq21,eq22],[x,y])",
" )"),
ans : [[x = -3/sqrt(5),y = -6/sqrt(5)],
[x = 2^(3/2)/sqrt(13),y = (3*sqrt(2))/sqrt(13)],[x = 1,y = 1]],
chk1show(cmds,ans),
return("--- end of on3solve_ex ---")
)$
/*##################################################################################*/
/*### on3chgv : 矩形領域の変数変換
f(x,y) on D(x,y) -> t=x+y, u=y -> g(t,u) on G(t,u) -> g(t) = integral(g(t,u),u)
2020.06.03 ###*/
/*##################################################################################*/
on3chgv([args]) := block([progn:"<on3chgv>",debug,f0,sum,sw,on3part,outf,outf_coef,out],
debug:ifargd(),
f0 : args[1],
outLev(on3info(f0,x),"x_"),
c1show(progn,x_Lon3coef),
sum : 0,
for i:1 thru length(x_Lon3f) do (
c1show(x_Lon3coef[i]),
outLev(on3info(x_Lon3coef[i],y),"y_"),
c1show(y_Lon3coef),
for j:1 thru length(y_Lon3f) do (
sw : 1,
if sw=1 then (
c1show(i,j,x_Lon3f[i],y_Lon3f[j],y_Lon3coef[j]),
on3part : on3chgvar2(x_Lon3f[i]*y_Lon3f[j])
) else if sw=2 then (
on3part : on3ineq([[t-u,0,1,cc],[u,0,1,cc]],'resultonly,'noplot)
) else if sw=3 then (
xl:x_Lon3[i][3], xr:x_Lon3[i][4],xlr:x_Lon3[i][5],
yl:y_Lon3[j][3], yr:y_Lon3[j][4],ylr:y_Lon3[j][5],
c1show(xl,xr,yl,yr),
on3part : on3(t,xl+yl,xl+yr,co)*on3(u,yl,t-xl,cc)
+ on3(t,xl+yr,xr+yl,co)*on3(u,yl,yr,cc)
+ on3(t,xr+yl,xr+yr,cc)*on3(u,t-xr,yr,cc)
)
else (
cshow(progn,"unknow sw =",sw), quit()
),
sum : sum + y_Lon3coef[j]*on3part
)
), /* end of for-i */
c1show(sum),
sum : ratsubst(u,y,sum),
sum : ratsubst(t-u,x,sum),
c1show(sum),
outLev(on3info(sum,t,'factor),"w_"),
out : w_outf,
c1show(out),
/* g(t,u) = w_outf */
killvars(["x_","y_","w_"]),
return(out)
)$ /* end of on3chgv() */
/*### --- fsplit: on3chgvar2.mx --- #####################################*/
/* <on3chgvar2> */
/* 矩形領域上の２変数関数f(x,y)を変数変換(t=x+y,u=y)した g(t,u) を返す */
/*######################################################################*/
on3chgvar2([args]) := block([progn:"<on3chgvar2>",debug,func,
i,funcL:[], x,y,x0,x1,y0,y1,lr1,lr2,f,fout,wL,won3,outL:[],outfun],
local(f),
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3chgvar2('help)--
機能: 矩形領域上の２変数関数f(x,y)を変数変換(t=x+y,u=y)した g(t,u) を返す
文法: on3chgvar2(func,...)
例示:
ex : on3(x,0,1,co)*on3(y,0,1,co)$ on3chgvar2(ex);
-> on3(t,1,2,co)*on3(u,t-1,1,cc)+on3(t,0,1,co)*on3(u,0,t,cc)
ex : on3(x,0,inf,co)*on3(y,0,inf,co)$ on3chgvar2(ex);
-> on3(t,0,inf,co)*on3(u,0,t,cc)
--end of on3chgvar2('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3chgvar2('ex)--"),
on3chgvar2_ex(),
print("--end of on3chgvar2('ex)--"),
return("--end of on3chgvar2('ex)--"),
block_main, /* main ブロック ====================================*/
func : ratexpand(args[1]),
c1show(progn,func),
funcL : f2l(on3std(func)),
d1show(funcL),
if funcL[1]="*" then funcL : ["+",funcL], /* 単項式の多項式化 */
d1show("after",funcL),
for i:2 thru length(funcL) do (
c1show(progn,i,funcL[i]),
x : funcL[i][3][2], y : funcL[i][4][2],
x0 : funcL[i][3][3], y0 : funcL[i][4][3],
x1 : funcL[i][3][4], y1 : funcL[i][4][4],
lr1 : funcL[i][3][5], lr2 : funcL[i][4][5],
define(f(x,y), funcL[i][2]),
d1show(f(x,y)),
fout : f(t-u,u),
d1show(fout),
/*** case begin *****************************************************/
if x0=minf and x1=inf then (
/*1*/ if y0=minf and y1=inf then (
wL : [fout,[t,minf,inf,oo, u,minf,inf,oo]], outL:endcons(wL, outL))
/*2*/ else if y0=minf and numberp(y1) then (
wL : [fout,[t,minf,inf,oo, u,minf,y1,oc]], outL:endcons(wL, outL))
/*3*/ else if numberp(y0) and y1=inf then (
wL : [fout,[t,minf,inf,oo, u,y0,inf,co]], outL:endcons(wL, outL))
/*4*/ else if numberp(y0) and numberp(y1) then (
wL : [fout,[t,minf,inf,oo, u,y0,y1,cc]], outL:endcons(wL, outL))
)
else if x0=minf and numberp(x1) then (
/*5*/ if y0=minf and y1=inf then (
wL : [fout,[t,minf,inf,oo, u,t-x1,inf,co]], outL:endcons(wL, outL))
/*6*/ else if y0=minf and numberp(y1) then (
wL : [fout,[t,minf,x1+y1,oc, u,t-x1,y1,cc]], outL:endcons(wL, outL))
/*7*/ else if numberp(y0) and y1=inf then (
wL : [fout,[t,minf,x1+y0,oc, u,y0,inf,co]], outL:endcons(wL, outL),
wL : [fout,[t,x1+y0,inf,co, u,t-x1,inf,co]], outL:endcons(wL, outL))
/*8*/ else if numberp(y0) and numberp(y1) then (
wL : [fout,[t,minf,x1+y0,oc, u,y0,y1,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x1+y0,y1,cc, u,t-x1,y1,cc]], outL:endcons(wL, outL))
)
else if numberp(x0) and x1=inf then (
/*9*/ if y0=minf and y1=inf then (
wL : [fout,[t,minf,inf,oo, u,minf,t-x0,oc]], outL:endcons(wL, outL))
/*10*/ else if y0=minf and numberp(y1) then (
wL : [fout,[t,minf,x0+y1,oc, u,minf,t-x0,oc]],outL:endcons(wL, outL),
wL : [fout,[t,x0+y1,inf,co, u,minf,y1,oc]],outL:endcons(wL, outL))
/*11*/ else if numberp(y0) and y1=inf then (
wL : [fout,[t,x0+y0,inf,co, u,y0,t-x0,cc]], outL:endcons(wL, outL))
/*12*/ else if numberp(y0) and numberp(y1) then (
wL : [fout,[t,x0+y0,x0+y1,cc, u,y0,t-x0,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x0+y1,inf,co, u,y0,y1,cc]], outL:endcons(wL,outL))
)
else if numberp(x0) and numberp(x1) then (
/*13*/ if y0=minf and y1=inf then (
wL : [fout,[t,minf,inf,oo, u,t-x1,t-x0,cc]], outL:endcons(wL,outL))
/*14*/ else if y0=minf and numberp(y1) then (
wL : [fout,[t,minf,x0+y1,oc, u,t-x1,t-x0,cc]],outL:endcons(wL, outL),
wL : [fout,[t,x0+y1,x1+y1,cc, u,t-x1,y1,cc]], outL:endcons(wL,outL))
/*15*/ else if numberp(y0) and y1=inf then (
wL : [fout,[t,x0+y0,x1+y0,cc, u,y0,t-x0,cc]], outL:endcons(wL,outL),
wL : [fout,[t,x1+y0,inf,co, u,t-x1,t-x0,cc]], outL:endcons(wL,outL))
/*16*/ else if numberp(y0) and numberp(y1) and x0+y1 < x1+y0 then (
wL : [fout,[t,x0+y0,x0+y1,co, u,y0,t-x0,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x0+y1,x1+y0,co, u,y0,y1,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x1+y0,x1+y1,co, u,t-x1,y1,cc]], outL:endcons(wL, outL))
/*17*/ else if numberp(y0) and numberp(y1) and x0+y1 = x1+y0 then (
wL : [fout,[t,x0+y0,x0+y1,co, u,y0,t-x0,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x1+y0,x1+y1,co, u,t-x1,y1,cc]], outL:endcons(wL, outL))
/*18*/ else if numberp(y0) and numberp(y1) and x0+y1 > x1+y0 then (
wL : [fout,[t,x0+y0,x1+y0,co, u,y0,t-x0,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x1+y0,x0+y1,co, u,t-x1,t-x0,cc]], outL:endcons(wL, outL),
wL : [fout,[t,x0+y1,x1+y1,co, u,t-x1,y1,cc]], outL:endcons(wL, outL))
)
else print("*** Error in on3chgvar2 : 想定外のケースを検出した ***")
/*** case end **********************************************************/
),
d1show(outL),
/*** 結果を関数形に変換する ***/
outfun : 0,
for i thru length(outL) do (
if length(outL[i][2]) = 4 then
won3 : funmake(on3,[outL[i][2][1],outL[i][2][2],
outL[i][2][3],outL[i][2][4]])
else if length(outL[i][2]) = 8 then
won3 : funmake(on3,[outL[i][2][1],outL[i][2][2],
outL[i][2][3],outL[i][2][4]])
*
funmake(on3,[outL[i][2][5],outL[i][2][6],
outL[i][2][7],outL[i][2][8]]),
outfun : outfun + outL[i][1] * won3
), kill(f),
d1show(outfun),
return(outfun)
)$ /* end of on3chgvar2() */
/*#######################################################################*/
/*--- on3chgvar2_ex -----------------------------------------------------*/
/*#######################################################################*/
on3chgvar2_ex([args]) := block([progn:"<on3chgvar2_ex>",debug,
x,y,ex0,ex1,ex2,ex3,ex4,ex,out],
debug:ifargd(),
print("領域(x,y)を変換{t=x+y,u=y}によって移した領域(t,u)を求める"),
ex0 : on3(x,0,1,co)* on3(y,0,1,co),
ex1 : on3(x,0,inf,co)* on3(y,0,inf,co),
ex2 : on3(x,1,inf,co)* on3(y,1,inf,co),
ex3 : on3(x,minf,0,oc)* on3(y,minf,0,oc),
ex4 : on3(x,minf,inf,oo)* on3(y,minf,inf,oo),
for ex in [ex0,ex1,ex2,ex3,ex4] do
(out:on3chgvar2(ex), ldisplay(ex),ldisplay(out)),
return("---done---")
)$
/*#######################################################################*/
/*--- on3chgvar2_test ---------------------------------------------------*/
/*#######################################################################*/
on3chgvar2_test() := block([progn:"<on3chgvar2_test>",debug,
ex,ans,cmds, x0,x1,y0,y1,i0,i1],
x0 : 0, x1 : 1, y0 : 0, y1 : 1,
ex[1] : on3(x, minf, inf, oo) * on3(y, minf, inf, oo),
ans[1] : on3(t,minf,inf,oo) * on3(u,minf,inf,oo),
ex[2] : on3(x,minf, inf, oo) * on3(y, minf, y1, oc),
ans[2] : on3(t,minf,inf,oo) * on3(u,minf,y1,oc),
ex[3] : on3(x, minf, inf, oo) * on3(y, y0, inf, co),
ans[3] : on3(t,minf,inf,oo) * on3(u,y0,inf,co),
ex[4] : on3(x, minf, inf, oo) * on3(y, y0, y1, cc),
ans[4] : on3(t,minf,inf,oo) * on3(u,y0,y1,cc),
ex[5] : on3(x, minf, x1, oc) * on3(y, minf, inf, oo),
ans[5] : on3(t,minf,inf,oo) * on3(u,t-x1,inf,co),
ex[6] : on3(x, minf, x1, oc) * on3(y, minf, y1, oc),
ans[6] : on3(t,minf,x1+y1,oc) * on3(u,t-x1,y1,cc),
ex[7] : on3(x, minf, x1, oc) * on3(y, y0, inf, co),
ans[7] : on3(t,minf,x1+y0,oc) * on3(u,y0,inf,co)
+ on3(t,x1+y0,inf,co) * on3(u,t-x1,inf,co),
ex[8] : on3(x, minf, x1, oc) * on3(y, y0, y1, cc),
ans[8] : on3(t,minf,x1+y0,oc) * on3(u,y0,y1,cc)
+ on3(t,x1+y0,y1,cc) * on3(u,t-x1,y1,cc),
ex[9] : on3(x, x0, inf, co) * on3(y, minf, inf, oo),
ans[9] : on3(t,minf,inf,oo) * on3(u,minf,t-x0,oc),
ex[10] : on3(x, x0, inf, co) * on3(y, minf, y1, oc),
ans[10]: on3(t,minf,x0+y1,oc) * on3(u,minf,t-x0,oc)
+ on3(t,x0+y1,inf,co) * on3(u,minf,y1,oc),
ex[11] : on3(x, x0, inf, co) * on3(y, y0, inf, co),
ans[11]: on3(t,x0+y0,inf,co) * on3(u,y0,t-x0,cc),
ex[12] : on3(x, x0, inf, co) * on3(y, y0, y1, cc),
ans[12]: on3(t,x0+y0,x0+y1,cc) * on3(u,y0,t-x0,cc)
+ on3(t,x0+y1,inf,co) * on3(u,y0,y1,cc),
ex[13] : on3(x, x0, x1, cc) * on3(y, minf, inf, oo),
ans[13]: on3(t,minf,inf,oo) * on3(u,t-x1,t-x0,cc),
ex[14] : on3(x, x0, x1, cc) * on3(y, minf, y1, oc),
ans[14]: on3(t,minf,x0+y1,oc) * on3(u,t-x1,t-x0,cc)
+ on3(t,x0+y1,x1+y1,cc) * on3(u,t-x1,y1,cc),
ex[15] : on3(x, x0, x1, cc) * on3(y, y0, inf, co),
ans[15]: on3(t,x0+y0,x1+y0,cc) * on3(u,y0,t-x0,cc)
+ on3(t,x1+y0,inf,co) * on3(u,t-x1,t-x0,cc),
x0 : 0, x1 : 3, y0 : 0 , y1 : 2,
ex[16] : on3(x, 0, 3, cc) * on3(y, 0, 2, cc), /* x0 + y1 < x1 + y0 */
ans[16]: on3(t,x0+y0,x0+y1,co) * on3(u,y0,t-x0,cc)
+ on3(t,x0+y1,x1+y0,co) * on3(u,y0,y1,cc)
+ on3(t,x1+y0,x1+y1,co) * on3(u,t-x1,y1,cc),
x0 : 0, x1 : 1, y0 : 0 , y1 : 1,
ex[17] : on3(x, 0, 1, cc) * on3(y, 0, 1, cc), /* x0 + y1 = x1 + y0 */
ans[17]: on3(t,x0+y0,x0+y1,co) * on3(u,y0,t-x0,cc)
+ on3(t,x1+y0,x1+y1,co) * on3(u,t-x1,y1,cc),
x0 : 0, x1 : 2, y0 : 0 , y1 : 3,
ex[18] : on3(x, 0, 2, cc) * on3(y, 0, 3, cc), /* x0 + y1 > x1 + y0 */
ans[18]: on3(t,x0+y0,x1+y0,co) * on3(u,y0,t-x0,cc)
+ on3(t,x1+y0,x0+y1,co) * on3(u,t-x1,t-x0,cc)
+ on3(t,x0+y1,x1+y1,co) * on3(u,t-x1,y1,cc),
/************ case end ******************************/
print("=== on3chgvar2_test start ==="),
i0 : 1, i1 : 18,
for i:1 thru i1 do (
cmds : sconcat("(","c0show(i,ex[i]), on3chgvar2(ex[i])",")"),
chk1show(cmds,ans[i])
),
return("---on3chgvar2_test end ---")
)$
/*#######################################################################*/
/*### on3D2G_ex() : 例と解答 */
/*#######################################################################*/
on3D2G_ex([args]) := block([progn:"<on3D2G_ex>",debug,
ex16,ans16,ex15,ans15,ex14,ans14,ex13,ans13,
ex12,ans12,ex11,ans11,ex10,ans10,ex9,ans9,
ex8,ans8,ex7,ans7,ex6,ans6,ex5,ans5,
ex4,ans4,ex3,ans3,ex2,ans2,ex1,ans1, exans, ex,out,ans,ansL],
debug:ifargd(),
ex1 : on3(x, minf, inf, oo) * on3(y, minf, inf, oo),
ans1 : [["ans1:E",0, on3(t,minf,inf,oo) * on3(u,minf,inf,oo), 0]],
ex2 : on3(x,minf, inf, oo) * on3(y, minf, yr, oc),
ans2 : [["ans2:E",0, on3(t,minf,inf,oo) * on3(u,minf,yr,oc), 0]],
ex3 : on3(x, minf, inf, oo) * on3(y, yl, inf, co),
ans3 : [["ans3:E",0, on3(t,minf,inf,oo) * on3(u,yl,inf,co), 0]],
ex4 : on3(x, minf, inf, oo) * on3(y, yl, yr, cc),
ans4 : [["ans4:A",0, on3(t,minf,inf,oo) * on3(u,yl,yr,cc), 0]],
ex5 : on3(x, minf, xr, oc) * on3(y, minf, inf, oo),
ans5 : [["ans5:E",0, 0, on3(t,minf,inf,oo) * on3(u,t-xr,inf,co)]],
ex6 : on3(x, minf, xr, oc) * on3(y, minf, yr, oc),
ans6 : [["ans6:E",0, 0, on3(t,minf,xr+yr,oc) * on3(u,t-xr,yr,cc)]],
ex7 : on3(x, minf, xr, oc) * on3(y, yl, inf, co),
ans7 : [["ans7:E",0, on3(t,minf,xr+yl,oc) * on3(u,yl,inf,co),
on3(t,xr+yl,inf,oo) * on3(u,t-xr,inf,co)]],
ex8 : on3(x, minf, xr, oc) * on3(y, yl, yr, cc),
ans8 : [["ans8:A",0, on3(t,minf,xr+yl,oc) * on3(u,yl,yr,cc),
on3(t,xr+yl,xr+yr,oc) * on3(u,t-xr,yr,cc)]],
ex9 : on3(x, xl, inf, co) * on3(y, minf, inf, oo),
ans9 : [["ans9:E",on3(t,minf,inf,oo) * on3(u,minf,t-xl,oc), 0, 0]],
ex10 : on3(x, xl, inf, co) * on3(y, minf, yr, oc),
ans10: [["ans10:E", on3(t,minf,xl+yr,oc) * on3(u,minf,t-xl,oc),
on3(t,xl+yr,inf,oo) * on3(u,minf,yr,oc), 0]],
ex11 : on3(x, xl, inf, co) * on3(y, yl, inf, co),
ans11: [["ans11:E", on3(t,xl+yl,inf,co) * on3(u,yl,t-xl,cc), 0, 0]],
ex12 : on3(x, xl, inf, co) * on3(y, yl, yr, cc),
ans12: [["ans12:A", on3(t,xl+yl,xl+yr,cc) * on3(u,yl,t-xl,cc),
on3(t,xl+yr,inf,oo) * on3(u,yl,yr,cc), 0]],
ex13 : on3(x, xl, xr, cc) * on3(y, minf, inf, oo),
ans13: [["ans13:B", 0, on3(t,minf,inf,oo) * on3(u,t-xr,t-xl,cc), 0]],
ex14 : on3(x, xl, xr, cc) * on3(y, minf, yr, oc),
ans14: [["ans14:B", 0, on3(t,minf,xl+yr,oc) * on3(u,t-xr,t-xl,cc),
on3(t,xl+yr,xr+yr,oc) * on3(u,t-xr,yr,cc)]],
ex15 : on3(x, xl, xr, cc) * on3(y, yl, inf, co),
ans15: [["ans15:B ",
on3(t,xl+yl,xr+yl,cc) * on3(u,yl,t-xl,cc),
on3(t,xr+yl,inf,oo) * on3(u,t-xr,t-xl,cc),0]],
/* type A : xr-xl > yr-yl <=> xr+yl > xl+yr
xl : 0, xr : 3, yl : 0 , yr : 2,
type B : xr-xl < yr-yl <=> xr+yl < xl+yr
xl : 0, xr : 2, yl : 0 , yr : 3,
type E : xr-xl = yr-yl <=> xr+yl = xl+yr
xl : 0, xr : 2, yl : 0 , yr : 2,
*/
ex16 : on3(x, xl, xr, cc) * on3(y, yl, yr, cc),
ans16: [["ans16A: when xr-xl > yr-yl ",
on3(t,xl+yl,xl+yr,cc) * on3(u,yl,t-xl,cc),
on3(t,xl+yr,xr+yl,oc) * on3(u,yl,yr,cc),
on3(t,xr+yl,xr+yr,oc) * on3(u,t-xr,yr,cc)],
["ans16B: when xr-xl < yr-yl",
on3(t,xl+yl,xr+yl,cc) * on3(u,yl,t-xl,cc),
on3(t,xr+yl,xl+yr,oc) * on3(u,t-xr,t-xl,cc),
on3(t,xl+yr,xr+yr,oc) * on3(u,t-xr,yr,cc)],
["ans16E(Aに合わせる): when xr-xl = yr-yl, yl+xr=yr+xl is true",
on3(t,xl+yl,xl+yr,cc) * on3(u,yl,t-xl,cc),0,
on3(t,xr+yl,xr+yr,oc) * on3(u,t-xr,yr,cc)] ],
/***run***/
cshow(progn," is go."),
on3D2G(ex16),
out : on3D2G(ex16,'typeA),
ans : ans16[1][2]+ans16[1][3]+ans16[1][4],
chkshow(ans16[1][1],out,ans),
out : on3D2G(ex16,'typeB),
ans : ans16[2][2]+ans16[2][3]+ans16[2][4],
chkshow(ans16[2][1],out,ans),
out : on3D2G(ex16,'typeE),
ans : ans16[3][2]+ans16[3][3]+ans16[3][4],
chkshow(ans16[3][1],out,ans),
if member('test, args) then for exans in [[ex15,ans15],[ex14,ans14],[ex13,ans13],
[ex12,ans12],[ex11,ans11],[ex10,ans10],[ex9,ans9],
[ex8,ans8],[ex7,ans7],[ex6,ans6],[ex5,ans5],
[ex4,ans4],[ex3,ans3],[ex2,ans2],[ex1,ans1]] do (
ex : exans[1], ansL : exans[2],
ans : ansL[1][2]+ansL[1][3]+ansL[1][4],
out : on3D2G(exans[1]),
chkshow(ansL[1][1],out,ans),
c0show("-- end of ",progn,"---")
),
return("-- set on3D2G_ex --")
)$ /* end of on3D2G_ex() */
/*#########################################################################*/
/* on3D2G : 矩形領域 D(x,y) 変換 t=x+y, u=y のとき G(t,u) を求める 2020.06.19 */
/*#########################################################################*/
on3D2G([args]) := block([progn:"<on3D2G>",debug,
exans, ex,ans, exL, xL,yL, xl,xr,xlr, yl,yr,ylr, xrng, yrng,type,D,G,
x_l,x_r,y_l,y_r,
t_l,t_r, tl,tr,tlr, tL, u_l,u_r, ul,ur,ulr, uL,
Ga,Gb,out,anss ],
/*#######################################################################*/
/*### plus : minf inf を含む変数x,yの和(差)の演算 2020.06.12 ###*/
/*#######################################################################*/
plus(x,y) := block([],
c1show(x,y),
if (x = -minf) then x : inf,
if (y = -minf) then y : inf,
if (x = -inf) then x : minf,
if (y = -inf) then y : minf,
if (x = minf) and (y = minf) then return(minf),
if (x = inf) and (y = inf) then return(inf),
if (x = minf) and (y # inf) then return(minf),
if (y = minf) and (x # inf) then return(minf),
if (x = inf) and (y # minf) then return(inf),
if (y = inf) and (x # minf) then return(inf),
return(x+y)
), /* end of plus() */
/*##############################################################################*/
/* addjoin : on3項の和の結合 2020.06.27 */
/*##############################################################################*/
addjoin(tl,tr,tlr, ul,ur,ulr) := block([progn:"<addjoin>",debug,
t_l, t_r, tL, uL, iL,indL],
debug:ifargd(),
t_l:[0,0,0], t_r:[0,0,0],
for i:1 thru 3 do (
t_l[i] : if member(tlr[i],[cc,co]) then "c" else "o",
t_r[i] : if member(tlr[i],[oc,cc]) then "c" else "o"
),
c1show(progn,t_l,t_r),
c1show(progn,tl,tr,tlr),
tL:[0,0,0], uL:[0,0,0],
for i:1 thru 3 do (
c1show(i,tl[i],tr[i],tlr[i]),
tL[i] : funmake(on3,[t,tl[i],tr[i],tlr[i]]),
if (tlr[i] # cc) and (tl[i]=tr[i]) then tL[i]:0,
/* 重要 is(equal(minf,0)) -> false, is(equal(minf+inf,0)) -> error */
if (tl[i] # minf+inf) and (tr[i] # minf+inf)
and is(equal(tr[i]-tl[i],0)) then tL[i]:0,
uL[i] : funmake(on3,[u,ul[i],ur[i],ulr[i]]),
if (ulr[i] # cc) and (ul[i]=ur[i]) then uL[i]:0
),
c1show(tL),c1show(uL),
indL : [[1,2],[1,3],[2,3]], c1show(indL),
for iL in indL do (
c1show(iL,tL[iL[1]]),
if (tlr[iL[1]] # cc) and (tl[iL[1]]=tr[iL[1]]) then tL[iL[1]]:0,
if (tlr[iL[2]] # cc) and (tl[iL[2]]=tr[iL[2]]) then tL[iL[2]]:0,
if (uL[iL[1]]=uL[iL[2]]) and (tr[iL[1]]=tl[iL[2]]) and (tL[iL[1]] # 0)
then (
c1show("match : ",iL),
tr[iL[1]]:tr[iL[2]],
tlr[iL[1]]:eval_string(sconcat(t_l[iL[1]],t_r[iL[2]])),
tl[iL[2]] : minf, tr[iL[2]]:minf,tlr[iL[2]]:oo,
tL[iL[1]] : funmake(on3,[t,tl[iL[1]],tr[iL[1]],tlr[iL[1]]]),
if (tlr[iL[1]] # cc) and (tl[iL[1]]=tr[iL[1]]) then tL[iL[1]]:0,
tL[iL[2]] : 0,
c1show(tL)
)
), /* end of for iL */
c1show(progn,tL),c1show(progn,uL),
return([tL,uL])
), /* end of addjoin() */
/***main part of on3D2G *****************************************************/
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
if args[1]='test then go(block_test),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3D2G('help)--
機能: on3D2G : 矩形領域 D(x,y) 変換 t=x+y, u=y のとき G(t,u) を求める
文法: on3D2G(on3(x,xl,xr,xlr)*on3(y,yl,yr,ylr),'typeA|'typeB|'typeE)
or on3D2G([on3,x,xl,xr,xlr],[on3,y,yl,yr,ylr],'typeA|'typeB|'typeE)
on3D2G('ex|'test)
例示: on3D2G([on3,x,xl,xr,cc],[on3,y,yl,yr,oc],'typeA)
-> on3(t,tl,tr,tlr)*on3(u,ul,ur,ulr) + ...
--end of on3D2G('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
block([progn:"<on3D2G('ex)>",debug,x,xl,xr,y,yl,yr,ex,out],
ex : on3(x,xl,xr,co)*on3(y,yl,yr,cc),
c0show(on3D2G(ex)),
c0show(on3D2G(ex,'typeA)),
c0show(on3D2G(ex,'typeB)),
c0show(on3D2G(ex,'typeE)),
ex : on3(x, xl, xr, cc) * on3(y, yl, inf, co),
c0show(on3D2G(ex)),
return("--end of on3D2g('ex)--")
),
return('normal_return),
block_test, /* test ブロック ===================================*/
block([progn:"<on3D2G('test)>",debug],
on3D2G_ex('test),
return("--end of on3D2G('test)--")
),
return("on3D2G('test) is normal_return"),
block_main, /* main ブロック ====================================*/
if listp(args[1]) # true then (
ex : ev(args[1]),
exL : f2l(ex),
c1show(progn,ex), c1show(exL),
xL : exL[3], yL : exL[4],
c1show(progn,xL,yL)
),
if (length(args)>=2) and listp(args[1]) and listp(args[2]) then (
/* [on3,x,xl,xr,xlr], [on3,y,yl,yr,ylr] */
if listp(args[1]) then xL : args[1] else xL : f2l(args[1]),
if listp(args[2]) then yL : args[2] else yL : f2l(args[2])
),
xl : xL[3], xr : xL[4], xlr : xL[5], xrng : plus(xr,-xl),
yl : yL[3], yr : yL[4], ylr : yL[5], yrng : plus(yr,-yl),
c0show("-- D:xl<x<xr, yl<y<yr --(t=x+y,u=y)--> G:G(t,u) --"),
c0show("◇ ",ex),
/* 自己判定 */
type:"by Case",
if is(xrng > yrng) then type:"A"
else if is(xrng < yrng) then type:"B"
else if is(xrng = yrng) then type:"E",
c1show("自己判定結果 ",type),
/* 自己判定結果が "by Case" の場合, 引数指定に基づく仮定を適用する */
if type="by Case" then (
if member('typeA,args) then (
c0show("判定結果: by Case -> type A (xrng > yrng) を仮定する"),
type:"A", assume(xrng > yrng)
),
if member('typeB,args) then (
c0show("判定結果: by Case -> type B (xrng < yrng) を仮定する"),
type:"B", assume(xrng < yrng)
),
if member('typeE,args) then (
c0show("判定結果: by Case -> type E (xrng = yrng) を仮定する"),
type:"E", assume(equal(xrng , yrng))
)
),
c0show(xL,yL),c0show(xrng,yrng,type,facts(yr)),
if type="by Case" then (
G(t,u) := if xrng <= yrng then
'on3(t,yl+xl,yr+xl,cc)*on3(u,yl,t-xl,cc)
+ 'on3(t,yr+xl,yl+xr,oc)*on3(u,yl,yr,cc)
+ 'on3(t,yl+xr,yr+xr,oc)*on3(u,t-xr,yr,cc)
else
'on3(t,yl+xl,yl+xr,cc)*on3(u,yl,t-xl,cc)
+ 'on3(t,yl+xr,yr+xl,oc)*on3(u,t-xr,t-xl,cc)
+ 'on3(t,yr+xl,yr+xr,oc)*on3(u,t-xr,yr,cc),
c0show(G(t,u)),
return(G(t,u))
),
if member(xlr,[cc,co]) then x_l:"c" else x_l:"o",
if member(xlr,[cc,oc]) then x_r:"c" else x_r:"o",
if member(ylr,[cc,co]) then y_l:"c" else y_l:"o",
if member(ylr,[cc,oc]) then y_r:"c" else y_r:"o",
c0show(x_l,x_r,y_l,y_r),
/* D(x,y) := on3(x,xl,xr,xlr)*on3(y,yl,yr,ylr), */
/* t = x+y, u = y */
/*=== type A (xrng > yrng) ===========================================
Ga[1] = 'on3(t,yl+xl,yr+xl,cc)*on3(u,yl,t-xl,cc)
Ga[2] = 'on3(t,yr+xl,yl+xr,oc)*on3(u,yl,yr,cc)
Ga[3] = 'on3(t,yl+xr,yr+xr,oc)*on3(u,t-xr,yr,cc)
=== type B (xrng < yrng) ============================================
Gb[1] = 'on3(t,yl+xl,yl+xr,cc)*on3(u,yl,t-xl,cc)
Gb[2] = 'on3(t,yl+xr,yr+xl,oc)*on3(u,t-xr,t-xl,cc)
Gb[3] = 'on3(t,yr+xl,yr+xr,oc)*on3(u,t-xr,yr,cc)
=== type E (xrng = yrng) ============================================
Ge[1] = 'on3(t,yl+xl,yr+xl,cc)*on3(u,yl,t-xl,cc) <- yr+xl=yl+xr
Ge[2] = 'on3(t,yr+xl,yl+xr,oc)*on3(u,ul*,ur*,cc)=0 <- yl+xr=yr+xl
Ge[3] = 'on3(t,yl+xr,yr+xr,oc)*on3(u,t-xr,yr,cc) <- yl+xr=yr+xl
type E は type A type B において第2項が0になり第1項,第3項が一致する
=====================================================================
上記3項における t, u の開閉は, xl,xr,yl,yrがすべてc(閉)の場合を示す.
変数tの開閉は cc,oc,oc 以外に co,co,cc が許される.
以下に t,u の具体的な開閉の定義規則を与える
on3(x,xl,xr,xlr)*on3(y,yl,yr,ylr)
xlr -> x_l, x_r, ylr -> y_l, y_r : "c" or "o"
on3(t,tl[i],tr[i],tlr[i])*on3(u,ul[i],ur[i],ulr[i])
=======================================================================*/
/*### iflr##############################################################*/
iflr(x_lr,y_lr,tu_lr) := block([progn:"<iflr>",debug,out],
out : if (x_lr="c") and (y_lr="c") and (tu_lr="o") then "c" else "o",
return(out)
), /* end of iflr() */
tl:[0,0,0], tr:[0,0,0], tlr:[0,0,0], t_l:["x","x","x"], t_r:["x","x","x"],
ul:[0,0,0], ur:[0,0,0], ulr:[0,0,0], u_l:["x","x","x"], u_r:["x","x","x"],
tl[1] : plus(xl,yl),
t_l[1] : iflr(x_l,y_l,"o"),
tr[1] : if type # "B" then plus(xl,yr) else plus(xr,yl),
t_r[1] : if type # "B" then iflr(x_l,y_r,"o") else iflr(x_r,y_l,"o"),
tlr[1] : eval_string(sconcat(t_l[1],t_r[1])),
tl[2] : if type # "B" then plus(xl,yr) else plus(xr,yl),
t_l[2] : if type # "B" then iflr(x_l,y_r,t_r[1]) else iflr(x_r,y_l,t_r[1]),
tr[2] : if type # "B" then plus(xr,yl) else plus(xl,yr),
t_r[2] : if type # "B" then iflr(x_r,y_l,"o") else iflr(x_l,y_r,"o"),
tlr[2] : eval_string(sconcat(t_l[2],t_r[2])),
tl[3] : if type # "B" then plus(xr,yl) else plus(xl,yr),
t_l[3] : if type # "B" then iflr(x_r,y_l,t_r[2]) else iflr(x_l,y_r,t_r[2]),
tr[3] : plus(xr,yr),
t_r[3] : iflr(x_r,y_r,"o"),
tlr[3] : eval_string(sconcat(t_l[3],t_r[3])),
ul[1] : yl,
u_l[1] : y_l,
ur[1] : plus(t,-xl),
u_r[1] : x_l,
ulr[1] : eval_string(sconcat(u_l[1],u_r[1])),
ul[2] : if type # "B" then yl else plus(t,-xr),
u_l[2] : if type # "B" then y_l else x_r,
ur[2] : if type # "B" then yr else plus(t,-xl),
u_r[2] : if type # "B" then y_r else x_l,
ulr[2] : eval_string(sconcat(u_l[2],u_r[2])),
ul[3] : plus(t,-xr),
u_l[3] : x_r,
ur[3] : yr,
u_r[3] : y_r,
ulr[3] : eval_string(sconcat(u_l[3],u_r[3])),
c0show("before join & reduce ->"),
c0show(tl,tr,tlr),
c0show(ul,ur,ulr),
if type="E" then
G(t,u) := funmake(on3,[t,tl[1],tr[1],tlr[1]])*funmake(on3,[u,ul[1],ur[1],ulr[1]])
+ funmake(on3,[t,tl[3],tr[3],tlr[3]])*funmake(on3,[u,ul[3],ur[3],ulr[3]])
else
G(t,u) := funmake(on3,[t,tl[1],tr[1],tlr[1]])*funmake(on3,[u,ul[1],ur[1],ulr[1]])
+ funmake(on3,[t,tl[2],tr[2],tlr[2]])*funmake(on3,[u,ul[2],ur[2],ulr[2]])
+ funmake(on3,[t,tl[3],tr[3],tlr[3]])*funmake(on3,[u,ul[3],ur[3],ulr[3]]),
c1show(G(t,u)),
/* xl,xr,yl,yr が minf, inf の場合を含めて"和"を定める.(minf+infは未処理とする) */
/* 項の結合 join : on3(t,t1l,t1r,tllr)*same + on3(t,t2l,t2r,t2lr)*same
- when t1r=t2l -> on3(t,t1l,t2r,t12lr)*same */
[tL, uL] : addjoin(tl,tr,tlr, ul,ur,ulr), /* addjpin の呼び出し */
c0show("after join & reduce ->"),c0show(tL), c0show(uL),
/*### output by chkshow ##################################*/
out : tL[1]*uL[1]+tL[2]*uL[2]+tL[3]*uL[3],
forget([xrng > yrng, xrng < yrng, xrng = yrng]),
return(out)
)$ /* end of on3D2G */
/*######################################################################*/
/* <on3factor>: on3poly の関数部を因数分解した表現を返す */
/*######################################################################*/
on3factor([args]) := block([progn:"<on3factor>",debug,exp, L:[],
sum,ton3,func,funcL:[],
on3type,on3none,on3monoone,on3mono,on3inv,on3poly,on3polyinv,on3unknown],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3factor('help)--
機能: on3poly の関数部を因数分解した表現を返す
文法: on3factor(exp,...)
例示: ex = x*on3(x,3,4,co)+(x^2-2*x+1)*on3(x,1,2,co)$
on3factor(ex);
-> x*on3(x,3,4,co)+(x-1)^2*on3(x,1,2,co)
--end of on3factor('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3factor('ex)--"),
/* on3factor_ex(), */
block([progn:"<on3factor('ex)>",debug,ex],
debug:ifargd(),
ex : (x^2-2*x+1)*on3(x,1,2,co)+ x*on3(x,3,4,co),
print("---ex---"),
ldisplay(ex),
cshow(on3factor(ex)),
return("--- end of on3factor('ex) ---")
), /* end of block */
print("--end of on3factor('ex)--"),
return("--end of on3factor('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
exp : on3std(exp),
if listp(exp) then L : copylist(L)
else L : f2l(exp),
on3type:on3typep(L), /* call on3typep */
d1show(on3type),
/*** on3poly 出ない場合は無処理とする ***/
if on3type # on3poly then return(exp),
sum : 0,
for i:2 thru length(L) do ( /* 関数部とon3部を分離する */
ton3:1,
funcL : scanmap(lambda([u], if listp(u) and u[1]=on3 then
(ton3:ton3*l2f(u), u:1) else u ), L[i]),
func : factor(l2f(funcL)), /* 関数部の因数分解 */
d2show(func,ton3),
sum : sum + func*l2f(ton3)
), /* end of for-i */
d1show(sum),
return(sum)
)$ /* end of on3factor() */
/*### --- fsplit: on3dim2_uni2.mx --- ##################################*/
/* <on3dim2_uni2> : 一様分布の和の分布 2019.06.21 */
/*######################################################################*/
on3dim2_uni2([args]) := block([progn:"<on3dim2_uni2>",debug,out,cmds,ans,
plotmode:true,viewmode:false,olddisplay2d,
x,y,t,u,f,g,h, xmean,xvar,xsd,nord, gh,gf,ga,dlist,glist,L],
debug:ifargd(),
if member(noplot,args) then (
plotmode:false, print("---Run with NoPlot Mode---") ),
if member(view,args) then (
viewmode:true, print("---Run with View Mode---") ),
if member(noview,args) then (
viewmode:false, print("---Run with NoView Mode---") ),
printf(true," 一様分布 U[0,1]に従う独立確率変数の和の分布(密度関数)を求める~%"),
olddisplay2d:display2d, display2d:true,
local(f,g,h,gh,gf,nord),
/*** 1個の和の分布 ********************************************/
print("◆ 1個の和の分布"),
f[1](t) := 1*on3(t,0,1,cc),
mshow(f[1](t)),
cmds : sconcat("( ",
"f[1](t)",
" )"),
ans : on3(t,0,1,cc),
chk1show(cmds,ans),
on3show(f[1](t)),
/*** 2個の和の分布 ********************************************/
print("◆ 2個の和の分布"),
g[2](x,y) := f[1](x)*f[1](y),
mshow(g[2](x,y)),
/* cshow("n=2",values),cshow(findstr(h)),*/
/* remarray(h), */
h[2](t,u) := on3chgv(g[2](x,y)), /* 同時分布 */
cshow(h[2](t,u)),
out : on3integ19(h[2](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
out : out_outf, killvars(["out_"]),
define(f[2](t), out),
cmds : sconcat("( ",
"f[2](t)",
" )"),
ans : t*on3(t,0,1,co) - (t-2)*on3(t,1,2,co),
chk1show(cmds,ans),
display2d:true, on3show(f[2](t)), display2d:false,
/*** 3個の和の分布 *********************************************/
print("◆ 3個の和の分布"),
g[3](x,y) := f[2](x)*f[1](y),
mshow(g[3](x,y)),
h[3](t,u) := on3chgv(g[3](x,y)), /* 同時分布 */
mshow(h[3](t,u)),
out : on3integ19(h[3](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
out : out_outf, killvars(["out_"]),
define(f[3](t), out),
cmds : sconcat("( ",
"f[3](t)",
" )"),
ans : t^2/2*on3(t,0,1,co) - (2*t^2-6*t+3)/2*on3(t,1,2,co)
+ (t-3)^2/2*on3(t,2,3,co),
display2d:false, chk1show(cmds,ans),
display2d:true, on3show(f[3](t)), display2d:false,
/*** 4個の和の分布 *********************************************/
print("◆ 4個の和の分布"),
g[4](x,y) := f[2](x)*f[2](y),
mshow(g[4](x,y)),
h[4](t,u) := on3chgv(g[4](x,y)), /* 同時分布 */
mshow(h[4](t,u)),
out : on3integ19(h[4](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
out : out_outf, killvars(["out_"]),
define(f[4](t), out),
cmds : sconcat("( ",
"f[4](t)",
" )"),
ans : t^3/6*on3(t,0,1,co) - (3*t^3-12*t^2+12*t-4)/6*on3(t,1,2,co)
+ (3*t^3-24*t^2+60*t-44)/6*on3(t,2,3,co)
- (t-4)^3/6*on3(t,3,4,co),
chk1show(cmds,ans),
display2d:true, on3show(f[4](t)), display2d:false,
if false then (out : on3integ(f[4](t),t,minf,inf), mshow(out)),
/*** 5個の和の分布 *********************************************/
print("◆ 5個の和の分布"),
g[5](x,y) := f[3](x)*f[2](y),
mshow(g[5](x,y)),
h[5](t,u) := on3chgv(g[5](x,y),debug0), /* 同時分布 */
mshow(h[5](t,u)),
out : on3integ19(h[5](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
c1show(progn,out_outf),
out : out_outf, killvars(["out_"]),
c1show(progn,out),
define(f[5](t), out),
cmds : sconcat("( ",
"f[5](t)",
" )"),
ans : t^4/24*on3(t,0,1,co)
- (4*t^4-20*t^3++30*t^2-20*t+5)/24*on3(t,1,2,co)
+ (6*t^4-60*t^3+210*t^2-300*t+155)/24*on3(t,2,3,co)
- (4*t^4-60*t^3+330*t^2-780*t+655)/24*on3(t,3,4,co)
+ (t-5)^4/24*on3(t,4,5,co),
chk1show(cmds,ans),
display2d:true, on3show(f[5](t)), display2d:false,
/*** 結果の作図 ***/
if plotmode then (
gh[1] : gr2d(title="h(t) = f[1](t), t=x_1",
grid=true, yrange=[-0.5, 1.5], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[1](t), t,-1, 2), ylabel="Dens."),
gh[2] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[2](t,u), t = x_1, u = x_2",
xlabel="t", ylabel="u", zlabel="h[2](t,u)",
explicit(h[2](t,u), t,-1,3, u,-1,3)
),
gh[3] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[3](t,u), t = x_1 + x_2, u = x_3",
xlabel="t", ylabel="u", zlabel="h[3](t,u)",
explicit(h[3](t,u), t,-1,3, u,-1,3)
),
gh[4] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[4](t,u), t = x_1 + x_2, u = x_3 + x_4",
xlabel="t", ylabel="u", zlabel="h[4](t,u)",
explicit(h[4](t,u), t,-1,4, u,-1,4)
),
gh[5] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[5](t,u), t = x_1 + x_2 + x_3, u = x_4 + x_5",
xlabel="t", ylabel="u", zlabel="h[5](t,u)",
explicit(h[5](t,u), t,-1,5, u,-1,5)
),
gf[1] : gr2d(title="f[1](t)",
grid=true, yrange=[-0.5, 1.5], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[1](t), t,-1, 2), ylabel="Dens."),
gf[2] : gr2d(title="f[2](t)",
grid=true, yrange=[-0.5, 1.5], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[2](t), t,-1, 3), ylabel="Dens."),
gf[3] : gr2d(title="f[3](t)",
grid=true, yrange=[-0.2, 1.2], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[3](t), t,-0.5, 3.5), ylabel="Dens."),
gf[4] : gr2d(title="f[4](t)",
grid=true, yrange=[-0.2, 1.0], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[4](t), t,0, 4), ylabel="Dens."),
gf[5] : gr2d(title="f[5](t)",
grid=true, yrange=[-0.1, 0.9], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[5](t), t, 0.5, 4.5), ylabel="Dens."),
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3dim2_uni2-sum"),
columns=2, dimensions=[1000,1500]],
glist : [gh[1],gf[1], gh[2],gf[2], gh[3],gf[3], gh[4],gf[4], gh[5],gf[5]],
if viewmode then mk_draw(glist,dlist,'view)
else mk_draw(glist,dlist,'noview),
/* 和の分布から平均の分布(確率密度関数)への変換 */
kill(x),
/* gav[1](x) := ratsubst(x,t,f[1](t)), */
for i:1 thru 5 do
gav[i](x) := ratsubst(i*x,t, f[i](t)) * i,
/* 一様分布U[0,1]の平均xmean=1/2,分散xvar=1/12 から
算術平均 AV=(X_1 + ,,, + x_n)/n の平均E(AV)=xmean, 分散V(AV)=xvar/n を求め,
正規分布N(E(AV),V(AV)) の確率密度関数 nord[n](x) を作成する. */
xmean : 1/2, xvar : 1/12,
for i:1 thru 5 do (
xsd : sqrt(xvar/i),
define(nord[i](x), 1/(sqrt(2*%pi)*xsd) * %e^(-((x-xmean)/xsd)^2/2)),
c1show(nord[i](x))
),
/* av[n](x) の確率密度関数 gav[n](x) と
正規分布N(E(AV),V(AV)) の確率密度関数 nord[n](x)の gr2dオブジェクト ga[n] */
for i:1 thru 5 do (
L : [title=sconcat("av[",i,"](x)"),
grid=true, yrange=[-0.1, 3.5], line_width=1.5, ylabel="Dens.",
color=red, key=sconcat("av(",i,")"), line_type=solid,
explicit(gav[i](x), x, -0.1, 1.1),
color=blue, key="Nor. Dens.", line_type=dots,
explicit(nord[i](x), x, -0.1, 1.1)],
ga[i] : funmake(gr2d, L)
),
glist : [gf[1],ga[1], gf[2],ga[2], gf[3],ga[3], gf[4],ga[4], gf[5],ga[5]],
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3dim2_uni2-av"),
columns=2, dimensions=[1000,1500]],
if viewmode then mk_draw(glist,dlist,'view)
else mk_draw(glist,dlist,'noview)
), /* end of plotmode */
/*** example end *********************************************/
remarray(f,g,h, gh,gf,ga,nord),
kill(f,g,h, gh,gf,ga,nord),
display2d:olddisplay2d,
return("---end of on3dim2_uni2 ---")
)$
/*### --- fsplit: on3dim2_exp2.mx --- ##################################*/
/* <on3dim2_exp2> : 指数分布の和の分布 2019.06.21 */
/*######################################################################*/
on3dim2_exp2([args]) := block([progn:"<on3dim2_exp2>",debug,out,ans,
plotmode:true,viewmode:false,olddisplay2d,
x,y,t,u,f,g,h, xmean,xvar,xsd,nord, gh,gf,ga,dlist,glist,L],
debug:ifargd(),
if member(noplot,args) then (
plotmode:false, print("---Run with NoPlot Mode---") ),
if member(view,args) then (
viewmode:true, print("---Run with View Mode---") ),
if member(noview,args) then (
viewmode:false, print("---Run with NoView Mode---") ),
printf(true," 指数分布 Ex(1)に従う独立確率変数の和の分布(密度関数)を求める~%"),
olddisplay2d:display2d, display2d:true,
local(f,g,h,gh,nord,gf),
/*** 1個の和の分布 ********************************************/
print("◆ 1個の和の分布"),
f[1](t) := %e^(-t)*on3(t,0,inf,co),
mshow(f[1](t)),
cmds : sconcat("( ",
"f[1](t)",
" )"),
ans : %e^(-t)*on3(t,0,inf,co),
chk1show(cmds,ans),
on3show(f[1](t)),
/*** 2個の和の分布 ********************************************/
print("◆ 2個の和の分布"),
g[2](x,y) := f[1](x)*f[1](y),
mshow(g[2](x,y)),
/* cshow("n=2",values),cshow(findstr(h)),*/
/* remarray(h), */
h[2](t,u) := on3chgv(g[2](x,y)), /* 同時分布 */
mshow(h[2](t,u)),
out : on3integ19(h[2](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
c1show(progn,out_outf),
out : out_outf, killvars(["out_"]),
c1show(progn,out),
define(f[2](t), out),
cmds : sconcat("( ",
"f[2](t)",
" )"),
ans : t*%e^(-t)*on3(t,0,inf,co),
chk1show(cmds,ans),
display2d:true, on3show(f[2](t)), display2d:false,
/*** 3個の和の分布 *********************************************/
print("◆ 3個の和の分布"),
g[3](x,y) := f[2](x)*f[1](y),
mshow(g[3](x,y)),
h[3](t,u) := on3chgv(g[3](x,y)), /* 同時分布 */
mshow(h[3](t,u)),
out : on3integ19(h[3](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
c1show(progn,out_outf),
out : out_outf, killvars(["out_"]),
c1show(progn,out),
define(f[3](t), out),
cmds : sconcat("( ",
"f[3](t)",
" )"),
ans : t^2/2*%e^(-t)*on3(t,0,inf,co),
display2d:false, chk1show(cmds,ans),
display2d:true, on3show(f[3](t)), display2d:false,
if false then (out : on3integ(f[3](t),t,minf,inf), mshow(out)),
/*** 4個の和の分布 *********************************************/
print("◆ 4個の和の分布"),
g[4](x,y) := f[2](x)*f[2](y),
mshow(g[4](x,y)),
h[4](t,u) := on3chgv(g[4](x,y)), /* 同時分布 */
mshow(h[4](t,u)),
out : on3integ19(h[4](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
c1show(progn,out_outf),
out : out_outf, killvars(["out_"]),
c1show(progn,out),
define(f[4](t), out),
cmds : sconcat("( ",
"f[4](t)",
" )"),
ans : t^3/3!*%e^(-t)*on3(t,0,inf,co),
chk1show(cmds,ans),
display2d:true, on3show(f[4](t)), display2d:false,
if false then (out : on3integ(f[4](t),t,minf,inf), mshow(out)),
/*** 5個の和の分布 *********************************************/
print("◆ 5個の和の分布"),
g[5](x,y) := f[3](x)*f[2](y),
h[5](t,u) := on3chgv(g[5](x,y)), /* 同時分布 */
mshow(h[5](t,u)),
if false then mshow(h[5](t,u)),
out : on3integ19(h[5](t,u),u,minf,inf), /* 周辺分布 */
outLev(on3info(out,t,'factor),"out_"),
c1show(progn,out_outf),
out : out_outf, killvars(["out_"]),
c1show(progn,out),
define(f[5](t), out),
cmds : sconcat("( ",
"f[5](t)",
" )"),
ans : t^4/4!*%e^(-t)*on3(t,0,inf,co),
chk1show(cmds,ans),
display2d:true, on3show(f[5](t)), display2d:false,
/*** 結果の作図 ***/
if plotmode then (
gh[1] : gr2d(title="h(t) = f[1](t), t=x_1",
grid=true, yrange=[-0.1, 1.1], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[1](t), t,-1, 6), ylabel="Dens."),
gh[2] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[2](t,u), t = x_1, u = x_2",
xlabel="t", ylabel="u", zlabel="h[2](t,u)",
explicit(h[2](t,u), t,-1,6, u,-1,6)
),
gh[3] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[3](t,u), t = x_1 + x_2, u = x_3",
xlabel="t", ylabel="u", zlabel="h[3](t,u)",
explicit(h[3](t,u), t,-1,8, u,-1,8)
),
gh[4] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[4](t,u), t = x_1 + x_2, u = x_3 + x_4",
xlabel="t", ylabel="u", zlabel="h[4](t,u)",
explicit(h[4](t,u), t,-1,10, u,-1,10)
),
gh[5] : gr3d(enhanced3d=true, surface_hide=true, nticks=5, xu_grid=40,
title="h[5](t,u), t = x_1 + x_2 + x_3, u = x_4 + x_5",
xlabel="t", ylabel="u", zlabel="h[5](t,u)",
explicit(h[5](t,u), t,-1,12, u,-1,12)
),
gf[1] : gr2d(title="f[1](t)",
grid=true, yrange=[-0.1, 1.1], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[1](t), t,-1, 6), ylabel="Dens."),
gf[2] : gr2d(title="f[2](t)",
grid=true, yrange=[-0.1, 0.5], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[2](t), t,-1, 6), ylabel="Dens."),
gf[3] : gr2d(title="f[3](t)",
grid=true, yrange=[-0.1, 0.4], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[3](t), t,-1,8), ylabel="Dens."),
gf[4] : gr2d(title="f[4](t)",
grid=true, yrange=[-0.05, 0.3], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[4](t), t,-1, 10), ylabel="Dens."),
gf[5] : gr2d(title="f[5](t)",
grid=true, yrange=[-0.05, 0.25], line_width=1.5,
color=blue, key="", line_type=solid,
explicit(f[5](t), t, -1, 12), ylabel="Dens."),
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3dim2_exp2-sum"),
columns=2, dimensions=[1000,1500]],
glist : [gh[1],gf[1], gh[2],gf[2], gh[3],gf[3], gh[4],gf[4], gh[5],gf[5]],
if viewmode then mk_draw(glist,dlist,'view)
else mk_draw(glist,dlist,'noview),
/* 和の分布から平均の分布(確率密度関数)への変換 */
kill(x),
gav[1](x) := ratsubst(x,t,f[1](t)),
for i:2 thru 5 do
gav[i](x) := ratsubst(i*x,t, f[i](t)) * i,
/* 指数分布Ex(1)の平均xmean=1,分散xvar=1 から
算術平均 AV=(X_1 + ,,, + x_n)/n の平均E(AV)=xmean, 分散V(AV)=xvar/n を求め,
正規分布N(E(AV),V(AV)) の確率密度関数 nord[n](x) を作成する. */
xmean : 1, xvar : 1,
for i:1 thru 5 do (
xsd : sqrt(xvar/i),
define(nord[i](x), 1/(sqrt(2*%pi)*xsd) * %e^(-((x-xmean)/xsd)^2/2)),
c1show(nord[i](x))
),
/* av[n](x) の確率密度関数 gav[n](x) と
正規分布N(E(AV),V(AV)) の確率密度関数 nord[n](x)の gr2dオブジェクト ga[n] */
for i:1 thru 5 do (
L : [title=sconcat("av[",i,"](x)"),
grid=true, yrange=[-0.1, 1.1], line_width=1.5, ylabel="Dens.",
color=red, key=sconcat("av(",i,")"), line_type=solid,
explicit(gav[i](x), x, -1, 6),
color=blue, key="Nor. Dens.", line_type=dots,
explicit(nord[i](x), x, -1, 6)],
ga[i] : funmake(gr2d, L)
),
glist : [gf[1],ga[1], gf[2],ga[2], gf[3],ga[3], gf[4],ga[4], gf[5],ga[5]],
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3dim2_exp2-av"),
columns=2, dimensions=[1000,1500]],
if viewmode then mk_draw(glist,dlist,'view)
else mk_draw(glist,dlist,'noview)
), /* end of plotmode */
/*** example end *********************************************/
remarray(f,g,h, gh,gf,ga,nord),
kill(f,g,h, gh,gf,ga,nord),
display2d:olddisplay2d,
return("---end of on3dim2_exp2 ---")
)$
/*--- fsplit: on3debug.mx ----------------------------------------------*/
/*######################################################################*/
/* <cashow>: 表示関数 (無修飾) */
/*######################################################################*/
cashow([lis])::=block([i,u,ans:[],n:length(lis),sp],
/* ans:append(ans,["Check in",progn,":"]), */
sp:"->",
ans:append(ans,[" "]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"->",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [""] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <c0show>: 表示関数 (無修飾) */
/*######################################################################*/
c0show([lis])::=block([i,u,ans:[],n:length(lis)],
/* ans:append(ans,["Check in",progn,":"]), */
ans:append(ans,[" "]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [""] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <cshow>: 表示関数 */
/*######################################################################*/
cshow([lis])::=block([i,u,ans:[],n:length(lis)],
/* ans:append(ans,["Check in",progn,":"]), */
ans:append(ans,["CS:"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <c1show>: チェック用表示関数(debug >= 1 のときに表示する) */
/*######################################################################*/
c1show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 1 then return(),
ans:append(ans,["C1:"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <c2show>: チェック用表示関数(debug >= 2 のときに表示する) */
/*######################################################################*/
c2show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 2 then return(),
ans:append(ans,["C2:"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <c3show>: チェック用表示関数(debug >= 3 のときに表示する) */
/*######################################################################*/
c3show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 3 then return(),
ans:append(ans,["C3:"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <d1show>: デバック用表示関数(debug >= 1 のときに表示する) */
/*######################################################################*/
d1show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 1 then return(),
ans:append(ans,["D1 in",progn,":"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <d2show>: デバック用表示関数(debug >= 2 のときに表示する) */
/*######################################################################*/
d2show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 2 then return(),
ans:append(ans,["D2 in",progn,":"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <d3show>: デバック用表示関数(debug >= 3 のときに表示する) */
/*######################################################################*/
d3show([lis])::=block([i,u,ans:[],n:length(lis)],
if debug < 3 then return(),
ans:append(ans,["D3 in",progn,":"]),
for i thru n do
(if stringp(lis[i]) then
ans:append(ans,buildq([u:lis[i]],['u]))
else ans:append(ans,buildq([u:lis[i]],['u,"=",u])),
if i < n and stringp(lis[i])=false then ans:append(ans, [","] )),
buildq([u:ans],print(splice(u))))$
/*######################################################################*/
/* <ifargd>: 親関数引数にdebug1,debug2,debug3があれば debug:1,2,3 を返す */
/*######################################################################*/
ifargd() ::= block([],
/* debug --- 0:none, 1:simple, 2:mid. , 3: detail */
/* print("args=",args), */
if member(debug1,args) then debug:1
else if member(debug2,args) then debug:2
else if member(debug3,args) then debug:3
else debug:0,
return(debug))$
/*------ debug_ex ----------------------------------------------------*/
debug_ex(x,[args]) := block([progn:"<debug_ex>",debug],
debug:ifargd(),
cshow(debug),
/* 本関数の呼び出し時に引数 debug1,2,3 があれば debug:1,2,3 が本関数内で設定される */
/* debug_ex(a,debug1) なら d1show() が反応し， debug_ex(a) なら反応しない */
d1show("d1show",x), d2show("d2show",x), d3show("d3show",x),
cshow(x),
debug_sub(x,debug1),
d1show("d1show-again",x),
return("--- end of debug_ex ---")
)$
debug_sub(y,[args]) := block([progn:"<debug_sub>",debug],
debug:ifargd(), cshow(debug),
d1show("d1show",y+1), d2show("d2show",y+1), d3show("d3show",y+1),
return(y+1)
)$
/***************************
debug; out1 : (x+y)^3$ cshow("--aaa--",out1)$
debug_ex(a,debug1); debug_ex(a,debug2); debug_ex(a,debug3);
debug_ex(a);
****************************/
/*--- fsplit: on3etc.mx -----------------------------------------------*/
/*######################################################################*/
/* <on3iftrue>: 式にon3関数が含まれていればTRUEを返す
on3iftrue(f0+f1*on3(x,1,2,co))---> true, on3iftrue(f0+f1)--->false */
/*######################################################################*/
on3iftrue([args]) := block([progn:"<on3iftrue>",debug,exp, out:false],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3iftrue('help)--
機能: 式にon3関数が含まれていればTRUEを返す
文法: on3itrue(exp,...)
例示: ex : f1*on3(x,1,2,co)+f0$ on3ftrue(ex) -> true
ex : f1+f0$ on3ftrue(ex) -> false
--end of on3iftrue('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3iftrue('ex)--"),
/* on3factor_ex(), */
block([progn:"<on3ftrue_ex>",ex1,ex2,ex],
ex1 : f0+f1*on3(x,1,2,co),
ex2 : f0+f1,
c0show("on3関数の有無の検査"),
for ex in [ex1,ex2] do ( c0show(ex,",", on3ftrue(ex)) ),
return("--- end of on3ftrue('ex) ---")
), /* end of block */
print("--end of on3iftrue('ex)--"),
return("--end of on3iftrue('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
scanmap(lambda([u], if atom(u)=false and op(u)=on3
then return(out:true) else u), exp),
return(out)
)$
/*######################################################################*/
/* <lpup>: リストの指定要素を取り出す
L:[+,[*,f1,[on3,x,3,4,co]],[on3,x,1,2,co]], lpup(L,[2,2]) ---> f1 */
/*######################################################################*/
lpup([args]) := block([progn:"<lpup>",debug,lname,ind0, wind0,wind,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of lpup('help)--
機能: リストの指定要素を取り出す
文法: lpup(list,ind,...)
例示: L:[+,[*,f1,[on3,x,3,4,co]],[on3,x,1,2,co]], lpup(L,[2,2]) ---> f1
--end of lpup('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of lpup('ex)--"),
/* on3factor_ex(), */
block([progn:"<lpup_ex>",L1],
L1 : ["+",["*",f1,[on3,x,3,4,co]],[on3,x,1,2,co]],
show(L1),
show(lpup(L1,2)),
show(lpup(L1,[2,2])),
return("--- end of lpup ---")
), /* end of block */
print("--end of lpup('ex)--"),
return("--end of lpup('ex)--"),
block_main, /* main ブロック ====================================*/
lname : args[1], ind0 : args[2],
wind0:ev(ind0), d2show(wind0),
if listp(wind0) then wind : copylist(wind0) else wind:[wind0],
d2show(wind),
out:"", out:sconcat(out,lname),
for i thru length(wind) do out:sconcat(out,"[",wind[i],"]"),
d1show(string(out)),
eval_string(out)
)$
/*######################################################################*/
/* <loffuncs>: 式に含まれる演算子(関数を含む)からなるリストを返す */
/*######################################################################*/
loffuncs([args]) := block([progn:"<loffuncs>",debug,exp, out:[]],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of loffuncs('help)--
機能: 式に含まれる演算子(関数を含む)からなるリストを返す
文法: loffuncs(exp,...)
例示: ex : f1*on3(x,3,4,co)+on3(x,1,2,co)$ loffuncs(ex) -> [\"*\",\"+\",on3]
---> c.f. listofvars(ex2) = [x,f1]
--end of loffuncs('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of loffuncs('ex)--"),
/* ???_ex(), */
block([progn:"<loffuncs_ex>", ex1, ex2, ex],
print("---begin of loffuncs_ex---"),
ex1 : 1/(f1+f2+f3) + f4,
ex2 : on3(x,1,2,co) + f1*on3(x,3,4,co),
for ex in [ex1,ex2] do (
cshow(ex), cshow(loffuncs(ex)),
cshow("---> c.f.", listofvars(ex))
),
return("--- end of loffuncs_ex---")
), /* end of block */
print("--end of loffuncs('ex)--"),
return("--end of loffuncs('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
d2show(exp),
scanmap(lambda([u], if atom(u)=false
then (out:cons(op(u),out), retuen(u)) else u), exp),
out:unique(out),
d2show(out),
return(out)
)$ /* end of loffuncs() */
/*### --- fsplit: on3pw.mx --- ##########################################*/
/* on3 関数式のカプセル化 */
/*#######################################################################*/
on3ftrue([args]) := block([progn:"<ifon3>",debug,exp,out:false],
ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3ftrue('help)--
機能: 式にon3()が含まれるときTRUEを返す
文法: on3ftrue(exp,...)
例示: on3ftrue(f0+f1*on3(x,1,2,co)); -> true
on3ftrue(f0+f1*sin(x)); -> false
--end of on3ftrue('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3ftrue('ex)--"),
/* ???_ex(), */
block([progn:"<on3ftrue_ex>", ex1, ex2, ex],
print("---begin of on3ftrue_ex---"),
ex1 : f0+f1*on3(x,1,2,co),
ex2 : f0+f1*sin(x),
for ex in [ex1,ex2] do (
cshow(ex), cshow(on3ftrue(ex))
),
return("--- end of on3ftrue_ex---")
), /* end of block */
print("--end of on3ftrue('ex)--"),
return("--end of on3ftrue('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
d2show(exp),
scanmap(lambda([u], if atom(u)=false and op(u)=on3
then return(out:true) else u),
exp),
return(out)
)$ /* end of on3ftrue() */
/*######################### begin of on3pw main block #############################*/
if false then (
matchdeclare(pwf,on3ftrue,var,atom,k,integerp,var0,true,var1,true),
tellsimpafter('diff(on3pw(pwf),var,k), on3pwoff(on3diff(pwf,var,k))),
tellsimpafter('diff(on3pw(pwf),var), on3pwoff(on3diff(pwf,var,1))),
(
remove(integrate,outative),
matchdeclare(pwf,on3ftrue,var,atom),
tellsimpafter('integrate(on3pw(pwf),var), on3integ(pwf,var)),
declare(integrate,outative)
),
/************ 以下の定積分は現時点では機能しない
( remove(integrate,[outative,transfun]),
matchdeclare(pwf,on3ftrue,var,atom,var0,true,var1,true),
tellsimpafter(integrate(on3pw(pwf),var,var0,var1), on3integ(pwf,var,var0,var1)),
declare(integrate, outative),
delcare(integrate,transfun) ), *************************/
/*** カプセルを外して評価する ***/
defrule(on3pw_off_rule, on3pw(pwf), pwf),
on3pwoff(exp) := block([], apply1(exp,on3pw_off_rule))
)$
/*######################### end of on3pw main block #############################*/
/*#######################################################################*/
/*--- on3pw_ex ----------------------------------------------------------*/
/*#######################################################################*/
on3pw_ex() := block([x,f0,f1,f,df_direct,df,F_direct,F],
print("--- begin of on3pw_ex ---"),
print("◆ 準備:関数 F1(x),f0(x)の作成"),
cmds : sconcat("( @",
"f0(x) := sin(x), @",
"f1(x) := x^2*on3(x,minf,0,oo) + (1-x^2)/2 *on3(x,0,1,oo) @",
"+ (1-x)*on3(x,1,inf,oo), @",
"ldisplay(f0(x)), ldisplay(f1(x)) @",
" )"),
logshow(cmds),
print("◆ 使用例1:on3pw()を用いない場合"),
cmds : sconcat("( @",
"define(df_direct(x), on3diff(f1(x),x,1) + diff(f0(x),x,1)),@",
"ldisplay(df_direct(x)),@",
"ldisplay(df_direct(1)),@",
"define(F_direct(x), on3integ(f1(x),x) + integrate(f0(x),x)),@",
"ldisplay(F_direct(x)),@",
"mshow(F_direct(2) - F_direct(-1)) @",
"@ )"),
logshow(cmds),
print("◆ 使用例2:on3pw()を用いる場合"),
cmds : sconcat("( @",
"f(x) := on3pw(f1(x))+f0(x), /* on3関数f1(x)のカプセル化 */ @",
"define(df(x), diff(f(x),x)), /* 関数f(x)の微分関数 df(x)の定義 */ @",
"ldisplay(df(x)),@",
"ldisplay(df(1)),@",
"define(F(x), integrate(f(x),x)), /* 関数f(x)の不定積分 F(x)の定義 */ @",
"ldisplay(F(x)),@",
"mshow(F(2) - F(-1)) @",
" )"),
logshow(cmds),
print("◆ 使用例3:on3diff(),on3integ19()(2010年以降)を用いる場合"),
cmds : sconcat("( @",
"f(x) := f1(x)+f0(x), /* on3関数f1(x)のカプセル化 */ @",
"define(df(x), on3diff(f(x),x,1)), /* 関数f(x)の微分関数 df(x)の定義 */ @",
"ldisplay(df(x)),@",
"ldisplay(df(1)),@",
"define(F(x), on3integ19(f(x),x)), /* 関数f(x)の不定積分 F(x)の定義 */ @",
"ldisplay(F(x)),@",
"mshow(F(2) - F(-1)) @",
" )"),
logshow(cmds),
return("--- end of on3pw_ex ---")
)$
/*--- fsplit: on3test.mx -----------------------------------------------------*/
/*#######################################################################*/
/*--- on3test ----------------------------------------------------------------*/
/*#######################################################################*/
on3test([args]) := block([progn:"<on3test>",debug],
debug:ifargd(),
print("--- 1. on3simp('ex) ---------"), on3simp('ex),
print("--- 2. on3std_ex ----------"), on3std_ex(),
print("--- 3. on3decomp_ex -------"), on3decomp_ex(),
print("--- 4. on3ev_ex -----------"), on3ev_ex(),
print("--- 5. on3diff_ex ---------"), on3diff_ex(),
print("--- 6. on3integ_ex --------"), on3integ_ex(),
print("--- 7. on3solve_ex --------"), on3solve_ex(),
print("--- 8. on3dim2_uni2 -------"), on3dim2_uni2(noplot),
print("--- 9. on3dim2_exp2 -------"), on3dim2_exp2(noplot),
print("---10. on3pw_ex -----------"), on3pw_ex(),
return("--- end of on3test ---")
)$
/**********************************************************************************/
/* ### new parts ###2019.04.25 ###############################################*/
/*############################################################################*/
/*### on3edge : 関数内でtellsimpafterを設定し,他の関数内で規則を呼び出し使用する試み ###*/
/*############################################################################*/
on3edge([args]) := block([progn:"<on3edge",debug,myrule],
debug:ifargd(),
matchdeclare([on3var,on3varl,on3varr,on3lr],true),
myrule : [1,2,3,4,5,6,7,8],
myrule[1]: tellsimpafter(on3(on3a,on3a,on3b,oo),0),
myrule[2]: tellsimpafter(on3(on3a,on3a,on3b,oc),0),
myrule[3]: tellsimpafter(on3(on3a,on3a,on3b,co),1),
myrule[4]: tellsimpafter(on3(on3a,on3a,on3b,cc),1),
myrule[5]: tellsimpafter(on3(on3b,on3a,on3b,oo),0),
myrule[6]: tellsimpafter(on3(on3b,on3a,on3b,oc),1),
myrule[7]: tellsimpafter(on3(on3b,on3a,on3b,co),0),
myrule[8]: tellsimpafter(on3(on3b,on3a,on3b,cc),1),
c1show(myrule),
cshow(progn,"on3式の端点規則を(グローバル)設定した"),
return(myrule)
)$
/*### on3edge_ex ############################################################*/
on3edge_ex([args]) := block([progn:"<on3edge_ex",debug],
debug:ifargd(),
out : on3edge(), /* on3edge() を飛び出す */
print('on3(a, a, b, oo), " = ", on3(a, a, b, oo)),
print('on3(a, a, b, oc), " = ", on3(a, a, b, oc)),
print('on3(a, a, b, co), " = ", on3(a, a, b, co)),
print('on3(a, a, b, cc), " = ", on3(a, a, b, cc)),
print('on3(b, a, b, oo), " = ", on3(b, a, b, oo)),
print('on3(b, a, b, oc), " = ", on3(b, a, b, oc)),
print('on3(b, a, b, co), " = ", on3(b, a, b, co)),
print('on3(b, a, b, cc), " = ", on3(b, a, b, cc)),
cshow(out)
)$
/*#######################################################################*/
/*### on3varfix0: on3関数on3(x,xl,xr,xlr)の第1引数xをx_fixに変更する（2019.04.19）###*/
/*#######################################################################*/
on3varfix0([args]) := block([progn:"<on3varfix0>", debug, on3func,
on3varsL, L,var,fix, var_fix, one],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3varfix0('help)--
機能: fix='onのとき on3関数on3(v,vl,vr,vlr)の第1引数vをv_fixに変更する
fix='offのとき 逆の操作を行う.
文法: on3varfix(on3func,var,fix,...)
例示: CS: ex = a*x+b
CS: -> out_on = a*x+b
CS: -> out_off = a*x+b
CS: ex = on3(x,a,b,co)
CS: -> out_on = on3(x_fix,a,b,co)
CS: -> out_off = on3(x,a,b,co)
CS: ex = a*on3(x,a,b,co)*on3(y,c,d,co)
CS: -> out_on = a*on3(x_fix,a,b,co)*on3(y,c,d,co)
CS: -> out_off = a*on3(x,a,b,co)*on3(y,c,d,co)
--end of on3ftrue('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3varfix('ex)--"),
/* ???_ex(), */
block([proogn:"<on3varfix_ex>",debug],
debug:ifargd(),
ex0 : a*x+b,
ex1 : on3(x,a,b,co),
ex2 : a*on3(x,a,b,co)*on3(y,c,d,co),
for ex in [ex0,ex1,ex2] do (
cshow(ex),
out_on : on3varfix0(ex,x,'on),
cshow(" -> ", out_on),
out_off : on3varfix0(out_on,x,'off),
cshow(" -> ", out_off)
),
return("-- end of on3varfix_ex --")
), /* end of block */
print("--end of on3varfix0('ex)--"),
return("--end of on3varfix('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1], var : args[2], fix : args[3],
on3varsL : on3vars(on3func),
c2show(progn, var, fix, on3varsL),
if length(on3varsL) = 0 then return(on3func),
L:f2l(on3func), c1show(L), /* change 2012.01.25, 2019.04.14 */
if L[1] = on3 then L : f2l(one*on3func),
var_fix : eval_string(sconcat(var,"_fix")),
c1show(progn,var,var_fix,fix),
c2show(properties(var),properties(var_fix)),
c1show(progn,"before",L),
if fix='on then (
/* on3(x,xl,xr,xlr)-> on3(x_fix,xl,xr,xlr)とし,積分に反応しないようにする */
L:scanmap(lambda([u],if listp(u) and u[1]='on3 and u[2]=ev(var)
then (u[2]:ev(var_fix), u) else u),L)
) else (
/* on3(x_fix,xl,xr,xlr) -> on3(x,xl,xr,xlr)とする */
L:scanmap(lambda([u],if listp(u) and u[1]='on3 and u[2]=ev(var_fix)
then (u[2]:ev(var), u) else u),L)
/* out1 : ev(l2f(L), ev(var_fix)=ev(var)), cshow(out1) */
),
c1show(progn,"after",L),
out : ev(l2f(L), one=1),
c1show(out),
return(out)
)$ /* end of on3varfix0() */
/*#######################################################################*/
/*###on3evdef ### 2019.04.21 ######################################*/
/* on3(var,vl,vr,lr)に変数,文字定数が存在する場合の評価を行う */
/*#######################################################################*/
on3evdef([args]) := block([progn:"<on3evdef>",debug],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3evdef('help)--
機能: on3(var,vl,vr,lr)関数に変数,文字定数が存在する場合の評価を行う
文法: on3evdef(on3func,...)
例示: on3evdef(on3(x,a,a+2,co)) -> on3(x,a,a+2,co)
on3evdef(on3(a,a,a+2,co)) -> 1
--end of on3evdef('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3evdef('ex)--"),
on3evdef_ex(),
block([progn:"<on3evdef('ex)>",debug],
exs : ['on3(a+1,a,a+2,cc),'on3(x,a,a+2,cc),'on3(a,a,a+2,cc),
'on3(a,a,a+2,oc), 'on3(t-u,t-u-1,t-u,oc)],
for ex in exs do (
show(ex,"--> ",on3evdef(ev(ex,nouns)))
),
return("-- end of on3evdef('ex) --")
), /* end of block */
print("--end of on3evdef('ex)--"),
return("--end of on3evdef('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1],
c1show(on3typep(on3func), on3vars(on3func)),
L : f2l(on3func),
L : scanmap(lambda([u],
if listp(u) and u[1]=on3 then (
var:u[2], vl:u[3], vr:u[4], vlr:u[5],
/* is(vr >= vl) = false のときエラーとする? */
if vlr=cc and vr-vl>=0 and var-vl >=0 and vr-var>=0 then u:1
else if vlr=co and vr-vl>0 and var-vl >=0 and vr-var>0 then u:1
else if vlr=oc and vr-vl>0 and var-vl >0 and vr-var>=0 then u:1
else if vlr=oo and vr-vl>0 and var-vl >0 and vr-var>0 then u:1
else u
, u) else u), L),
c1show(L),
return(l2f(L))
)$ /* end of on3evdef() */
/*#######################################################################*/
/*### on3find0 #########2019.04.21 ###*/
/* on3()の積の項において指定した変数Varに関するon3(var,,,,)を検索する */
/*#######################################################################*/
on3find0([args]) := block([progn:"<on3find0>",debug,on3func,var],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3find('help)--
機能: on3()関数の積の項において指定した変数Varに関するon3(var,,,,)関数を検索する
文法: on3find0(on3func,var,...)
例示: CS: ex = on3(x,a,b,co)*on3(y,yl,yr,oo)+x*on3(x,c,d,cc)
CS: on3typep(on3func) = on3poly , on3vars(on3func) = [x,y]
CS: ** find ic = 1 , u = [on3,x,a,b,co]
CS: ** find ic = 2 , u = [on3,x,c,d,cc]
--end of on3ftrue('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3find('ex)--"),
/* on3find_ex(), */
block([progn:"<in3find_ex>",debug],
debug: ifargd(),
ex : on3(x,a,b,co)*on3(y,yl,yr,oo) + x*on3(x,c,d,cc),
c0show(ex),
out : on3find0(ex,x),
c0show(out),
return("-- end of on3find_ex --")
), /* end of block */
print("--end of on3find('ex)--"),
return("--end of on3find('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1], var : args[2],
show(on3typep(on3func), on3vars(on3func)),
L : f2l(on3func),
ic : 0,
L : scanmap(lambda([u],
if listp(u) and u[1]=on3 and u[2]=ev(var) then (
ic:ic+1, show("** find ",ic,u),
u:sconcat("<<here-",ic,">>"), u) else u), L),
show(L),
return(l2f(L))
)$ /* end of on3find0() */
/*#######################################################################*/
/*### on3on3 ##########################################################*/
/* 同一変数に関するon3()関数の積の簡約化を試み,簡約化ができない場合は無処理とする
on3(x,a,b,lr1)*on3(x,c,d,lr2) (a<=b,c<=d) -> on3(x,vl,vr,vlr)
--a--c--b--d-- (a<=c, c<=b, b<=d)のとき on3(x,c,b,vlr), vlr=[lr2l,lr1r]
--a--c--d--b-- (a<=c, c<=d, d<b)のとき on3(x,c,d,vlr), vlr=[lr2l,lr2r]
--c--a--b--d-- (c<a, a<=b, b<=d)のとき on3(x,a,b,vlr), vlr=[lr1l,lr1r]
--c--a--d--b-- (c<a, a<=d, d<b)のとき on3(x,a,d,vlr), vlr=[lr1l,lr2r]
otherwise のときは無処理で on3(x,a,b,lr1)*on3(x,c,d,lr2) を返す
用途:
matchdeclare([on3v,on3a,on3b,on3lr1,on3c,on3d,on3lr2],true),
tellsimp(on3(on3v,on3a,on3b,on3lr1)*on3(on3v,on3c,on3d,on3lr2),
on3on3(on3(on3v,on3a,on3b,on3lr1),on3(on3v,on3c,on3d,on3lr2)) )
*/
/*#######################################################################*/
on3on3(on3func1,on3func2,[args]) := block([progn:"<on3on3>",debug,
L1,L2,L12, lr, out],
/* 永久ループの問題<<注意>> : ------------------------------------------
on3on3() はtellsimpの記述に基づいて呼び出される.
on3on3 内に on3()*on3() と行った文があると,またtellsimpの対象として
on3on3が呼び出され永久ループとなる.
tellsimp から letsimp に変更
--------------------------------------------------------------------- */
debug:ifargd(),
cshow(progn,"--enter---"),
c2show(on3typep(on3func1), on3vars(on3func1)),
c2show(on3typep(on3func2), on3vars(on3func2)),
local(v1,a,b,lr1, v2,c,d,lr2, l1,r1,l2,r2),
L1 : f2l(on3func1), v1:L1[2], a:L1[3], b:L1[4], lr1:L1[5],
L2 : f2l(on3func2), v2:L2[2], c:L2[3], d:L2[4], lr2:L2[5],
cshow(L1,L2),
c1show(v1,a,b,lr1,v2,c,d,lr2),
/* lr1 lr2 から端点a,b,c,dの開閉を取り出す */
l1:"o", r1:"o", l2:"o", r2:"o",
if lr1=cc or lr1=co then l1:"c", if lr1=oc or lr1=cc then r1:"c",
if lr2=cc or lr2=co then l2:"c", if lr2=oc or lr2=cc then r2:"c",
c2show(lr1,"->",l1,r1,lr2,"->",l2,r2),
/* v1=v2 の確認 */
L12 : ["*",L1,L2], /* 無処理のとき返す内容(on3の積にしないこと) */
if v1 # v2 then return(L12) else v:v1,
if is(a>b)=true then (
cshow(progn,"on3func1 の区間指定で例外を発見したので実行を停止する!"),quit()),
if is(c>d)=true then (
cshow(progn,"on3func2 の区間指定で例外を発見したので実行を停止する!"),quit()),
if (is(a<=b) = unknown) or (is(c<=d) = unknown) then (
assume(a <= b), assume(c <= d), cshow(facts()),
print(" ++ 仮定: assume : ",a," <= ",b, " and ",c, " <= ",d," ++")
),
out : L12,
if a<=c and c<=b and b<=d then
( lr:eval_string(sconcat(l2,r1)), out : on3(v,c,b,lr) )
else if a<=c and c<=d and d<b then
( lr:eval_string(sconcat(l2,r2)), out : on3(v,c,d,lr) )
else if c<a and a<=b and b<=d then
( lr:eval_string(sconcat(l1,r1)), out : on3(v,a,b,lr) )
else if c<a and a<=d and d<b then
( lr:eval_string(sconcat(l1,r2)), out : on3(v,a,d,lr) ),
if b<c or d<a then out : 0,
cshow(out),
/* assume() で設定した仮定,変数の表示と解除 */
c1show("設定された仮定:",properties(a)),cshow(facts(a),facts(c)),
forget(facts(a)), forget(facts(b)), forget(facts(c)), forget(facts(d)),
kill(a,b,c,d), /* 仮定,変数の解除 */
c1show("設定された仮定及び変数の削除(forget,kill)確認: ",
facts(a),facts(b),facts(c),facts(d)),
return(out)
)$ /* end of on3on3() */
/*#######################################################################*/
on3on3_ex1([args]) := block([progn:"<on3on3_ex1>",debug],
debug:ifargd(),
out : on3on3(on3(x,a,a+2,cc),on3(x,a+1,a+5,oc)),
cshow(out)
)$ /* end of on3on3_ex1 */
/*#######################################################################*/
on3on3_ex2([args]) := block([progn:"<on3on3_ex2>",debug,a,b,c,d],
debug:ifargd(),
local(a,b,c,d),
cshow(progn,"--enter--"),
/* 永久ループの問題<<注意>> : ------------------------------------------
on3on3() はtellsimpの記述に基づいて呼び出される.
on3on3 内に on3()*on3() と行った文があると,またtellsimpの対象として
on3on3が呼び出され永久ループとなる.
tellsimp から letsimp に変更
--------------------------------------------------------------------- */
/* maxapplydepths:5, maxapplyheight:5, */
if true then (
clear_rules(),
matchdeclare(on3v,atom,[on3a,on3b,on3lr1,on3c,on3d,on3lr2],true),
myrule:tellsimp( on3(on3v,on3a,on3b,on3lr1)*on3(on3v,on3c,on3d,on3lr2),
on3on3(on3(on3v,on3a,on3b,on3lr1),on3(on3v,on3c,on3d,on3lr2)) ),
cshow(myrule)
),
c1show(values),
ex1 : "on3(x,a,a+2,cc)*on3(x,a+1,a+5,oc)",
ans1 : "on3(x,a+1,a+2,oc)",
out : eval_string(ex1),
cshow(ex1,"-->",out, ans1),
cshow("---begin of ex2 ---"),
ex2 : "on3(x,a,b,cc)*on3(x,a-1,b+1,cc)",
ans2 : "on3(x,a,b,cc)",
out : eval_string(ex2),
cshow(ex2,"-->",out, ans2),
cshow("---begin of ex3 ---"),
ex3 : "on3(x,a,b,cc)*on3(x,b+1,d,cc)",
ans3 : "0",
out : eval_string(ex3),
cshow(ex3,"-->",out, ans3),
if false then (
cshow("---begin of ex4 ---"),
ex4 : "on3(x,a,b,cc)*on3(x,a+3,a-2,cc)",
ans4 : "実行停止",
out : eval_string(ex4),
cshow(ex4,"-->",out, ans4)
)
)$ /* end of on3on3_ex2 */
/*#########################################################################*/
/*### findstr : ユーザ定義の関数,マクロから指定文字列を含む関数(マクロ)名を検索する ###*/
/*#########################################################################*/
findstr([args]) := block([progn:"<findstr>",debug,listname,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
/* block_main */
block_main, /* メインブロック */
/* functions, macros : Maxima 予約リスト */
str : args[1],
declare(str,noun), str : string(str),
print(progn,"search string =",str),
chk(a) := if ssearch(str, string(a)) > 0 then true, /* sublist の判定関数 */
for listname in ['functions, 'macros] do (
out : sublist(ev(listname), chk), /* 判定関数chk()がTRUEのサブリストを返す */
print(progn,listname,"-->",out)
),
return("--- end of findstr ---"),
block_help, /* ヘルプブロック */
printf(true,"
--begin of findstr('help)--
機能: ユーザ定義の関数,マクロから指定文字列を含む関数(マクロ)名を検索する
文法: findstr(str)
例示: findstr('solve)
--end of findstr('help')--
"
),
return('normal_return),
block_ex, /* 例ブロック */
print("--begin of func1('ex)--"),
block([cmds,w1,w2,wout],
cmds : sconcat("( ",
"findstr('solve), /* 文字列solve を含む関数名,マクロ名を標示する */ @",
"findstr('decomp), /* 文字列decomp を含む関数名,マクロ名を標示する */ @",
"findstr('show) /* 文字列show を含む関数名,マクロ名を標示する */ @",
" )"),
chk1show(cmds,""),
return(wout)
), /* end of block */
/* find_key_ex(), */
print("--end of findstr('ex)--"),
return("--end of findstr('ex)--")
)$
/*+++ findstr_ex() ++++++++++++++++++++++++++++++++++++++++++++*/
findstr_ex([args]) := block([progn:"<findstr>"],
findstr('decomp),
findstr(decomp),
findstr(solve),
findstr(_ex),
findstr(show)
)$
/*#######################################################################*/
/*### exchk : 例題プログラムとその答えを作成する ##############################*/
/*#######################################################################*/
exmk(ex,[args]) := block([progn:"<exmk>",debug,ans,out,chk],
debug:ifargd(),
c1show(progn,ex),
if stringp(ex)=false then ex : string(ex),
c1show(ex),
out : eval_string(ev(ex,noeval)),
ans : string(out),
exans : [ex,ans],
return(exans)
)$
/*### exmk_ex ############################################################*/
exmk_ex([args]) := block([progn:"<exmk_ex>",debug],
debug:ifargd(),
exans : exmk("on3(2,1,3,co)"),
cshow(ex,exans),
exchk("", [exans]),
return("--end of exmk and exchk--")
)$
/*#######################################################################*/
/*### exchk : 例題プログラムの検査を行う ##############################*/
/* ex: exchk(null, [["on3(2,1,3,co)","1"]]);
exchk("on3simp", [["on3(x,1,3,co)*on3(x,2,4,co)","on3(x,2,3,co)"]]); */
/*#######################################################################*/
exchk(on3func_name,exansL,[args]) := block([progn:"<exchk>",debug,
exans, ex, exf, ans, out, chk, swshow:0, outcmt:""],
debug:ifargd(),
c1show(on3func_name),
c1show(exansL,length(exansL)),
for exans in exansL do (
c1show(exans,length(exans)),
outcmt:"",
if length(exans) = 3 then ( /* on3showオプション または 注釈 */
swshow : ssearch("on3show",exans[3]),
outcmt:"", if swshow=false then outcmt : exans[3]
), /* end of if 3 */
if length(exans) = 1 then (print("▼",exans[1]) ),
if length(exans) > 1 then (
ex : exans[1], ans : exans[2],
if is(ans # "") then ans : eval_string(ans),
c1show(ex,ans),
exf : ex,
if stringp(on3func_name) and slength(on3func_name)>1
then exf : sconcat(on3func_name,"(",ex,")"),
c1show(exf),
out : eval_string(exf),
c1show(out),
if is(equal(out,ans)) then chk:"◎ " else chk:"◆ 不一致 ◆",
if chk="◎ " then (
if slength(exf) < 45 then print("★",chk, exf,"=",out, outcmt)
else ( print("★", chk, exf), print(" =",out, outcmt))
),
if chk="◆ 不一致 ◆" then (
print("★", chk, exf), print(" =",out),
print(" <- ans =",ans)),
if swshow > 0 then (
now:display2d, display2d:true, on3show(out), display2d:now
)
) /* end of if > 1 */
), /* end of for */
return("--end of exchk---")
)$
/*### exchk_ex ##########################################################*/
exchk_ex([args]) := block([progn:"<exchk_ex>",debug],
exansL : [["第1引数が区間の左端点に一致する場合"],
["on3(a, a, b, oo)","0"], ["on3(a, a, b, oc)","0"],
["on3(a, a, b, co)","1"], ["on3(a, a, b, cc)","1"]],
exchk("",exansL),
exansL : [["第1引数が区間の右端点に一致する場合"],
["on3(b, a, b, oo)", "0"], ["on3(b, a, b, oc)", "1"],
["on3(b, a, b, co)", "0"], ["on3(b, a, b, cc)", "1"]],
exchk("",exansL),
exansL : [["区間の端点が一致する場合"],
["on3(a, inf, inf, oo)","0"],["on3(a, minf, minf, oo)","0"]],
exchk("",exansL),
exansL : [["第1引数がminf,infの場合:特例"],
["on3(inf, a, inf, co)","1"],["on3(minf, minf, b, oc)","1"]],
exchk("",exansL),
return("--end of exchk--")
)$ /* end of exchk */
/*#######################################################################*/
/*### exchk2 : 例題プログラムの検査を行う ##############################*/
/* ex: exchk2(["on3(2,1,3,co)", "ex", "1", "comment/on3show" ]);
exchk2(["on3(x,1,3,co)*on3(x,2,4,co)", "on3simp(ex)", "on3(x,2,3,co)"]);
*/
/*#######################################################################*/
exchk2(exansL,[args]) := block([progn:"<exchk2>",debug,
ex, ex_s, exfunc, exfunc_s, ans, outform, chk, chkm, swshow:0, outcmt:""],
debug:ifargd(),
if exansL='help then (
print("--exchk2 help begin--"),
print(" exchk2([[ex:例, exfunc:関数部, ans:答え],[\"文字列\"], ...])"),
print(" exchk2(['on3(2,1,3,co), \"ex\", \"1\", \"comment/o3show\" ]);"),
print(" exchk2([\"on3(x,1,3,co)*on3(x,2,4,co)\",\"on3simp(ex)\",\"on3(x,2,3,co)\"]);"),
print(" ex : 'on3(2,1,3,co) or ev(on3(2,13,co),noun)"),
print(" out : ev(exfunc, nouns) "),
return("--exchk2 help end--")
),
if listp(exansL) and listp(exansL[1])=false then exansL : [exansL],
/* exansL = [[<title1>], [ex1,exfunc1,<ans1>,<on3show/comment>],[],...,[]] */
for exans in exansL do (
c1show(exans,length(exans)),
if length(exans)=4 then ( /* on3showオプション または 注釈 */
swshow : ssearch("on3show",exans[4]),
outcmt:"", if swshow=false then outcmt : exans[4]
), /* end of if 3 */
if length(exans) = 1 then (print("▼",exans[1]) ),
if length(exans) > 1 then (
if stringp(exans[1])
then (ex_s : exans[1], ex : eval_string(exans[1]))
else (ex_s : sconcat(exans[1]), ex : exans[1]),
if stringp(exans[2])
then (exfunc_s : exans[2], exfunc : eval_string(exans[2]))
else (exfunc_s : sconcat(exans[2]), exfunc : exans[2]),
/* ex : 'on3(2,1,3,co) or ev(on3(2,13,co),noun)
ex : 'on3(x,1,5,co)*'on3(x,3,8,co) or ev(on3(x,1,5,co)*on3(x,3,8,co),noun)
exfunc : ex or 'on3sim('ex) or ev(on3simp('ex),noun)
out : ev(exfunc, nouns) */
if is(exans[3] # "") then ans : eval_string(exans[3]),
if exfunc = ex then exfunc:'ex,
c1show(progn, ex_s, exfunc_s, ans),
out : ev(exfunc, nouns), /* 動詞化 */
c1show(out),
display2d:false,
if is(equal(out,ans)) then (chk:true, chkm:"◎ ") else (chk:false, chkm:"◆ 不一致 ◆"),
if chk=true then (
if slength(ex_s)+slength(exfunc_s) < 40 then
print("★",chkm, "ex :", ex_s, ",", exfunc_s,"=",out, outcmt)
else ( print("★",chkm, "ex :", ex_s),
print(" ",exfunc_s),
print(" =",out, outcmt))
),
if chk=false then (
print("★", chkm, exfunc_s), print(" =",out),
print(" <- ans =",ans)),
if swshow > 0 then (
now:display2d, display2d:true, on3show(out), display2d:now
)
) /* end of if > 1 */
), /* end of for */
return("--end of exchk2---")
)$ /* end of exchk2 */
/*### exchk2_ex #######################################################*/
exchk2_ex([args]):= block([progn:"<exchk2_ex>",debug],
print("-- exchk2_ex ---"),
exchk2([["on3()関数の振る舞い"],
['on3(2,1,3,co), ex, "1"," <- ex of exchk2"],
["微分"],
[ev(x^3*on3(x,1,3,co),noun),'on3diff('ex,x,1),
"3*x^2*on3(x,1,3,oo)","<- ex of exchk2"]
]),
exchk2(["on3()関数の振る舞い"]),
exchk2(['on3(2,1,3,co), ex, "1"," <- ex of exchk2"]),
exchk2(["微分"]),
exchk2([ev(x^3*on3(x,1,3,co),noun),'on3diff('ex,x,1),
"3*x^2*on3(x,1,3,oo)","<- ex of exchk2"]),
exchk2(["不定積分"]),
exchk2([%e^(1-x)*on3(x,1,inf,co)+x^2*on3(x,0,1,co), 'on3integ(ex,x),
"(%e^-x*(4*%e^x-3*%e)*on3(x,1,inf,co))/3+(x^3*on3(x,0,1,co))/3","on3show"]),
exchk2([x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)+((1-x^2)*on3(x,0,1,oo))/2,
'on3integ(ex,x),
sconcat("(x^3*on3(x,minf,0,oo))/3-((3*x^2-6*x+1)*on3(x,1,inf,co))/6",
"-(x*(x^2-3)*on3(x,0,1,oo))/6"), "on3show"]),
exchk2([x^2*on3(x,minf,0,oo)+(1-x)*on3(x,1,inf,oo)
+((1-x^2)*on3(x,0,1,oo))/2+sin(x), 'on3integ(ex,x),
sconcat("(-((3*cos(x)-x^3)*on3(x,minf,0,oo))/3)",
"-((6*cos(x)+3*x^2-6*x+1)*on3(x,1,inf,co))/6",
"-((6*cos(x)+x^3-3*x)*on3(x,0,1,co))/6"), "on3show"]),
/*
exchk2([f2*on3(x,c,d,co)+f1*on3(x,a,b,co), 'on3integ(ex,x),
sconcat("(d*f2-c*f2)*on3(x,d,inf,co)+(f2*x-c*f2)*on3(x,c,d,co)".
"+(b*f1-a*f1)*on3(x,b,inf,co)+(f1*x-a*f1)*on3(x,a,b,co)"),
"on3show" ]),
*/
exchk2([f2*on3(x,0,1,co)*on3(y,x,2,co)+f1*on3(x,0,1,co)*on3(y,x,1,co),
'on3integ(ex,y),
sconcat("on3(x,0,1,co)*(f2*y-f2*x)*on3(y,x,2,co)",
"+on3(x,0,1,co)*(f1*y-f1*x)*on3(y,x,1,co)",
"+(2*f2-f2*x)*on3(x,0,1,co)*on3(y,2,inf,co)",
"+(f1-f1*x)*on3(x,0,1,co)*on3(y,1,inf,co)"),
"on3show"]),
exchk2(["2重定積分"]),
exchk2([(y+x+5)*(on3(x,2,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)
+on3(x,-3,-2,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)
+on3(x,-2,2,co)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc)
+on3(x,-2,2,co)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc)),
'on3integ(ex,y,minf,inf),
sconcat("sqrt(9-x^2)*((2*x+10)*on3(x,2,3,co)+(2*x+10)*on3(x,-2,2,co)",
"+(2*x+10)*on3(x,-3,-2,co))+((-2*x)-10)*sqrt(4-x^2)*on3(x,-2,2,co)"),
" <- yに関して積分"]),
exchk2([(y+x+5)*(on3(x,2,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)
+on3(x,-3,-2,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)
+on3(x,-2,2,co)*on3(y,-sqrt(9-x^2),-sqrt(4-x^2),cc)
+on3(x,-2,2,co)*on3(y,sqrt(4-x^2),sqrt(9-x^2),cc)),
'on3integ('on3integ(ex,y,minf,inf), x,minf,inf),
"25*%pi",
" <- yとxに関して積分"]),
return("-- end of exchk2_ex --")
)$ /* endof exchk2_ex() */
/*#############################################################################*/
/* end of on3lib20.mx */
/*#############################################################################*/
/*### --- fsplit: on3ineq.mx --- ##########################################*/
/*===全体構成 ==============================================================
on3ineq (2009.09.29, 2009.10.20, 2010.03.04, 2010.10.01,
2011.01.19, 2011.09.28, 2017.02.13, 2019.07.26 改訂)
|---S1 on3ineq_backsolve: (use: msort, elimalg1, va_unique)
| 変数消去に基づき等式解 va, 特異点 vsing 及び 端点リスト vlist を得る
|---S2 on3ineq_fwd: (use: realp, msort)
| 分割されたセル領域の不等式仮判定と解候補生成
|---S3 on3ineq_shrink: 縮退領域の追加と貼り付け (use: shrink, msort, flrlimit)
|---S4 on3ineq_acnode: 孤立点の追加，補正 (use: salgall, sqrt2d)
|---S5 on3dplot2: 解領域の探索的表示, on3gr2: 解領域の関数表示
|-x--S5 on3ineq_reduce: on3多項式の簡素化
| on3ineq_reduce_sub, (on3lrl, f2l, l2f, ...)
| on3ineq_reduce_add, wscan, wscan_sub, reduce2 (clr,flr)
|-x--S5 on3ineq_check: 端点検査 outerl
|-x--S6 on3ineq_decomp: on3多項式の同等性を調べる
==========================================================================*/
/*### on3ineq ##############################################################*/
/* <on3ineq> : m変数不等式 on3ineq([[f,fl,fr,flr],...],'varl=[x,y,...]) の求解 */
/*############################################################################*/
on3ineq([args]) := block([progn:"<on3ineq>",debug,varlt,vlist,vmdiv:3,Exs,
/* vnoend:0,varl:[],on3f:0,acnode:[], */
outlineonly,resultonly,on3floatnump,plotmode:true,fL,outl,outs,restlr,
gkey,glist,dkey,dlist,gdlist,swview],
/* 共通変数: FL, vnoend, varl, on3f, outsum, LL, V, acnode */
vnoend:0, varl:[], on3f:0, acnode:[], /* 共通変数の初期化 */
debug:ifargd(), c1show(debug),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='detail then go(block_detail),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3ineq('help)--
機能: m変数多項式不等式 on3ineq([[f,fl,fr,flr],...],'varl=[x,y,...]) の求解
文法: on3ineq([f,fl,fr,flr],...) or on3ineq([[f,fl,fr,flr]],...)
on3ineq([[f1,f1l,f1r,f1lr],[f2,f2l,f2r,f2lr],...],'varl=[x,y,...])
例示: on3ineq([x^2+y^2,1,9,co],'view)
on3ineq([x^2+y^2,1,9,co],'resultonly,'view)
メモ: on3(log(x),1,2,co,eval) による解法
--end of on3ineq('help')--
"
),
return('normal_return),
block_detail, /* detail ブロック ====================================*/
printf(true,"
--on3ineq('detail)--
[使用例]
fl <= f(x,y,z) < fr ---> on3ineq([[f(x,y,z),fl,fr,co]]) (注:関数fは多項式に限定)
fl <= f(x,y,z) ---> on3ineq([[f(x,y,z),fl,inf,co]])
f(x,y,z) < fr ---> on3ineq([[f(x,y,z),minf,fr,oo]])
下限 fl, 上限 fr は関数であっても可, co は閉(c)開(o)を表す．
連立不等式 ---> on3ineq([[f1,f1l,f1r,lr1],[f2,f2l,f2r,lr2],...])
on3ineq(on3(f(x,y),fl,fr,co)) ---> on3ineq([[f(x,y),fl,fr,co]]) として解く
[変数メモ]
varl : [x,y_1,...,y_m,z] : 変数リスト (varl=[y,x]の様に指定可)
va : [ansx,ansy_1,...,ansy_m,ansz] : 等式解のリスト
=[[[x1,c],[x2,o],...], [[y1,o],[y2,c],...],...,[[z1,o],[z2,o],...]]
vsing : [xs,ys_1,...,ys_m,zs], : 特異点のリスト
=[[[x1,s],[x2,s],...], [[y1,s,],...],...,[[z1,s],[z2,s],...] ]
acnode : [[x = x1,y = y1],[x = x2,y = y2],...] : 孤立点
vmdiv : 中間点の指定 vmid : vl + (vr-vl)/vmdiv
FL : 入力不等式のリスト
[[f(x,y,z),fl,fr,co]]， [[f1,f1l,f1r,lr1],[f2,f2l,f2r,lr2],...]
LL : 不等式解のリスト表現
-- begin of example fL = [on3,y^2+x^2,1,9,oc] --
LL =
[[['V[1][1],'V[1][2],co],['V[2][3],'V[2][4],cc]],
[['V[1][2],'V[1][3],cc],['V[2][3],'V[2][1],co]],
[['V[1][2],'V[1][3],cc],['V[2][2],'V[2][4],oc]],
[['V[1][3],'V[1][4],oc],['V[2][3],'V[2][4],cc]]]
, where
V[ 1 ]= [-3, -1, 1, 3, minf, inf]
V[ 2 ]= [-sqrt(1-x^2), sqrt(1-x^2), -sqrt(9-x^2), sqrt(9-x^2), minf, inf]
-- end of example --
V : 解の左右境界(値，線，．．．)の数式表現リスト
制限: 多変数多項式 (algsys が等式解を返せる関数，第1変数以外は4次まで可)
on3f : 入力不等式のon3表現
outsum : 不等式解の関数表現
共通変数: on3ineqOutL = ['FL=FL, 'on3f=on3f, 'varl=varl, 'LL=LL, 'V=V, 'vsing=vsing,
'acnode=acnode, 'outsum=outsum] (本ルーチンの外で参照可能)
debug : null, debug1, debug2, debug3 (デバッグレベル)
on3floatnump : {true,false}:algsysの結果:近似解(true),厳密解(false)を返す
restlr: {[minf,inf]*,[xl,xr]}:第1変数解の範囲を制限したいときに指定する
outlineonly: {true,false*}:開閉処理をしないときtrueとする
flimitmode: {true*,false}:左右極限値評価を浮動小数モードで行うときtrueとする
resultonly: (true,false*):最終結果outsumのみを表示したいときtrueとする
{'view,'noview} : 不等式解のグラフ表示の有無
{'nooutsum} : 最終結果outsumの非表示
-------------------------------------------------------------------
--end of on3ineq('detail)--
"
),
return("end of on3ineq('detail)"),
block_ex, /* example ブロック ===================================*/
print("--begin of on3ineq('ex)--"),
/*on3ineq_ex(), */
block([progn:"<on3ineq('ex)>",debug,cmds,ans1,ans3,figfile],
printf(true,"
--on3('ex)--
on3ineq([x^2+y^2,1,9,co],'view)
on3ineq([x^2+y^2,1,9,co],'resultonly,'view)
--end of on3('ex)--
"
),
figfile : sconcat(figs_dir,"/","on3ineq-ex1"),
cmds : sconcat("( ",
" /* 例1. */ @",
"on3ineq([x^2+y^2,1,9,co], 'resultonly, @",
"'file_name=",figfile, ", ", swview, ") @ ",
" )"),
ans1 : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co),
chk1show(cmds,ans1),
figfile : sconcat(figs_dir,"/","on3ineq-ex2"),
cmds : sconcat("( ",
" /* 例2. */ @",
"on3ineq([x^2+y^2,1,9,oc], 'resultonly, @",
"'file_name=",figfile, ", ", swview, ") @ ",
" )"),
chk1show(cmds,""),
cmds : sconcat("( ",
" /* 例3. */ @",
"on3ineq([x^2+y^2+z^2,1,9,co], 'resultonly, 'noview )",
" )"),
ans3 : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
*on3(z,-sqrt((-y^2)-x^2+9),sqrt((-y^2)-x^2+9),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
*on3(z,-sqrt((-y^2)-x^2+9),sqrt((-y^2)-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
*on3(z,-sqrt((-y^2)-x^2+9),sqrt((-y^2)-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co)
*on3(z,-sqrt((-y^2)-x^2+9),sqrt((-y^2)-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),oo)
*on3(z,-sqrt((-y^2)-x^2+9),-sqrt((-y^2)-x^2+1),oc)
+on3(x,-1,1,oo)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),oo)
*on3(z,sqrt((-y^2)-x^2+1),sqrt((-y^2)-x^2+9),co),
chk1show(cmds,ans3),
return("end of on3ineq('ex)-block")
), /* end of block */
print("--end of on3ineq('ex)--"),
return("--end of on3ineq('ex)--"),
block_main, /* main ブロック ====================================*/
/* rat 関係の浮動小数･有理数の標示抑制 */
ratprint:false, keepfloat:true,
if length(args) >= 1 and listp(args[1]) then (
FL : copylist(args[1]), c1show(FL)),
outlineonly:false,
if member('resultonly,args) then resultonly:true else resultonly:false,
if member('noplot, args) then (plotmode:false, args:delete('noplot,args)),
/*
c1show(progn,args),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3ineq-regionview"),
columns=2, dimensions=[1000,500]],
dkeyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,dkeyL),
cshow(progn,dlist),
*/
/* ex1: on3ineq([(x-y)/((x-1)*(y-2)), 1/(x-1), 1/(y-2),co])
ex2: C2 C2:funmake(on3ineq,[[x^2+y^3+2*x*y,1,9,co]]),
ex3: H1a H1a:funmake(on3ineq,[[x^2-y^2-(x^2+y^2)^2,-1,0,oc]]),
ex4: H2:funmake(on3ineq,
[[(93392896/15625)*y^6
+((94359552/625)*x^2+(91521024/625)*x +(-249088)/125)*y^4
+((1032192/25)*x^4-36864*x^3+((-7732224)/25)*x^2
+(-207360)*x+770048/25)*y^2
+65536*x^6+49152*x^5+(-135168)*x^4
+(-72704)*x^3+101376*x^2+27648*x-27648, 0,0,cc]]),
ex5: S1:funmake(on3ineq,[[(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co]]),
ex6: A1:funmake(on3ineq,
[[[y,(x-1)*(x-5)+5,(-(x-1))*(x-5)+5,co],[y,(-(x-2))+3,(x-2)+3,co]]]),
ex7: q3(file_name="/tmp/lang/tmp-q3",'noview)$
ex8: q4(file_name="/tmp/lang/tmp-q4",'noview)$
*/
/*
Exs :
"=== Examples in on3ineqlib ==============================:
realp_ex(), elimalg11_ex(), msort_ex(), mkfloat_ex(),
floatfix_ex(), flrlimit_ex(), salgall_ex(), sqrt2d_ex(),
on3ineq_ex(c1,c2oo,c2oc,c2co,c2cc,c3oo,c3oc,c3co,c3cc,
c4oo,c4oc,c4co,c4cc,
A1,A2,S0,S1,S2,S3,K1,K2,H1,H1a,H2),
q3(), q4(), chk1g(), chk2g(), chk3g(),
grv_ex(), on3gr_ex()
============================================================",
*/
if atom(FL)=true then (print(Exs),return()),
c1show(FL),
if listp(FL) = false
then ( FL : f2l_one(FL), FL : delete(on3,FL,1), FL : [FL])
else if listp(FL[1])=false then FL:[FL],
c1show(progn, FL),
/* 入力不等式の2重リストFLのon3関数式表現 */
on3f:1, for i thru length(FL) do
on3f:on3f*funmake(on3,[FL[i][1],FL[i][2],FL[i][3],FL[i][4]]),
/* 変数リストの設定(無指定の場合は自動生成) */
for i thru length(args) do if lhs(args[i])='varl then varl:rhs(args[i]),
varlt : listofvars(on3f),
for i thru length(varlt) do if member(varlt[i],[oo,oc,co,cc]) then varlt[i]:null,
varlt:sort(delete(null,varlt)),
if varl=[] then varl:copylist(varlt)
else if length(varl) # length(varlt) then
(cshow("指定された変数リストと式中に現れる変数の個数が不一致"),
cshow("->",varl), cshow("->",varlt),return("Error in ",progn)),
vnoend:length(varl),
c1show("==on3ineq==",vnoend,varl),
va : makelist([],i,1,vnoend),
vsing : makelist([],i,1,vnoend),
vlist : makelist([],i,1,vnoend), /* vlist[2] は vlist[1]の端点に依存する */
/*=== S1: 変数消去により等式解 va, 特異リスト vsing を求める ==============*/
c1show("=== on3ineq begin ===",varl),
[va,vsing] : on3ineq_backsolve(FL,debug0),
c1show("result of backsolve:",varl,vlist,va,vsing),
LL:[],
c1show("== start on3ineq_fwd ==="),
/*=== S2: セル領域(派生する境界面(線,点)を含む)の不等式仮判定と解候補生成(重要) ========*/
LL : on3ineq_fwd(varl,va,vlist,vsing,debug0),
c1show(progn,"--end of on3ineq_fwd--"),
if outlineonly # true then (
c1show(progn,"pre-shrinkr:",LL),
LL:on3ineq_shrink(debug0),
c1show(progn,"post-srhrinkr:",LL)
),
[outsum,varl,LL,V] : ll2on3(varl,va,LL,resultonly), /* 解の整理と表示 */
on3ineq_OutL : ['FL=FL,'on3f=on3f, 'varl=varl,
'LL=LL,'V=V,'vsing=vsing,'acnode=acnode,'outsum=outsum],
c1show(progn,on3ineq_OutL),
if false then (display2d:true, on3show(outsum)),
outsum:ev(outsum,nouns),
if resultonly=false then (
if slength(sconcat(outsum)) < 300 then cshow(progn,outsum),
print("--[Result display]--"),
print("varl =",varl),print("LL =",LL), print(", where"),
for vno thru vnoend do (
if slength(sconcat(V[vno])) > 300
then print("V[",vno,"]=",reveal(V[vno],6))
else print("V[",vno,"]=",V[vno]) ),
c1show(outsum),
print("---end---"), display2d:false, /*display2d_old, */
cshow("参照可能変数: varl,V,LL,vsing,on3f,fL,on3floatnump,acnode")
),
/*=== S3: 孤立点検証に基づく補正 ==============================================*/
c1show(progn,outlineonly),
if outlineonly=true then (outs:0) else
([acnode,outl,outs] : on3ineq_acnode(FL),
c1show("--->",outl),c1show("--->",outs), outsum:outsum+outs ),
/*xxx S4: 不等式解の構成 ==============================================*/
if false then outsum : on3ineq_build(outsum,noreduce,correct),
/*xxx S5:合併(結合)処理 ====================================================*/
if false then (outsum : on3ineq_reduce(outsum)),
/*xxx S6: 孤立点検証 =========================================================*/
if false then on3ineq_check(varl,va,vsing,on3f,outsum),
/* return([outsum,varl,LL,V]) */
/*=== begin view =======================================================*/
if plotmode then (
glist : ['title="on3ineq-regionview", 'xrange=[-5,5], 'yrange=[-5,5]],
gkey : ['title, 'xrange, 'yrange],
glist : mergeL(glist,args,gkey), /* glist をargs で更新 */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3ineq-regionview"),
columns=2, dimensions=[1000,500] ],
dkey : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,dkey), /* dlist をargs で更新 */
c1show(progn,args),
c1show(progn,dlist),
gdlist : append(glist,dlist),
c1show(gdlist),
on3regionview(FL,outsum,'argsL=gdlist,swview) /* グラフ表示 */
),
c1show(progn,FL), c1show(progn,gdlist),
if member('nooutsum, args)
then (c1show(progn,"outsum : 省略"), return("--end of on3ineq()--"))
else (c1show(progn,outsum), return(outsum))
)$ /* end of on3ineq() */
/*#################################################################################*/
/*# ll2on3: varl, va から V を作成し，varl, LL, V を表示する (in on3ineq(), 内部使用) #*/
/*#################################################################################*/
ll2on3(varl,va,LL,[args]) := block([progn:"<ll2on3>",debug,display2d_old,
LLs,vvv,tmp],
debug:ifargd(),
display2d_old:display2d, display2d:false,
c1show(progn,length(va),va),
LLs : sconcat(LL), LLs:ssubst("'V","'va",LLs),LL:eval_string(LLs),c1show(LL),
V:copylist(va),
V:scanmap(lambda([u],if listp(u) and listp(u[1])=false
and (u[2]=o or u[2]=c or u[2]=s) then u:u[1] else u ),V),
c1show(V), outsum:0, vnoend:length(varl),
for i thru length(LL) do ( vvv :1,
for vno thru vnoend do (
tmp : funmake(on3,cons(varl[vno],LL[i][vno])),
c1show(tmp,ev(tmp,nouns)),
vvv:vvv*ev(tmp,nouns)
), /* end of for-vno */ vvv:ev(vvv,nouns,infeval), c1show(vvv),
outsum:outsum+vvv
), /* end of for-i*/
outsum : ev(outsum,nouns,infeval),
return([outsum,varl,LL,V])
)$
/*############################################################################*/
/*### on3regionview : 廃止予定 on3ineq()の入力FLと結果outsumから結果の解領域を図示する ###*/
/*############################################################################*/
on3regionview([args]) := block([progn:"<on3regionview>",debug,
plotmode:true, viewmode:true, /* , outsum, dlist,*/ keyL,on3func,
xrange,yrange,argsc,argsL,rxrange,ryrange,keyv,
dxlr,xl,xr,nx,dylr,yl,yr,ny, gd,gout,dlist3,glist,swview],
debug : ifargd(),
if member('noview,args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3regionview('help)--
機能: on3ineq()の入力FLと結果outsumから結果の解領域を図示する
文法: on3regionview(FL,outsum,...)
例示: on3ineq('ex); /* on3ineq()関数の共通変数FL,outsum,vsingを参照する */
on3regionview([[y^2+x^2,1,9,co]],outsum);
メモ: 未完成,廃止予定
--end of on3regionview('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3regionview('ex)--"),
block([progn:"<on3regionview('ex)>",varl,FL,outsum,argsL]),
on3ineq([x^2+y^2,1,9,co],'resultonly,'noview),
/* on3ineq() の共通変数: varl, FL, outsum, LL, V, vsing */
varl : [x,y],
FL : [[y^2+x^2,1,9,co]],
outsum : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co),
argsL : [title = "on3regionview",xrange = [-5,5],yrange = [-5,5],terminal = png,
file_name = sconcat(figs_dir,"/","on3regionview"),
columns = 2,dimensions = [1000,500]],
c0show(progn,varl),
c0show(progn,FL),
c0show(progn,outsum),
c0show(progn,argsL),
on3regionview(FL,outsum,'argsL=argsL,swview),
return("block of on3regionview('ex)"),
print("--end of on3regionview('ex)--"),
return("--end of on3regionview('ex)--"),
block_main, /* main ブロック ====================================*/
c1show(progn,length(args),args),
argsc : args,
argsL : rhs(find_key(argsc,'argsL)),
c1show(progn,length(argsL),argsL),
args : args_flat(argsc),
c1show(progn,"S1",length(args),args),
if length(args) >=2 then ( /* 実質的必須の引数 */
FL : copylist(args[1]), /* on3ineq の入力不等式たち(2重リスト形式) */
outsum:args[2] ), /* on3ineq の結果(関数表現) */
c1show(progn,varl,FL,outsum),
/* 描画範囲と検査点数の初期値 */
rxrange : xrange=[-2,2], ryrange : yrange=[-2,2], nx:50, ny:50,
/* 引数から rxrange=[rxl,rxr], ryrange=[ryl,ryr] を設定する */
keyv : find_key(args,'xrange),
if keyv # false then ( rxrange : keyv, c1show(progn,rxrange) ),
keyv : find_key(args,'yrange),
if keyv # false then ( ryrange : keyv, c1show(progn,ryrange) ),
[xl, xr] : rhs(rxrange), [yl,yr] : rhs(ryrange),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3regionview-2d"),
columns=2, dimensions=[1000,500]],
keyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,argsL,keyL),
c1show(dlist),
c1show(progn,plotmode,viewmode),c1show(outsum),c1show(FL),
if outsum=0 then (cshow(progn,outsum,"---stop"),return()), /* ??? */
on3func:1, /* on3ineq の入力不等式たち(2重リスト形式) FL のon3関数化 */
for i thru length(FL) do
on3func:on3func*funmake(on3,[FL[i][1],FL[i][2],FL[i][3],FL[i][4]]),
c1show(on3func,listofvars(on3func)),
c1show(progn,on3func),
if plotmode=true then (
if length(listofvars(on3func))=2 then (
cshow(progn,"==2変数関数=="),
c1show(progn,dlist),
c1show(progn,argsL),
gd : on3dplot2(on3func,'argsL=argsL,'noview), /* 解領域を点で示す */
gout : on3gr2(outsum,'argsL=argsL,'noview), /* 解析解領域を関数で示す */
/* 注意: gd, gout は文字列で返される ー> eval_string */
c1show(gd), c1show(gout),
if true then (
/* dlist : draw() 関数の引数のリスト */
if stringp(gd) then gd:eval_string(gd),
if stringp(gout) then gout:eval_string(gout),
glist : [gd,gout],
c1show(progn,"call mk_draw:",dlist),
mk_draw(glist,dlist,swview) /* mk_draw 関数の呼び出し */
)
), /* end of if-then 2*/
if length(listofvars(on3func))=3 then (
/* gout : on3gr(out,xrange=[xl,xr],yrange=[yl,yr]), */
c1show(progn,"==3変数関数=="),
gout : on3gr(outsum),
c1show(gout),
if true then (
/* dlist : draw() 関数の引数のリスト */
glist:[gout],
dlist3 : [terminal='png, file_name=sconcat(figs_dir,"/","on3regionview-3d"),
columns=2, dimensions=[1000,1400]],
mk_draw(glist,dlist3,swview) /* mk_draw 関数の呼び出し */
)
) /* end of if-then 3 */
) /* end of if-plotmode */
)$ /* end of on3regionview */
/*#################################################################################*/
/*### va_unique : 内部使用 in on3ineq_backsolve() #####################################*/
/*#################################################################################*/
va_unique([args]) := block([progn:"<va_unique>",debug,L],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of va_unique('help)--
機能: 端点リストvaの要素実数に [x0,o],[x0,c],[x0,s] が存在するとき[x0,s]にする
文法: va_unique(va[i],...)
例示: va[1] :
[[0,o],[1,c],[1,o],[1,s],[2,o],[-sqrt(2),o],[sqrt(2),o],
[-(sqrt(5)-1)/2,o],[(sqrt(5)+1)/2,o]]
---> [1,c], [1,o] が除かれる by va[1]:va_unique(va[1])
va[1] =
[[0,o],[1,s],[2,o],[-sqrt(2),o],[sqrt(2),o],[-(sqrt(5)-1)/2,o],[(sqrt(5)+1)/2,o]]
メモ:
--end of realp('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of va_unique('ex)--"),
block([progn:"<va_unique_ex>",debug,va],
debug:ifargd(),
va[1] : [[0,o],[1,c],[1,o],[1,s],[2,o],[-sqrt(2),o],[sqrt(2),o],
[-(sqrt(5)-1)/2,o],[(sqrt(5)+1)/2,o]],
c0show(progn),c0show(va[1]),
cashow(va_unique(va[1])),
return("---end of va_unique_ex---")
), /* end of block */
print("--end of va_unique('ex) block--"),
return("--end of va_unique('ex)--"),
block_main, /* main ブロック ====================================*/
L : args[1],
if length(L) > 1 then for i thru length(L)-1 do (
for j:i+1 thru length(L) do (
if L[i][1]=L[j][1] then
if L[i][2]=s then L[j]:null
else if L[j][2]=s then (L[i][2]:s, L[j]:null)
else L[j]:null
) /* end of for-j */ ), /* end of for-i */
L: delete(null,L),
return(L)
)$
/*#################################################################################*/
/*### realp #######################################################################*/
/*#################################################################################*/
realp([args]) := block([progn:"<realp>",debug,exp, realonly_old,EPS:1.0E-7,in,tmp,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of realp('help)--
機能: expが実数のときTRUEを返し,複素数のときFALSEを,
変数を含むときunknownを返す. 虚数部の絶対値が微小のときは実数とみなす.
文法: realp(exp,...)
例示: realp(exp) -> true
メモ:
--end of realp('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of realp('ex)--"),
block([progn:"<realp_ex>",debug],
debug:ifargd(),
c0show(realp(1.0)),
c0show(realp(1.0+1.0E-10*%i), "/* 微小虚数を含む場合 */"),
c0show(realp(1.0+1.0E-6*%i), "/* 微小虚数を含む場合 */"),
c0show(realp(2*x+%i)),
c0show(realp([1.0,1.0+1.0E-10*%i,1.0+1.0E-6*%i,2*x+%i])),
c0show(freeof(unknown,false,realp([1.0,1.0+1.0E-10*%i]))),
c0show(freeof(unknown,false,realp([1.0,1.0+1.0E-6*%i,2*x+%i]))),
return("---end of realp_ex---")
), /* end of block */
print("--end of realp('ex)--"),
return("--end of realp('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
realonly_old:realonly, realonly:false, /* keepfloat:false, */
if listp(exp)=false then in:[exp] else in:exp, out:makelist(null,i,1,length(in)),
for i thru length(in) do (
if listofvars(in[i]) # [] then out[i]:'unknown
else (
tmp:in[i], tmp:ev(tmp,expand,infeval), tmp:float(tmp), tmp:rectform(tmp),
if freeof(%i,tmp) then out[i]:true
else if abs(imagpart(tmp))/cabs(tmp) < EPS then out[i]:true
else out[i]:false ) /* end of else */
), /* end of for-i */
realonly:realonly_old,
if listp(exp)=false then return(out[1]) else return(out)
)$
/*### on3ineq_backsolve ######################################################*/
/* <on3ineq_backsolve: 変数消去により等式解 va, 特異リスト vsing を求める(内部使用) */
/*############################################################################*/
/* maxima/5.17.1/share/contrib/solve_rat_ineq.mac を参照した */
on3ineq_backsolve(LF,[args]) := block([progn:"<on3ineq_backsolve>",debug,
kend,varlt:[],f,fl,fr,flr, z,y,ansz,zs,vnoend, swl,swr,wlr, tvars,tmp,
z0,z1,z2,z0num,z0den,z1num,z1den,z2num,z2den,
eqs,eqsend,weq,wweq,eqlr,eql,eqr,eqsing,c0,c1,c2,w,ans,
anslr,ansl,ansr,ansy,ds,ys,dl,dr,rnumlist],
debug:ifargd(),
kend:length(LF), weq:[],
swl:makelist(null,k,1,kend), swr:makelist(null,k,1,kend),
eql:makelist(null,k,1,kend),eqr:makelist(null,k,1,kend),
eqsing:makelist(null,k,1,kend),
for k thru length(LF) do (
f:LF[k][1],fl:LF[k][2],fr:LF[k][3], flr:LF[k][4],
varlt : endcons([listofvars(f),listofvars(fl),listofvars(fr)],varlt),
z0 : fullratsimp(f), z0den : denom(z0), z0num : num(z0),
z1 : fullratsimp(fl), z1den : denom(z1), z1num : num(z1),
z2 : fullratsimp(fr), z2den : denom(z2), z2num : num(z2),
eql[k] : z0num*z1den-z1num*z0den, /* 左境界面・線・点 */
eqr[k] : z0num*z2den-z2num*z0den, /* 右境界面・線・点 */
eqsing[k] : z0den*z1den*z2den, /* 特異面・線・点を一気に解く */
if fl=minf then eql[k]:null, if fr=inf then eqr[k]:null,
if flr=cc then (swl[k]:c, swr[k]:c)
else if flr=co then (swl[k]:c, swr[k]:o)
else if flr=oc then (swl[k]:o, swr[k]:c)
else if flr=oo then (swl[k]:o, swr[k]:o)
),
c1show(progn,"=== START on3bsolM ===",varl),
if atom(varl) then varl:unique(flatten(varlt)), vnoend:length(varl),
va : makelist([],i,1,vnoend), vsing:makelist([],i,1,vnoend),
vlist : makelist([],i,1,vnoend),
c1show(eql),c1show(eqr),c1show(eqsing), c1show(varl,vnoend),
/*** vsing : 特異面・線・点を一気に解く ***************************************/
c1show(eqsing),
for k thru kend do (
zs : flatten(algsys([eqsing[k]],[varl[vnoend]])), /* 特異線 */
zs : map('rhs,zs),
for i thru length(zs) do
if member(zs[i],%rnum_list) then zs[i]:null else zs[i]:[zs[i],s],
zs:delete(null,zs), zs : unique(zs),
zs : sublist(zs, 'lambda([u], freeof(minf,inf,u))), /* 除外 */
c2show("z(x,y) と 特異面"), c1show(k,zs),
vsing[vnoend]:append(vsing[vnoend],zs)
),
/* 第1変数まで繰り返し処理 */
if vnoend > 1 then for vno:vnoend-1 step -1 thru 1 do (
c1show("=== 繰り返し",vno,"==="),
if vno=1 then realonly:true else realonly:false,
/* z : varl[vno+1], y : varl[vno], */
for k thru kend do (
c1show("===",eqsing),
if [eqsing[k]]=[] or freeof(ev(y),eqsing[k]) then ys:[]
else ( /* 特異面，線，点の関数を求める */
c1show(eqsing[k]),
tvars:[], for i:vno thru vnoend do tvars:endcons(varl[i],tvars),
c1show(tvars),
tmp: algsys([eqsing[k]],tvars),c1show(tmp), /* call algsys */
tmp:flatten(tmp),
ys:[],
for i thru length(tmp) do
if lhs(tmp[i])=ev(varl[vno]) and constantp(rhs(tmp[i]))
and freeof(%i,rhs(tmp[i])) then ys:endcons(rhs(tmp[i]),ys),
for i thru length(ys) do ys[i]:[ys[i],s]
), c1show(ys),
if vno=1 and length(ys) > 1 then ansy:msort(ys,1), /* call msort */
vsing[vno]:append(vsing[vno],ys)
) /* end of for-k */
), /* end of for-vno ----------------------------------------*/
c1show(vsing),
/*** end of vsing *****************************************************/
eqs:[],
for k thru kend do eqs:append(eqs,[[eql[k],swl[k]],[eqr[k],swr[k]]]), /* 方程式の合併 */
eqsend:length(eqs), c1show("===",eqsend,reveal(eqs,10)),
/* 最終変数 z について解く */
if vnoend=1 then realonly:true else realonly:false,
for k thru eqsend do (
if eqs[k][1]=null then ans:[] else ( /* call algsys */
if errcatch( ans:algsys([eqs[k][1]],[varl[vnoend]]), return)=[]
then ( cshow("== Error in backsolve =="),
cshow("参考:",polydeg(eqs[k][1])), quit() )
else ans ,
ans : flatten(ans), c1show(k,ans), ans : map('rhs,ans),
for i thru length(ans) do
if member(ans[i],%rnum_list) then ans[i]:null else ans[i]:[ans[i],eqs[k][2]],
ans:delete(null,ans)
),c1show(varl[vnoend],ans),
va[vnoend]:append(va[vnoend],ans)
), /* end of for-k */
c1show("Z-",va[vnoend]),
/*========================================================================*/
/* 第1変数まで繰り返し処理 (for vno) */
if vnoend > 1 then for vno:vnoend-1 step -1 thru 1 do ( /* begin for-vno */
c1show("=== 繰り返し",vno,"==="),
if vno=1 then realonly:true else realonly:false,
/* 交点 */
weq : copylist(eqs),
for k thru length(weq) do
if freeof(minf,inf,weq[k][1])=false or weq[k][1]=null then weq[k]:null,
weq:delete(null,weq), eqsend:length(weq),
c1show(weq),
if length(weq) > 1 then for k1 thru length(weq)-1 do ( /* begin for-k1 */
for k2:k1+1 thru length(weq) do ( /* begin of for-k2 */
c1show(weq[k1],weq[k2],varl[vno+1]),
[ans,wweq]:elimalg1([weq[k1][1],weq[k2][1]],varl[vno+1],varl[vno]), /* elimalg1 */
c1show(k1,k2,ans),c1show(wweq),
if weq[k1][2]=c and weq[k2][2]=c then wlr:c else wlr:o,
ans : map('rhs,ans), c1show(ans),
for i thru length(ans) do if member(ans[i],%rnum_list)
then ans[i]:null else ans[i]:[ans[i],wlr],
ans:delete(null,ans),
va[vno]:append(va[vno],ans)
) /* end of for-k2 */
), /* end of for-k1 */
c1show("k1,k2-end ",eqs,z),
/* 零点 */
for k thru eqsend do ( /* 不等式の個数 */
c1show("S--",vno,k,eqs[k]),
[ans,weq]:elimalg1([eqs[k][1]],varl[vno+1],varl[vno]), /* call elimalg1 */
c1show(k,ans),c1show(weq),
ans : map('rhs,ans), c1show(ans),
for i thru length(ans) do if member(ans[i],%rnum_list)
then ans[i]:null else ans[i]:[ans[i],eqs[k][2]],
ans:delete(null,ans),
eqs[k]:flatten([weq,[eqs[k][2]]]),
va[vno]:append(va[vno],ans)
), /* end of for-k */
c1show(vno,va)
), /* end of for-vno ----------------------------------------*/
realonly:false, c1show(va),
/*=== 後処理 ====================================*/
for vno thru vnoend do
(va[vno]:append(va[vno],vsing[vno]), va[vno]:unique(va[vno]) ),
c1show(progn,"===end of on3bsolM ==="),
on3floatnump:false,
for i thru length(va[1]) do if floatnump(va[1][i][1]) then on3floatnump:true,
c1show(on3floatnump),
if on3floatnump=true then for i thru length(va[1]) do va[1][i][2]:o,
/* 重複処理 va_unique */
/* va[1] =
[[0,o],[1,c],[1,o],[1,s],[2,o],[-sqrt(2),o],[sqrt(2),o],
[-(sqrt(5)-1)/2,o],[(sqrt(5)+1)/2,o]]
---> [1,c], [1,o] が除かれる
va[1] =
[[0,o],[1,s],[2,o],[-sqrt(2),o],[sqrt(2),o],[-(sqrt(5)-1)/2,o],[(sqrt(5)+1)/2,o]]
*/
if true then for vno thru vnoend do va[vno]:va_unique(va[vno]), /* call va_unique */
for vno thru vnoend do (
for i thru length(va[vno]) do
if member(va[vno][i][1],[minf,inf]) then va[vno][i]:null,
va[vno]:delete(null,va[vno]) ), /* end of for-vno */
/*** add 2010-08-15 ***/
for i thru length(va[1]) do
if constantp(va[1][i][1]) = false or realp(va[1][i][1])=false then va[1][i]:null,
va[1]:delete(null,va[1]),
c1show(va),c1show(vsing),
/* add 2010-09-09 */
c1show("P3:y=%i*(x-x0)+y0 - > [x=x0,y=y0] の処理 <--"),
for i:1 thru vnoend do (
c1show(i,va[i]),
for j thru length(va[i]) do (
w:va[i][j][1], c0:listofvars(w), c1:length(c0),
if c1 > 0 then c2:hipow(w,c0[1]) else c2:-1,
c1show(c0,c1,c2),
if freeof(%i,w)=false and polynomialp(w,c0) and c1=1 and hipow(w,c0[1])=1
then (
c1show("---complex---",w),
ansi:algsys([imagpart(w)],c0)[1][1],
ansr:realpart(w), c1show("--->",ansi,ansr),
if lhs(ansi)=varl[i-1] then va[i-1]:endcons([rhs(ansi),va[i][j][2]],va[i-1]),
va[i][j]:[ansr,va[i][j][2]]
) /* end of then */
) /* end of for-j */
), /* end of for-i */
for i thru vnoend do va[i]:unique(va[i]),
/* add 2010-11-06 */
for vno thru vnoend do (
for i thru length(va[vno]) do if realp(va[vno][i][1])=false then va[vno][i]:null,
va[vno]:delete(null,va[vno])
),
c1show("R-",reveal(va,10)), c1show("R-",vsing), c1show(va[1]), c1show(float(va[1])),
return([va,vsing])
)$ /* end of on3ineq_backsolve() */
/*#################################################################################*/
/*### elimalg1: eqs から変数evarを消去し変数aval についての解ansと消去式eqsを返す ####*/
/*#################################################################################*/
elimalg1([args]) := block([progn:"<elimalg1>",debug,
eqs,evar,avar, weq,weq1,dd,wgcd,add,ans],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of elimalg1('help)--
機能: eqs から変数evarを消去し変数aval についての解ansと消去式eqsを返す
文法: elimalg1(eqs,evar,avar,...)
例示:
メモ:
--end of elimalg1('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of elimalg1('ex)--"),
elimalg1_ex(),
/*
block([progn:"<elimalg1_ex>",debug],
return("---end of elimalg1_ex---")
), /* end of block */
*/
print("--end of elimalg1('ex)--"),
return("--end of elimalg1('ex)--"),
block_main, /* main ブロック ====================================*/
eqs : args[1], evar : args[2], avar : args[3],
c1show("In elimalg1:",eqs,evar,avar),
if listp(eqs)=false then weq:[eqs] else weq:copylist(eqs),
c1show(length(weq),weq),
if length(weq)=1 then ( dd:diff(weq[1],evar), weq:flatten([weq[1],dd]) ),
c1show("-elimalg1-",weq),
wgcd:gcd(weq[1],weq[2]),
if wgcd # 1 and length(listofvars(wgcd)) > 0 then (
c1show("=elmalg1:case of wgcd # 1="),
weq:fullratsimp(weq/wgcd), c1show("-elimalg1-",wgcd,weq),
weq1:eliminate(weq,[evar]), c1show(weq1),
if errcatch( ans:algsys(weq1,[avar]), return )=[]
then (cshow("== Error in algsys ipolydegn elimalg1 -> return ans:[] =="), ans:[])
else ans,
if member(evar,listofvars(wgcd))=false then (
if errcatch( add:algsys([wgcd],[avar]), return )=[]
then (cshow("== Error in algsys(add) in elmalg1 -> reurn add:[] =="),add:[],
cshow(wgcd,evar) )
else add,
ans:append(ans,add)
) /* end of if-member-false */
) /* end of wgcd # 1 */
else (
weq1:eliminate(weq,[evar]),
if errcatch( ans:algsys(weq1,[avar]), return )=[]
then ( cshow("== Error in algsys in elimalg1 (wgcd=1) -> return ans:[] =="),ans:[])
else ans
), /* end of else */
ans:flatten(ans), c1show("-elimalg1-",ans,weq1),
return([ans,weq1])
)$
/*--- elimalg1_ex ------------------------------------------------------------------*/
elimalg1_ex([args]) := block([progn:"<elimalg1_ex>",debug,eR30,Lex,eq,
ansz,ansy,eqy,ansx,eqx],
debug:ifargd(),
eR30 : ((x-1)^2+(y-2)^2+(z-3)^2)*(x^2+y^2+z^2-1),
Lex : [eR30],
for eq in Lex do (
print("---例--- eq :",eq),
cshow(eq:expand(eq)),
display(polydeg(eq)),
print("ansz:algsys([eq],[z] ->"),
ansz:algsys([eq],[z]),
display(ansz),
print("[ansy,eqy]:elimalg1(eq,z,y) ->"),
display([ansy,eqy]:elimalg1(eq,z,y)),
print("[ansx,eqx]:elimalg1(eqy,y,x) ->"),
display([ansx,eqx]:elimalg1(eqy,y,x))
),
return("---end of elimalg1_ex---")
)$
/*#############################################################################*/
/*### chk2D : exp内の sqrt(f(x))部において f(x)<0 の判定を行う ##################*/
/*#############################################################################*/
chk2D([args]) := block([progn:"<chk2D>",debug,exp, out:[],st,stw,varl,c,D,neg],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of chk2D('help)--
機能: exp内の sqrt(f(x))部において f(x)<0 の判定を行う
文法: chk2D(exp,...)
例示:
メモ:
--end of chk2D('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of chk2D('ex)--"),
/* chk2D_ex(), */
block([progn:"<chk2D_ex>",debug],
c0show(chk2D(x+sqrt(-x^2+4*x-8))),
c0show(chk2D(x+sqrt(-x^2+4*x-8) + sqrt(t-2))),
c0show(chk2D(x+sqrt(-x^2))),
return("---end of chk2D_ex---")
), /* end of block */
print("--end of chk2D('ex)--"),
return("--end of chk2D('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
out:scanmap(lambda([u], if atom(u) = false then u:cons(op(u),args(u)) else u),exp),
c1show("S1:完全リスト:",out),
out:scanmap(lambda([u],
if listp(u) and first(u)=sqrt and listp(u[2]) then [u[1],l2f(u[2])] else u),out),
c1show("S2:",out),
st:[],
scanmap(lambda([u], if listp(u) and u[1]=sqrt and length(listofvars(u[2]))=1
and polynomialp(u[2],listofvars(u[2])) and hipow(u[2],listofvars(u[2])[1])=2
then (st:endcons(u[2],st)) else u ), out),
c1show("S3:",st),
if length(st)=0 then (neg:false, return(neg)),
for i thru length(st) do (
stw:st[i], varl:listofvars(stw), varnoend:length(varl),
c:[], for j:0 thru 2 do c:endcons(coeff(stw,varl[1],j),c), D:c[2]^2-4*c[1]*c[3],
if c[3] < 0 and D < 0 then neg:true else neg:false,
c1show(neg)
), /* end of for-i */
return(neg)
)$
/*** ex : x+sqrt(-x^2+4*x-8); ex : ex + sqrt(t-2); chk2D(ex); ***/
/*############################################################################*/
/*### polydeg 多変数多項式の変数毎の次数リストを返す ###########################*/
/*############################################################################*/
polydeg([args]) := block([progn:"<polydeg>",debug,exp, f,varl,vnoend,vorder,volist],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of polydeg('help)--
機能: 多変数多項式の変数毎の次数リストを返す
文法: polydeg(exp,...)
例示: polydeg(x^2+4*x-8)); -> [[x],[[2,1]]]
polydeg(expand((x^2+4*x-8)*(y-1)^3)); -> [[x,y],[[2,1],[3,2,1]]]
メモ:
--end of polydeg('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of polydeg('ex)--"),
/* polydeg_ex(), */
block([progn:"<polydeg_ex>",debug],
c0show(polydeg(x^2+4*x-8)),
c0show(polydeg(expand((x^2+4*x-8)*(y-1)^3))),
return("---end of polydeg_ex---")
), /* end of block */
print("--end of polydeg('ex)--"),
return("--end of polydeg('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
f:expand(exp), varl:listofvars(f), vnoend:length(varl),
vorder:makelist(null,vno,1,vnoend),
if polynomialp(f,varl)= false then (cshow("Not Polynomial Expression"),return([])),
for vno thru vnoend do vorder[vno]:hipow(f,varl[vno]), c1show(varl,vorder),
volist:makelist([],vno,1,vnoend),
for vno thru vnoend do (
if vorder[vno] > 0 then for j:vorder[vno] step -1 thru 1 do (
if coeff(f,ev(varl[vno])^j) # 0 then volist[vno]:endcons(j,volist[vno])
) /* end of for-j */
), /* end of for-vno */
c1show(volist),
return([varl,volist])
)$
/*### on3ineq_fwd ##########################################################*/
/* <on3ineq_fwd>: 結果のon3式を構成する */
/*############################################################################*/
on3ineq_fwd(varl,va,vlist,vsing,[args]) := block([progn:"<on3ineq_fwd>",
debug, ff,fl,fr,flr, tmp,tmp1,sind,soind,cind,vl,vr,vm, vno,pno,
fvlist, fvm,svm, tlist,tlist1,tv,tvlist,tvrlist,tvf,tvflist, tind1,
swl,swr,swlr,vlr,lr, bind, sno,snop1, swlr0,LLS],
/* 共通変数: varl, vnoend, va */
/*** Memo ***************************************************************
cind : [[1],[2],[3]] -> [[1,1],[1,2],[1,3],[2],[3]]
-> [[1,1,1],[1,1,2],[1,2],[1,3],[2],[3]]
-> [[1,1,2],[1,2],[1,3],[2],[3]] ->...-> []
cind の初期リストは第１変数 x の端点番号リストを用いる (<- xlist より)
cind[i][j]=[1,3] : 第1変数の端点番号が1，第2変数の端点番号が3であることを示す
length(cind[1]) : 変数番号( [1,3] のとき第2変数を示す)
restlr : [rxl,rxr] : 第１変数制限値
va : [[x1,x2,...,x5],[y1(x),...y6(x)],[z1(x,y),...,z4(x,y)]]
-> [[x1,..,x5,rxl,rxr],[y1(x),..,y6(x),ryl,ryr],[z1(x,y),...,z4(x,y),rzl,rzr]]
vxlist[1] : [rxl,x3,x4,rxr], <- x1<x2<rxl<x3<x4<rxr<x5
vxlist[2] : [ryl,y5(xm),y2(xm),ryr] <-- 制限値，複素数値を除いてソート(xmは中間値)
soind : [[6,3,4,7],[7,5,2,8]] <- vlist の va での位置番号を記憶する
(2,1)要素値 7 は値ryl はvans[2]での第7関数であることを示し，
(2,2)要素値 5 は値y5(xm)はvans[2]での第5関数であることを示す．
cind[1]=[2,3] のとき 領域 [[x3,x4],[y5(xm),ryl]] を示す
vl:[xl,yl,zl], vr:[xr,yr,zr], vm[xm,ym,zm]
: 端点リスト vlist に基づく区間の下限，上限，中間点の値
vlr:[xlr,ylr,zlr] : 端点での開閉
************************************************************************** */
debug:ifargd(), LLS:[],
c1show("on3ineq_fwd: 素領域の生成(時間がかかる)"),
/* floateval:true,*/
fL:f2l_one(on3f), c1show(fL), /* ff:fL[2], fl:fL[3], fr:fL[4], flr:fL[5],*/
/**** DEBUG:領域制限(第１変数のみ有効) *****/
vmdiv:2, /* [-4,-3] or [-2,-8/10], */
if listp(restlr)=false then restlr:[minf,inf],
va[1]:endcons([restlr[1],o],va[1]), va[1]:endcons([restlr[2],o],va[1]),
if vnoend > 1 then for vno:2 thru vnoend do (
va[vno]:endcons([minf,o],va[vno]), va[vno]:endcons([inf,o],va[vno])
),
vlist:makelist([],i,1,length(va)), vlist[1]:copylist(va[1]),
/* vlist[1] の生成とソート */
tmp : copylist(vlist[1]), c1show(tmp),
for i thru length(tmp) do
if (tmp[i][1]<restlr[1]) or (tmp[i][1]>restlr[2]) then tmp[i][1]:inf+1,
sind:msort(tmp,1), c2show(sind),
tmp1 : makelist(null,i,1,length(sind)),
for i thru length(sind) do tmp1[i]:tmp[sind[i]],
c1show(tmp1),
vlist[1]:tmp1,
c1show("領域制限:",vlist[1]), /* ??? */
soind : makelist([],i,1,vnoend),
soind[1]:copylist(sind), c2show(soind),
cind : makelist([i],i,1,length(vlist[1])), /*第１変数 x の端点番号リストを初期値とする*/
vl : makelist(null,i,1,vnoend), vr : copylist(vl), vm : copylist(vl),
c1show(soind), c2show(cind),
tlist:[],
c1show("===before loop===",vlist),
block(loop, /*======= begin of block-loop ==========================*/
c1show("--- S2-1: begin loop : 端点リストの構成---"),
vno : length(cind[1]), /* 変数番号 */
pno : cind[1][vno], /* 端点位置番号 */
/*--- 第1変数の端点リスト tlist=vlist[1] から各区間の中間点を求め，各中間点における
第2変数の端点リスト tlist1=vlist[2] を生成する．
ここで，vlist[2] は 第１変数の区間 [vlist[1][p],vlist[1][p+1]] に依存する．
これを制御添字リスト first(cind) に [p,1] として追加する．
[p,1] : 第1変数に関して第p区間，第2変数に関して第1区間を表す．
上記の操作を最終変数に到るまで繰り返す．
---*/
c1show("S2-1a:",vno,pno),
tlist : copylist(vlist[vno]), c2show(vlist),
if pno = length(tlist) then (c1show(va,outsum), return(outsum)), /* block から抜ける */
d2show(cind,vno,pno,va,tlist),
vl[vno] : tlist[pno][1], vr[vno] : tlist[pno+1][1], vm[vno] : tlist[pno][1],
vm[vno] : vl[vno]+(vr[vno]-vl[vno])/vmdiv, /* 中間点 */
if vl[vno]=minf and vr[vno]=inf then vm[vno]:1/3
else if vl[vno]=minf then vm[vno]:vr[vno]-1
else if vr[vno]=inf then vm[vno]:vl[vno]+1,
/*** if floateval=true then vm:float(vm) else vm:fullratsimp(vm), ***/
if vno=vnoend then (c1show(vm),c1show(vl),c1show(vr),c2show(vlist) ),
if vno < vnoend then (
tvrlist : [], tvflist:[],
for j thru length(va[vno+1]) do (
c2show("---pre-s:",vlist),
tv:va[vno+1][j][1], c2show("fwd:",tv),
/* vlist[1]からvlst[vno]より中間点を求め関数vans[vno+1]の中間点での値評価 */
/* tvf, tvflist : Float型, tv, tvlist : 非Float型 */
for k thru vno do tv:ev(tv,varl[k]=ev(vm[k]),expand,infeval), /* caution ******/
c2show(j,float(tv)),
/* va[vno+1] から複素数値 および 制限値を越える関数を除く */
if realp(tv) then (tvf:realpart(float(tv)) ) else tvf:false,
if tvf # false then
( tvflist:endcons([tvf,va[vno+1][j][2]],tvflist),
tvrlist:endcons([tv,va[vno+1][j][2]],tvrlist),
c1show("---inc",vno,"->",vno+1,j,tvf)
) else (tvflist:endcons([inf+1,va[vno+1][j][2]],tvflist),
tvrlist:endcons([inf+1,va[vno+1][j][2]],tvrlist) )
), /* end of for-j */
c2show(tvflist),
sind:msort(tvflist,1), /* call msort */
tlist1:makelist([],i,1,length(sind)),
for k1 thru length(sind) do tlist1[k1]:tvrlist[sind[k1]],
c2show(tlist1),c1show("昇順関数番号(va[vno+1]):",sind),
soind[vno+1]:sind,
c1show(soind), c2show(tlist1),
c2show("---pre1---",vlist),
vlist[vno+1]:copylist(tlist1),
c2show(vlist,"<- S2-1:更新vlist"),
tind1 : makelist(append(first(cind),[i]),i,1,length(tlist1)-1),
d2show(tind1),
cind : append(tind1,rest(cind,1))
), /* end of vno-then */
if vno < vnoend then (c2show("repeat"),go(loop)), /* ラベル loop に戻る */
/*=== cind に基づき領域構成を行う ==================================*/
fvlist:realpart(float(vlist)),
c1show(cind,"<- S2-1:cind,vlistの更新結果"),c1show("->",fvlist),
for kk:1 thru length(sind)-1 do (
c1show("===",kk,"==="),
swl : makelist(null,vno,1,vnoend), swr : makelist(null,vno,1,vnoend),
swlr : makelist(null,vno,1,vnoend), vlr : makelist(null,vno,1,vnoend),
lr : makelist(null,vno,1,vnoend),
for vno thru vnoend do (
pno:cind[1][vno], sno:soind[vno][pno], snop1:soind[vno][pno+1],
c2show(pno,sno,snop1),
swl[vno]:va[vno][sno][2], lr[vno]:swl[vno],
swr[vno]:va[vno][snop1][2],
c2show("--->",swl[vno],swr[vno],swlr[vno]),
if member(swl[vno],[o,s]) and member(swr[vno],[o,s]) then swlr[vno]:oo
else if member(swl[vno],[o,s]) and swr[vno]=c then swlr[vno]:oc
else if swl[vno]=c and member(swr[vno],[o,s]) then swlr[vno]:co
else if swl[vno]=c and swr[vno]=c then swlr[vno]:cc,
swlr0:copylist(swlr),
if vno < vnoend then swlr0[vno]:oo, /******************* CHANGE *********/
vlr[vno]:['va[vno][sno], 'va[vno][snop1],swlr0[vno]]
), /* end of for-vno */
c1show(vlr),
/* 中間点の値を求める */
vm:makelist(null,vno,1,vnoend), vl:makelist(null,vno,1,vnoend),
vr:makelist(null,vno,1,vnoend),
for vno thru vnoend do ( /* minf inf の処理 ? */
pno:cind[1][vno],
vl[vno] : vlist[vno][pno][1],
vr[vno] : vlist[vno][pno+1][1],
vm[vno] : vl[vno]+(vr[vno]-vl[vno])/vmdiv, /* 中間点 */
if vl[vno]=minf and vr[vno]=inf then vm[vno]:1/3
else if vl[vno]=minf then vm[vno]:vr[vno]-1
else if vr[vno]=inf then vm[vno]:vl[vno]+1
), /* end of for-vno */
/* if floateval=true then vm:float(vm) else vm:fullratsimp(vm), /* 重要 RAT */ */
if member(false,map(realp,vm))=true then (c1show(vm),quit()),
fvm:map(mkfloat,vm),
c1show(fvm),c2show(vm,fvm,on3f),
pno:cind[1][vnoend],c2show(fvlist[vnoend][pno],fvlist[vnoend][pno+1]),
c1show("before svm",on3f),
svm:on3f, for vno thru vnoend do fvm[vno]:varl[vno]=float(fvm[vno]),
c1show(svm,fvm),c1show(ev(svm,fvm)),
/* ERROR in this point in
on3ineq([(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co],debug2);*/
svm : ev(svm,fvm), if svm < 1.e-3 then svm:0 else svm:1,
c1show("中間点評価 --->",svm),
if svm=1 then /* 中間点での評価で解領域の輪郭を得る -> LL に追加する */
( LL:endcons(vlr,LL), c1show("***",length(LL),"->",last(LL)),
c1show(LL) ), /* end of svm=1 */
if svm=0 and swl[vnoend]=c then ( /* fl <= f(x,y) <= fl への対応 */
vlr[vnoend]:['va[vnoend][sno], 'va[vnoend][sno],cc],
LLS : endcons(vlr,LLS) ),
cind : rest(cind,1), c1show(cind) /* cindの更新 */
), /* end of for-kk ========================================= */
if length(cind[1]) < vnoend then go(loop),
c2show(LL), c2show(va), c2show("end of block")
), /*====== end of block loop ==========================================*/
if length(LL)=0 then LL:copylist(LLS), /* fl <= f(x,y) <= fl への対応 */
c1show("S2 の結果 ->"), c1show(LL), c1show(LLS),
return(LL)
)$
/*############################################################################*/
/*### msort : データ位置(昇順順位位置)を返す ###################################*/
/*############################################################################*/
msort([args]):=block([progn:"<msort>",debug,M, rows,cols,col,w,ws,sw,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of msort('help)--
機能: データ位置(昇順順位位置)を返す
文法: msort(M,{col},...)
例示:
v : [30,inf,10,-sqrt(2),1+2*%i,10,1,minf],
M : [[30,c],[inf,o],[10,c],[-sqrt(2),o],[2*%i+1,o],[10,o],[1,o],[minf,o]],
M2: [[x,c],[x-sqrt(2),o],[x+sqrt(2),c],[x-1,c]],
msort(v) = [8,4,7,3,6,1,2],
msort(M,1) = [8,4,7,3,6,1,2],
msort(M2,1) = [2,4,1,3],
メモ:
--end of msort('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of msort('ex)--"),
msort_ex(),
/*
block([progn:"<msort_ex>",debug],
c0show(msort(x^2+4*x-8)),
c0show(msort(expand((x^2+4*x-8)*(y-1)^3))),
return("---end of msort_ex---")
), /* end of block */
*/
print("--end of msort('ex)--"),
return("--end of msort('ex)--"),
block_main, /* main ブロック ====================================*/
M : args[1],
if length(M) = 0 then return(M),
for i thru length(args) do if numberp(args[i]) then col:args[i],
rows:length(M),if listp(M[1]) then cols:length(M[1]),
w:makelist(null,i,1,rows),
if listp(M[1]) then (for i thru rows do w[i]:M[i][col])
else (for i thru rows do w[i]:M[i]),
for i thru length(w) do if freeof(%i,null,w[i]) = false then w[i]:1+inf,
c1show(w),
ws:sort(w,"<"),ws:delete(1+inf,ws),
c1show(ws),out:makelist(null,i,1,length(ws)),
for i thru length(ws) do
(sw:0,
for j thru length(w) do
if ws[i] = w[j] and sw = 0 then (out[i]:j,w[j]:null,sw:1),
c2show(i,wout)),c2show("昇順位位置:",out),
c2show("注:非数(null)，複素数は除外し，inf+1 とする"),
return(out)
)$ /* end of msort() */
/*====== msort_ex() =========================================================*/
msort_ex() := block([progn:"<msort_ex>",v,M,M1,ansv,ansM,ansM2,out],
v : [30,inf,10,-sqrt(2),1+2*%i,10,1,minf],
M : [[30,c],[inf,o],[10,c],[-sqrt(2),o],[2*%i+1,o],[10,o],[1,o],[minf,o]],
M2: [[x,c],[x-sqrt(2),o],[x+sqrt(2),c],[x-1,c]],
ansv : [8,4,7,3,6,1,2],
ansM : [8,4,7,3,6,1,2],
ansM2 : [2,4,1,3],
print("msort_ex: データ位置(昇順順位位置)を返す"),
print(" 例1 : msort(v) "), print(" データ v： ", v), out : msort(v),
chkshow("msort(v)",out,ansv),
print(" 例2 : msort(M,1)"), print("データ M: ",M), out : msort(M,1),
chkshow("msort(M,1)",out,ansM),
print(" 例3 : msort(M2,1)"), print("データ M2: ",M2), out : msort(M2,1),
chkshow("msort(M2,1)",out,ansM2),
return("---end of msort_ex---")
)$ /* end of msort_ex() */
/*############################################################################*/
/*### gcd2l: L=[f1(x),f2(x),...] から Lout:[GCD,[f1/GCD,f2/GCD]] を返す ########*/
/*############################################################################*/
gcd2l([args]) := block([progn:"<gcd2l>",debug,L, wgcd,Lout],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of gcl2L('help)--
機能: リスト L=[f1(x),f2(x),...] から Lout:[GCD,[f1/GCD,f2/GCD]] を返す
文法: gcl2L(L,...)
例示: gcd2l([a*b*c,b*c*d,c*a*b]); -> [b*c,[a,d,a]]
メモ:
--end of gcl2L('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of gcl2L('ex)--"),
/* gcl2L_ex(), */
block([progn:"<gcl2L_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of gcl2L_ex---")
), /* end of block */
print("--end of gcl2L('ex)--"),
return("--end of gcl2L('ex)--"),
block_main, /* main ブロック ====================================*/
L : args[1],
if listp(L)=false or length(L) = 1 then return(Lout:[0,[0]]),
wgcd:L[1], for i:2 thru length(L) do wgcd:gcd(wgcd,L[i]),
Lout:[wgcd,L/wgcd],
return(Lout)
)$ /* end of gcd2l() */
/*### on3ineq_shrink #########################################################*/
/* <on3ineq_shrink> : 解領域の輪郭の開閉を処理する (in on3ineq()) */
/*############################################################################*/
on3ineq_shrink([args]) := block([progn:"<on3ineq_shrink>",debug,
outlineforce:false, vno,vnom1,ix, LXL,LYH,LXmid,LYLR0,LYLR,LTAB,xmid,tmp],
debug:ifargd(),
/* LERR:[], */
if vnoend=1 then (
tmp:flatten(LL), d2show(tmp),
for i thru length(va[1]) do
if va[1][i][2]=c and member('va[1][i],tmp)=false then (
add : ['va[1][i],'va[1][i],cc],
LL : endcons([add],LL),
c1show("--->孤立点追加",add) ), /* end of if-then */
return(LL)
),
outlineforce:false,
c1show("=== Start shrink:",outlineforce),
for vno:vnoend step -1 thru 2 do (
if outlineforce # true then (
vnom1:vno-1,
c1show("###########################################"),
c1show("### 開閉処理: 変数",vno,"--->",vnom1),
c1show("###########################################"),
/* LYLR0 = [ [[i,'R],LL[i][vno]], ... ] <- 検索点:",'va[vnom1][ix] をもつLLの項 */
/* LXL = [ ['V[1],'V[2],...,'V[vnom1-1]], ['V[1],'V[2],...,'V[vnom1-1]],... ]
'V[i] = [[vl,llr], [vr,rlr]]
<- 検索点:",'va[vnom1][ix] をもつLLの項の 第(vnom1-1)変数までの領域 */
/* LYH も必要?-> 必要無し!! ***********************************/
for ix thru length(va[vnom1]) do (
if outlineforce # true and va[vnom1][ix][2] # 's then (
c1show("===start=== 検索点:",'va[vnom1][ix]),c1show(va[vnom1][ix]),
/* 1次解から端点 x[ix] を含むyの領域に現れる端点y[j]を見出す */
LXL:[],LYH:[],LYLR0:[],
for i thru length(LL) do (
if LL[i][vnom1][1]='va[vnom1][ix] or LL[i][vnom1][2]='va[vnom1][ix] then (
LXL:endcons(rest(LL[i],-(vnoend-vnom1+1)), LXL),
LYH:endcons(rest(LL[i],vno), LYH) ),
if LL[i][vnom1][1]='va[vnom1][ix]
then LYLR0:endcons([[i,'R],LL[i][vno]],LYLR0),
if LL[i][vnom1][2]='va[vnom1][ix]
then LYLR0:endcons([[i,'L],LL[i][vno]],LYLR0)
), /* end of for-i */
if length(LYLR0) # 0 and freeof(minf,inf,va[vnom1][ix][1])=true
and outlineforce # true then (
LXL : unique(LXL), LYH : unique(LYH),
c1show(LYLR0), c1show(LXL,length(LXL)),
if LXL # [[]] then for i thru length(LXL) do (
LXmid:[], c2show(LXL[i]),
for j thru length(LXL[i]) do (
xl : ev(LXL[i][j][1],nouns)[1], xr:ev(LXL[i][j][2],nouns)[1],
if xl=minf and xr=inf then xmid:0
else if xl=minf then xmid : xr-1
else if xr=inf then xmid:xl+1 else xmid:(xl+xr)/2,
if j > 1 then xmid:ev(xmid, LXmid), c2show("->",LXmid),
if numberp(xmid)=false then xmid:float(xmid), /*************/
LXmid : endcons(varl[j]=xmid, LXmid)
), /* end of for-j */
c1show("-->",LXmid),
LYLR:copylist(LYLR0),
for k thru length(LYLR0) do (
c2show(rest(LL[LYLR0[j][1][1]],-(vnoend-vnom1+1)),LXL[i]),
if rest(LL[LYLR0[k][1][1]],-(vnoend-vnom1+1)) # LXL[i]
then LYLR[k]:null
),
LYLR:delete(null,LYLR),
c1show(i,LXL[i]),c1show("->",LXmid),c1show("->",LYLR),
shrink10(LYLR,'debug0) /*** call shrink ***/
), /* end of for-i */
if LXL = [[]] then (
c2show("case of LXL=[[]]"),
LXmid:[[]], LYLR:copylist(LYLR0),
c2show(LXL),c1show("->",LXmid),c1show("->",LYLR),
shrink10(LYLR,'debug0) /*** call shrink ***/
),
if outlineforce # true then c2show("更新",LL)
) /* end of if */
) /* end of outlineforce # true <2> */
), /* end of for-ix */
c2show(vno,LL)
) /* end of outlineforce # true <1> */
), /* end of for-vno */
return(LL)
)$ /* end of on3ineq_shrink() */
/*### shrink10 ########################################################################*/
/* y(x) から x=x_i での開閉を決める */
/*#####################################################################################*/
shrink10(LYLR,[args]) := block([progn:"<shrink10>",debug, ratprint:false, xvnoreal,
xeps,xv,xvm,xvp, yeps,yv,yvm,yvp,pointerror,lyepsk,yepsk,
LY,yvalue,S,SS,pend,Pco,LTAB,ii,sp,js,je],
/* use: flrlimit, floatfix, mkfloat, realp */
debug:ifargd(),
if outlineonly=true then return([]),
c1show("== Start shrink10 =="),
/**** LY:[['va[2][4],[y(x-),Pno,lr],[y(x+),Pno,lr]],...] の作成 ***/
LY:[],
for i thru length(LYLR) do (LY:endcons(LYLR[i][2][1],LY),LY:endcons(LYLR[i][2][2],LY) ),
LY:unique(LY), c2show(LY),
/* xv=va[vnom1][ix][1] におけるy(x)の左極限値,右極限値を調べる */
lyepsk:[],
for i thru length(LY) do (
yv:ev(LY[i],nouns)[1], xv:va[vnom1][ix][1], c2show(i,xv,yv),
if LXmid # [[]] then (xv:ev(xv,LXmid),yv:ev(yv,LXmid)),
xvnoreal:false,
if realp(xv)=false then (
cshow("E0: 検索点xの評価に失敗した"),
cshow(" ",va[vnom1][ix][1]),
cshow(" -> xvnoreal:true として処理を続行する"),
xvnoreal:true,
return(LTAB)
),
c2show(i,xv,yv,varl[vnom1]), /********/
[yvm,yvp,yepsk] : flrlimit(yv,ev(varl[vnom1]),xv), /*** call flrlimit 左右極限値 ***/
lyepsk:endcons(yepsk,lyepsk), c2show(xv,yvm,yvp),
if yv=minf or yv=inf then (yvm:yv,yvp:yv),
c1show("->",i,mkfloat(xv),yvm,yvp,yepsk),
LY[i]:[LY[i],[float(yvm)],[float(yvp)]]
), /* end of for-i */
if xvnoreal=true then return(LTAB),
lyepsk:delete(null,lyepsk),
if lyepsk=[] then yepsk:1.0E-5 else yepsk:last(sort(lyepsk,"<")),
if false then yepsk:yepsk*100,
c1show(lyepsk,"->",yepsk),
c2show("S1:",LY),
S:[], for i thru length(LY) do (S:endcons(LY[i][2][1],S), S:endcons(LY[i][3][1],S)),
c2show(S), c1show("S2:",S),
S:delete('null,S),
/* if member('null,S) then (cshow("===NULL==="),return(LTAB)), ********************/
S : sort(S,"<"), c2show("--sorted--",S),
if length(S)>1 and length(listofvars(S))=0 then for i thru length(S)-1 do (
if member(S[i],[minf,inf,null])=false then (
if abs(S[i+1]-S[i])<yepsk then S[i+1]:S[i]
)
), /* end of for-i */
c2show(S),c2show(unique(S)),
SS : sort(unique(S),"<"),
if length(SS)=0 then return(LTAB), /****************************************/
c1show(SS),
pend : length(SS),
if length(listofvars(SS))=0 then for i thru length(LY) do
for j thru length(SS) do (
if abs(float(LY[i][2][1])-SS[j])<=yepsk then LY[i][2]:endcons(j,LY[i][2]),
if abs(float(LY[i][3][1])-SS[j])<=yepsk then LY[i][3]:endcons(j,LY[i][3])
)
else (
cshow("E1: 検索点xにおける関数値y(x)の評価に失敗した"),
cshow(" ",va[vnom1][ix][1]),cshow(" ",SS),cshow(" ",LY),
cshow(" -> outlineonly:true として処理を続行する"),
/* outlineonly:true, */
return(LTAB)
), /* outlineonly:true */
for k thru length(LY) do (
if LY[k][2]=[null] then LY[k][2]:[null,0],
if LY[k][3]=[null] then LY[k][3]:[null,0]
),
c1show("S3:",LY),
pointerror:false,
for k thru length(LY) do (
if length(LY[k][2]) # 2 then (pointerror:true, cshow("Error:",k,LY[k]) ),
if length(LY[k][3]) # 2 then (pointerror:true, cshow("Error:",k,LY[k]) )
),
if pointerror=true then (cshow("Error at Point in shrink10:",xepsk,yepsk), quit()),
/* 端点番号とその開閉を調べる(閉線,開線の交点に注意) */
Pco : makelist(c,i,1,pend),
for p thru pend do
for i thru length(LY) do (
if LY[i][2][2]=p and ev(LY[i][1][2],nouns)=o then Pco[p]:o,
if LY[i][3][2]=p and ev(LY[i][1][2],nouns)=o then Pco[p]:o
), /* end of for-i */
c1show(Pco),
for i thru length(LY) do (
if LY[i][2]=[null,0] then LY[i][2]:[null,0,x] else
LY[i][2]: endcons(Pco[LY[i][2][2]], LY[i][2]),
if LY[i][3]=[null,0] then LY[i][3]:[null,0,x] else
LY[i][3]: endcons(Pco[LY[i][3][2]], LY[i][3])
), /* end of for-i */
c1show("S4:",yepsk),c1show(LY),
/* LTAB = [[[LLno,'L],['va[2][1],'va[2][3],lr],[P1,lr],[P2,lr],"R2"],...] */
LTAB : copylist(LYLR), /* LYLR の複写 */
for i thru length(LTAB) do (LTAB[i]:endcons([],LTAB[i]),LTAB[i]:endcons([],LTAB[i])),
for i thru length(LTAB) do (
for j thru length(LY) do if LTAB[i][2][1]=LY[j][1] then
if LTAB[i][1][2]='L then LTAB[i][3]:[LY[j][2][2],LY[j][2][3]]
else LTAB[i][3]:[LY[j][3][2],LY[j][3][3]],
for j thru length(LY) do if LTAB[i][2][2]=LY[j][1] then
if LTAB[i][1][2]='L then LTAB[i][4]:[LY[j][2][2],LY[j][2][3]]
else LTAB[i][4]:[LY[j][3][2],LY[j][3][3]]
), /* end of for-i */
for i thru length(LTAB) do c2show(i,LTAB[i]),
/*
for i thru length(LTAB) do if LTAB[i][3][1] > LTAB[i][4][1]
then LERR:endcons(LTAB[i][1][1],LERR),
*/
for i thru length(LTAB) do if LTAB[i][3][1] > LTAB[i][4][1] then LTAB[i]:null,
LTAB:delete(null,LTAB),
/* R1: 飛び越し, R2: 2点接続, R3: 1点接続 */
/* ----------- memo -------------------------------------------------------------------
[[ly1,o],[ly2,c]] -> [[P1,o],[P2,o]] R2 -> x
[[ly3,c],[ly4,o]] -> [[P2,o],[P2,o]] R3o -> x
[[ly5,c],[ly6,c]] -> [[P3,c],[P3,c]] R3 -> include
[[ry1,o],[ry2,o]] -> [[P1,o],[P2,o]] R2 -> include
[[ry4,c],[ry5,c]] -> [[P3,c],[P3,c]] R3c -> x
R1: 飛び越しの有無(P1,P4のときP2,P3が飛び越された点とする)
R11 飛び越された点にo点があれば飛び越し区間を不採用とする.
R12 飛び越された点がすべてc点のときは合併の可能性を調べる
R2: 異なる2点区間 [[Pi,lri],[Pj,lrj]] (Pi # Pj) では,lrバターンが一致する
[[yi,lr1],[yj,lrj]] があれば採用し,不一致のものは不採用とする.
R3: R3o:1点区間 [[Pi,o],[Pi,o]] は無処理,
R3c:1点区間 [[Pi,c],[Pi,c]] は一ヶ所のみ合併処理をおこなう.
---------------------------------------------------------------------------------- */
for i thru length(LTAB) do
if LTAB[i][4][1]-LTAB[i][3][1] > 1 then LTAB[i]:endcons("R1?",LTAB[i])
else if abs(LTAB[i][4][1]-LTAB[i][3][1])=1 then LTAB[i]:endcons("R2?",LTAB[i])
else if LTAB[i][4][1]-LTAB[i][3][1]=0 then LTAB[i]:endcons("R3?",LTAB[i])
else LTAB[i]:endcons("Rx?",LTAB[i]),
c2show("予備判定"),c2show(LTAB),
for i thru length(LTAB) do
if LTAB[i][5]="R2?" then (
if ev(LTAB[i][2][1][2],nouns)=LTAB[i][3][2] and
ev(LTAB[i][2][2][2],nouns)=LTAB[i][4][2]
then (
LTAB[i][5]:"R2",
if i < length(LTAB) then for j:i+1 thru length(LTAB) do
if LTAB[j][3]=LTAB[i][3] and LTAB[j][4]=LTAB[i][4] then LTAB[j][5]:"R2x"
)
else LTAB[i][5]:"R2x" ),
c2show("R2:2点接続"),c2show(LTAB),
for i thru length(LTAB) do
if LTAB[i][5]="R3?" then (
if LTAB[i][3][2]=c and LTAB[i][4][2]=c
/* and LTAB[i][2][3]=cc */
and ev(LTAB[i][2][1][2],nouns)=c and ev(LTAB[i][2][2][2],nouns)=c
then (
LTAB[i][5]:"R3",
if i < length(LTAB) then for j:i+1 thru length(LTAB) do
if LTAB[j][3]=LTAB[i][3] and LTAB[j][4]=LTAB[i][4] then LTAB[j][5]:"R3x"
)
else LTAB[i][5]:"R3x"
),
c2show("R3:1点接続"),c2show(LTAB),
for i thru length(LTAB) do
if LTAB[i][5]="R1?" and LTAB[i][4][1]-LTAB[i][3][1]=2 then (
sp:LTAB[i][3][1]+1, /* P1,P3 のとき P2 */
if Pco[sp]=o then LTAB[i][5]:"R1x",
if Pco[sp]=c then (
for j thru length(LTAB) do (
if j # i and LTAB[j][3][1]>=sp-1
and LTAB[j][4][1]<=sp+1
and not (LTAB[j][3][1]=sp-1 and LTAB[j][4][1]=sp+1)
then LTAB[j][5]:"R1-included" ),
LTAB[i][5]:"R1"
) /* end of if-Pco[sp]=c */
), /* end of 1点飛び越し */
c2show("R1:飛び越し"),c2show(LTAB),
c1show("R-判定結果"), for i thru length(LTAB) do c1show(i,LTAB[i]),
/* 変更箇所検出と開閉変更 ********************/
/* LTAB = [[[LLno,'L],['va[2][1],'va[2][3],lr],[P1,lr],[P2,lr],"R2"],...] */
for i thru length(LTAB) do (
if member(LTAB[i][5],["R1","R2","R3"]) then (
ii:LTAB[i][1][1],
if LTAB[i][1][2]='L then (
if LL[ii][vnom1][3]=oo then LL[ii][vnom1][3]:oc
else if LL[ii][vnom1][3]=co then LL[ii][vnom1][3]:cc ),
if LTAB[i][1][2]='R then (
if LL[ii][vnom1][3]=oo then LL[ii][vnom1][3]:co
else if LL[ii][vnom1][3]=oc then LL[ii][vnom1][3]:cc )
) /* end of if-then */ ), /* end of for-i */
/*epsk:null, */
return(LTAB)
)$
/*############################################################################*/
/*### mkfloat 虚数%iを含む数値を判定し実数であれば実数値を返す ########################*/
/*############################################################################*/
mkfloat([args]) := block([progn:"<mkfloat>",debug,exp, tmp,realonly_old,EPS:1.0E-7,in,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of mkfloat('help)--
機能: 虚数%iを含む数値を判定し実数であれば実数値を返す
文法: mkfloat(exp,...)
例示:
CS: mkfloat(1.0) = 1.0
CS: mkfloat(1.0E-10*%i+1.0) = 1.0
CS: mkfloat(1.0E-6*%i+1.0) = null
CS: mkfloat(2*x+%i) = unknown
CS: mkfloat([1.0]) = [1.0]
CS: mkfloat([1.0,1.0E-10*%i+1.0,1.0E-6*%i+1.0,2*x+%i]) = [1.0,1.0,null,unknown]
CS: freeof(unknown,null,mkfloat([1.0,1.0E-10*%i+1.0])) = true
CS: freeof(unknown,null,mkfloat([1.0,1.0E-10*%i+1.0,1.0E-6*%i+1.0,2*x+%i])) = false
メモ:
--end of mkfloat('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of mkfloat('ex)--"),
mkfloat_ex(),
/*
block([progn:"<mkfloat_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of mkfloat_ex---")
), /* end of block */
*/
print("--end of mkfloat('ex)--"),
return("--end of mkfloat('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
realonly_old:realonly, realonly:false,
if listp(exp)=false then in:[exp] else in:exp, out:makelist(null,i,1,length(in)),
for i thru length(in) do (
if listofvars(in[i]) # [] or in[i]=infinity then out[i]:'unknown
else (
tmp:in[i], tmp:ev(tmp,expand,infeval), tmp:float(tmp), tmp:rectform(tmp), /*重要*/
if cabs(tmp) < 1.0E-14 then tmp:0
else if abs(imagpart(tmp))/cabs(tmp) < EPS then tmp:realpart(tmp) else tmp:'null,
out[i]:float(tmp) ) /* end of else */
), /* end of for-i */
realonly:realonly_old,
if listp(exp)=false then return(out[1]) else return(out)
)$
/*--- mkfloat_ex -------------------------------------------------------------------*/
mkfloat_ex([args]) := block([progn:"<mkfloat_ex>",debug],
debug:ifargd(),
cshow(mkfloat(1.0)),
cshow(mkfloat(1.0+1.0E-10*%i)),
cshow(mkfloat(1.0+1.0E-6*%i)),
cshow(mkfloat(2*x+%i)),
cshow(mkfloat([1.0])),
cshow(mkfloat([1.0,1.0+1.0E-10*%i,1.0+1.0E-6*%i,2*x+%i])),
cshow(freeof(unknown,null,mkfloat([1.0,1.0+1.0E-10*%i]))),
cshow(freeof(unknown,null,mkfloat([1.0,1.0+1.0E-10*%i,1.0+1.0E-6*%i,2*x+%i]))),
return("---end of mkfloat_ex---")
)$ /* end of mkfloat() */
/*############################################################################*/
/*### floatfix: 数値 exp をk桁に丸めた結果を返す ##################################*/
/*############################################################################*/
floatfix([args]) := block([progn:"<floatfix>",debug,exp, keta, k,s,in,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of floatfix('help)--
機能: 数値 exp をk桁に丸めた結果を返す
文法: floatfix(exp,...)
例示:
CS: floatfix(1.234567,4) = 1.235
CS: floatfix([1.234567],4) = [1.235]
CS: floatfix([1.234567,123456.7,1.234567E-10],3) = [1.23,123000.0,1.23E-10]
CS: freeof(null,floatfix([1.234567,x+1.234567],4)) = false
メモ:
--end of floatfix('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of floatfix('ex)--"),
floatfix_ex(),
/*
block([progn:"<floatfix_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of floatfix_ex---")
), /* end of block */
*/
print("--end of floatfix('ex)--"),
return("--end of floatfix('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1], keta : args[2],
if listp(exp)=false then in:[exp] else in:exp, out:makelist(null,i,1,length(in)),
c2show(exp,in,keta),
for i thru length(in) do (
if numberp(in[i])=false then out[i]:'null
else if cabs(in[i]) < 1.0E-15 then out[i]:0
else (
k : keta - fix(log(cabs(in[i]))/log(10)) -1,
s:sign(in[i]), if s=pos then s:1 else if s=neg then s:-1 else s:0,
out[i] : s*float(fix(cabs(in[i])*10^k+0.5)/(10^k))
) /* end of else */ ), /* end of for-i */
if listp(exp)=false then return(out[1]) else return(out)
)$ /* end of floatfix() */
/*--- floatfix_ex -------------------------------------------------------------------*/
floatfix_ex([args]) := block([progn:"<floatfix_ex>",debug],
debug:ifargd(),
cshow(floatfix(1.234567,4)),
cshow(floatfix([1.234567],4)),
cshow(floatfix([1.234567,1.234567E5,1.234567E-10],3)),
cshow(freeof(null,floatfix([1.234567,x+1.234567],4))),
return("---end of floatfix_ex---")
)$ /* end of floatfix_ex() */
/*############################################################################*/
/*### flrlimit: x0:浮動小数での関数f(x)の左右極限値を評価する #######################*/
/*############################################################################*/
flrlimit([args]) := block([progn:"<flrlimit>",debug, func,var,x0,
f,df,dfm,dfp,xepsk,yepsk,xeps,yeps,ym,yp,wym,wyp,ky],
/* use: mfloat, floatfix */
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of flrlimit('help)--
機能: x0:浮動小数での関数f(x)の左右極限値を評価する
文法: flrlimit(func,var,x0,...)
例示:
CS: v21 =
(sqrt(27*x^4+32*x^3-486*x^2+2187)/(2*3^(3/2))-(x^2-9)/2)^(1/3)
-(2*x)/(3*(sqrt(27*x^4+32*x^3-486*x^2+2187)/(2*3^(3/2))-(x^2-9)/2)^(1/3))
CS: flrlimit(v21,x,x0) = [2.4595186,2.4595186,0]
CS: v24 =
(sqrt(27*x^4+32*x^3-54*x^2+27)/(2*3^(3/2))-(x^2-1)/2)^(1/3)
-(2*x)/(3*(sqrt(27*x^4+32*x^3-54*x^2+27)/(2*3^(3/2))-(x^2-1)/2)^(1/3))
CS: flrlimit(v24,x,x0) = [1.1681861,1.1681861,0]
CS: h1 = -sqrt(sqrt(8*x^2+1)-2*x^2-1)/sqrt(2) , x0 = 0
CS: flrlimit(h1,x,x0) = [0.0,0.0,0]
メモ:
--end of flrlimit('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of flrlimit('ex)--"),
flrlimit_ex(),
/*
block([progn:"<flrlimit_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of flrlimit_ex---")
), /* end of block */
*/
print("--end of flrlimit('ex)--"),
return("--end of flrlimit('ex)--"),
block_main, /* main ブロック ====================================*/
func : args[1], var : args[2], x0 : args[3],
c2show(progn,x0,func,flotnump(x0),mkfloat(x0)),
if floatnump(x0)=false and flimitmode#true then (
ym:limit(func,var,x0,minus), ym:mkfloat(ym),
yp:limit(func,var,x0,plus), yp:mkfloat(yp),
yepsk:0,
c1show("flrlimit:正確評価",x0,ym,yp),
return([ym,yp,yepsk])
),
x0:mkfloat(x0), c2show(x0,func),if x0='null then return([null,null,0]),
xepsk:1.0E-7,
if cabs(x0) < 1.0E-15 then xeps:1.0E-10 else xeps:floatfix(cabs(x0)*xepsk,1),
define(f(var), func), define(df(var),diff(f(var),var)),
dfm:mkfloat(df(x0-xeps)), dfp:mkfloat(df(x0+xeps)),
if dfm='null then dfm:0, if dfp='null then dfp:0,
yeps:max(abs(dfm),abs(dfp))*xeps*4,
ym:mkfloat(limit(f(var),var,x0-xeps,minus))+dfm*xeps,
yp:mkfloat(limit(f(var),var,x0+xeps,plus))-dfp*xeps,
c2show(progn,"-<0>",dfm,dfp,ym,yp,yeps,floatfix(yeps,1)),
if cabs(yp-ym) < yeps then yp:ym,
ky:4, /* 結果の有効桁数の指定 */
ym:floatfix(ym,ky),
yp:floatfix(yp,ky),
if ym='null then wym:0 else wym:cabs(ym),
if yp='null then wyp:0 else wyp:cabs(yp),
if ym='null and yp='null then return([null,null,0]),
if ym=0 and yp=0 then return([0,0,0]),
yepsk: floatfix( 10^(fix(log(max(wym,wyp))/log(10))-ky+1), 1) * 5,
yepsk: max(floatfix(yeps,1),yepsk), /****************************/
c2show(progn,ym,yp,yepsk),
return([ym,yp,yepsk])
)$ /* end of flrlimit() */
/*--- flrlimit_ex -----------------------------------------------------------------*/
flrlimit_ex([args]) := block([progn:"<flrlimit_ex>",debug,x0,v24,v21,h1],
debug:ifargd(),
v24:(sqrt(27*x^4+32*x^3-54*x^2+27)/(2*3^(3/2))-(x^2-1)/2)^(1/3)
-2*x/(3*(sqrt(27*x^4+32*x^3-54*x^2+27)/(2*3^(3/2))-(x^2-1)/2)^(1/3)),
v21:(sqrt(27*x^4+32*x^3-486*x^2+2187)/(2*3^(3/2))-(x^2-9)/2)^(1/3)
-2*x/(3*(sqrt(27*x^4+32*x^3-486*x^2+2187)/(2*3^(3/2))-(x^2-9)/2)^(1/3)),
x0:-3695/1806, /*-2.046*/
cshow(v21),cshow(flrlimit(v21,x,x0)),
cshow(v24),cshow(flrlimit(v24,x,x0)),
h1:-sqrt(sqrt(8*x^2+1)-2*x^2-1)/sqrt(2),
x0:0,
cshow(h1,x0),cshow(flrlimit(h1,x,x0)),
return("---end of flrlimit_ex---")
)$
/*############################################################################*/
/*### salgall 多連立多変数代数方程式の同時解を求める ###########################*/
/* [f1(x,y,z),f2(x,y,z)] -> [f1,f2,f1x,f2x,f1y,f2y,f1z,f2z] -> [f1,f2,f1x,f2x,f1y,f2y,f1z]
- ... -> [f1,f2] を順次 [x,y,z] について解く */
/*############################################################################*/
salgall([args]) := block([progn:"<salgall>",debug,eqs,varl,
realonly_old,vnoend,kend,dd:[],weqs:[],rnumv,ans],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of salgall('help)--
機能: 多連立多変数代数方程式の同時解を求める
文法: salgall(eqs,varl,...)
例示:
salgall((x-8)^2*((y-7)^2+(x-6)^2)*((z-5)^2+(y-4)^2+(x-3)^2)*(z^2+y^2+x^2-1),[x,y,z])
-> [[x = 3,y = 4,z = 5],[x = 6,y = 7,z = z],[x = 8,y = y,z = z],
[x = x,y = y,z = -sqrt((-y^2)-x^2+1)],
[x = x,y = y,z = sqrt((-y^2)-x^2+1)]]
salgall(y^3+2*x*y+x^2-1,[x,y])
-> [[x = -2.0459579,y = 1.1678921],[x = -0.65266742,y = -0.65962984]]
salgall([y-x^2+6*x-10,y+x^2-6*x],[x,y])
-> [[x = 1,y = 5],[x = 5,y = 5]]
メモ:
--end of salgall('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of salgall('ex)--"),
salgall_ex(),
/*
block([progn:"<salgall_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of salgall_ex---")
), /* end of block */
*/
print("--end of salgall('ex)--"),
return("--end of salgall('ex)--"),
block_main, /* main ブロック ====================================*/
eqs : args[1], varl : args[2],
vnoend:length(varl),
if listp(eqs)=false then eqs:[eqs], kend:length(eqs),
for vno thru vnoend do for k thru kend do dd:append(dd,[diff(eqs[k],varl[vno])]),
c1show("=== Enter salgall ==="),
realonly_old:realonly, realonly:false,
/* begin of block --------------------------*/
block([v,err],v:1, loop,
weqs:append(eqs,rest(dd,v)), /* v:0, rest(dd,-v) ****************/
if errcatch( ans:algsys(weqs,varl), return )=[] then (ans:[]),
c2show(v,weqs,ans),
if ans=[] and v < vnoend*kend then (v:v+1,go(loop)) else return(ans)
), /* end of block */
if ans=[] then c1show(progn, map(polydeg,eqs)),
c1show(length(weqs)),c1show("->",reveal(ans,10)),c1show(%rnum_list),
/* 複素数処理 */
for i thru length(ans) do for vno thru vnoend do
if realp(rhs(ans[i][vno]))=false then ans[i]:null,
ans:delete(null,ans),
/* 補助変数処理 */ rnumv:[],
for j thru length(ans) do ( for k thru length(ans[j]) do (
if member(rhs(ans[j][k]),%rnum_list) and atom(rhs(ans[j][k])) then
rnumv:endcons([rhs(ans[j][k]),lhs(ans[j][k])],rnumv)
) /* end of for-k */ ), /* end of for-j */ c1show(rnumv),
for k thru length(rnumv) do ans: subst(rnumv[k][2], rnumv[k][1], ans),
c1show("P3:y=%i*(x-x0)+y0 - > [x=x0,y=y0] の処理 <--",length(ans)),
block([w,c0,c1,c2,ansi,ansr,ansir],
for i thru length(ans) do (
c1show(i,ans[i]),
if vnoend > 0 then for j:2 thru vnoend do (
w:ans[i][j],c1show(ans[i][j]),
c0:listofvars(rhs(w)), c1:length(c0),
if c1 > 0 then c2:hipow(rhs(w),c0[1]) else c2:-1,
c1show(c0,c1,c2),
if lhs(w)=varl[j] and
freeof(%i,rhs(w))=false and polynomialp(rhs(w),c0)
and c1=1 and hipow(rhs(w),c0[1])=1
then (
c1show("---complex---",w),
ansi:algsys([imagpart(rhs(w))],c0)[1][1],
ansr:realpart(w),
c1show("--->",ansi,ansr),
if lhs(ansi)=varl[j-1] then ans[i][j-1]:ansi,
if lhs(ansr)=varl[j] then ans[i][j]:ansr,
ansir:[ansi,ansr],
if j < vnoend then
for jj:j+1 thru vnoend
do ans[i][jj]:lhs(ans[i][jj])=ev(rhs(ans[i][jj]),ansir)
) /* end of then */
) /* end of for-j */
), /* end of for-i */
ans:unique(ans),return(ans)), /* end of block ----------------------*/
for i thru length(ans) do ans[i]:sqrt2d(ans[i]), ans : unique(ans), /* add */
realonly:realonly_old,
c1show(ans),
return(ans)
)$ /* end of salgall() */
/*--- salgall_ex ----------------------------------------------------------------------*/
salgall_ex([args]) := block([progn:"<algall_ex>",debug,
Lex,ex,vl,ans, ex1,C2,C2a,A1,A2,R30,R30b,R40],
debug : ifargd(),
Lex : [ex1,C2,C2a,/* hyx(x,y),*/ A1,A2,R30,R30b,R40],
/*
if length(args) > 0 and member(args[1],Lex) then Lex : [args[1]],
*/
ex1 : (x-8)^2*((y-7)^2+(x-6)^2)*((z-5)^2+(y-4)^2+(x-3)^2)*(z^2+y^2+x^2-1),
C2 : x^2+y^3+2*x*y-1,
C2a : expand(C2*(y-3*x)^3),
A1 : [y-x^2+6*x-10,y+x^2-6*x],
A2 : [(y-2)*(x^2+y^2+z^2-4),z-x^2-y^2-1],
R30 : ((x-1)^2+(y-2)^2+(z-3)^2)*(x^2+y^2+z^2-1),
R30b:(x-5)*((x-4)^2+(y-5)^2)*((z-3)^2+(y-2)^2+(x-1)^2)*(z^2+y^2+x^2-1),
R40 : ((t-4)^2+(z-3)^2+(y-2)^2+(x-1)^2)*(t^2+z^2+y^2+x^2-1),
for ex in Lex do (
print("--- 実行例 ---",ex), ex:ev(ex,nouns),
vl : listofvars(ex),
disp('salgall(ex,vl)),
ans : salgall(ex,vl),
ldisplay(ans)
),
return("---end of algall_ex---")
)$ /* end of salgall_ex() */
/*#############################################################################*/
/*### sqrt2d : [x=x, y=y, z = z0 + sqrt(c1*x^2+c2*x+c3*y^2+c4*y+c5)
= z0 + sqrt(c1*(x-a)^2+c2*(y-b)^2), c1 <0, c2 <0
-> [x=a,y=b,z=z0] ##################*/
/*#############################################################################*/
sqrt2d([args]) := block([progn:"<sqrt2d>",debug, ans0,
vnoend,varl,lastv,exp,out:[],rem,st,f,vl,vend,c2,j1,vv,f2,d,const,eqs,ans],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of sqrt2d('help)--
機能: z = z0 + sqrt(z1) z1 < 0 のとき z=z0 とする処理
文法: sqrt2d(ans0,...)
例示:
sqrt2d([x = x,y = y,z = sqrt((-y^2)+4*y-x^2+2*x-5)+3])
-> [x = 1,y = 2,z = 3]
sqrt2d([x = x,y = y,z = -sqrt((-y^2)-x^2+1)])
-> [x = x,y = y,z = -sqrt((-y^2)-x^2+1)]
メモ:
--end of sqrt2d('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of sqrt2d('ex)--"),
sqrt2d_ex(),
/*
block([progn:"<sqrt2d_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of sqrt2d_ex---")
), /* end of block */
*/
print("--end of sqrt2d('ex)--"),
return("--end of sqrt2d('ex)--"),
block_main, /* main ブロック ====================================*/
ans0 : args[1],
c1show("<<sqrt2d>> in ---",ans0),
vnoend : length(ans0), varl : map(lhs,ans0), lastv:last(varl), exp:rhs(last(ans0)),
c1show(progn,lastv,exp),
out:scanmap(lambda([u], if atom(u) = false then u:cons(op(u),args(u)) else u),exp),
c2show("S1:完全リスト:",out),
out:scanmap(lambda([u],
if listp(u) and first(u)=sqrt and listp(u[2])
then [u[1],l2f(u[2])] else u),out),
c1show("S2:",out),
if listp(out)=false then return(ans0),
rem : copylist(out),
rem:scanmap(lambda([u],
if listp(u) and first(u)=sqrt then u[2]:0 else u),rem), rem:l2f(rem),
c1show(rem,out),
if listp(out) = false then return(ans0),
st:[],
scanmap(lambda([u], if listp(u) and u[1]=sqrt and length(listofvars(u[2])) > 0
and hipow(u[2],listofvars(u[2])[1])=2
then (st:endcons(u[2],st)) else u ), out),
c1show("S3:",st),
if length(st)=0 then return(ans0),
/* 計算 */
f:st[1], vl:listofvars(f), vend:length(vl), c2:[], j1:true,
for v thru vend do (
c2:endcons(coeff(f,vl[v],2),c2), if c2[v] >= 0 then j1:false ), c1show(c2),
if j1=fase then return(ams0),
vv : [x0,y0,z0,t0,u0], vv:rest(vv,5-vend),
f2:0, for v thru vend do f2:f2+c2[v]*(vl[v]-vv[v])^2, f2:f2+c0,
c1show(f2,vv),
d : expand(f-f2),
c1show(d),const:d,
eqs:[], for v thru vend do
(eqs:endcons(coeff(d,vl[v],1),eqs), const:coeff(const,vl[v],0),
c2show(v,const) ),
eqs:endcons(const,eqs), c1show(eqs),
vv:endcons(c0,vv),
ans : algsys(eqs,vv), ans:ans[1],
c1show(ans),
if rhs(last(ans))=0 then (
c1show("完全2次形式"),
for v thru vnoend-1 do ans[v]: varl[v]=rhs(ans[v]), ans[vnoend]: lastv=rem,
c1show(ans0),c1show("--->",ans)
) else (c1show("---xx---"), ans:copylist(ans0) ),
return(ans)
)$
/*--- sqrt2d_ex -------------------------------------------------------------*/
sqrt2d_ex([args]) := block([progn:"<sqrt2d_ex>",debug, ans0,ans1, Lex,ex,out],
debug:ifargd(),
ans0 : [x=x,y=y,z = 3 + sqrt(-y^2+4*y-x^2+2*x-5)],
ans1 : [x=x,y=y,z = -sqrt(-y^2-x^2+1)],
Lex : [ans0,ans1],
for ex in Lex do (
print("---例---",ex),
disp('sqrt2d(ex)), out:sqrt2d(ex), ldisplay(out)
),
return("---end of sqrt2d_ex---")
)$ /* end of sqrt2d_ex() */
/*######################################################################*/
/* <acnode_join>: (内部使用) : 孤立点間の合併
on3(x,minf,inf,oo)*on3(y,y0,y0,cc)*{on3(z,z1(x),z1(x),cc)+on3(z,z2(x),z2(x),cc)}
-> on3(x,minf,inf,oo)*on3(y,y0,y0,cc)*on3(z,z1(x),z2(x),cc)
tvar, on3f は外部プログラムから参照する */
/*######################################################################*/
acnode_join(LWT0,[args]) := block([progn:"<acnode_join>",debug,
LWT:LWT0,out,ton3j:[],ton3k:[],gtj,gtk,wgtj,wgtk,wtl:[],vmid,won3f,tl,tr],
debug:ifargd(),
c1show("acnode_join start",LWT),
if not LWT[1] = "+" then (c1show("not reducedac",LWT), return([LWT,false])),
for j:2 thru length(LWT)-1 do (
if LWT[1]="*" then return([LWT,true]),
gtj:l2f(LWT[j]), c1show(gtj),
scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then ton3j:u else u), LWT[j]),
wgtj:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then u:1 else u), LWT[j]),
c1show(ton3j,wgtj,l2f(wgtj)),
if length(LWT) > 1 and LWT[1]="+" then for k:j+1 thru length(LWT) do (
gtk:l2f(LWT[k]),
scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then ton3k:u else u),LWT[k]),
wgtk:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=tvar
then u:1 else u), LWT[k]),
c1show(ton3k,wgtk),
wtl:sort(unique([ton3j[3],ton3j[4],ton3k[3],ton3k[4]])), /* 条件 */
c1show(gtj,gtk,wtl,wgtj,wgtk),
if length(wtl)=2 and wgtj=wgtk and length(listofvars(wtl)) > 0
then (
vmid:makelist(null,vno,1,vnoend),
for vno thru vnoend do (
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=varl[vno]
then ( if u[3]=minf and u[4]=inf then vmid[vno]:u[2]
else vmid[vno]:(u[3]+u[4])/2, u)
else u), wgtj),
if varl[vno]=tvar then vmid[vno]:(ton3j[3]+ton3k[3])/2
), /* end of for vno */
c2show(vmid,on3f),
for vno thru vnoend do vmid[vno]:varl[vno]=expand(vmid[vno]),
won3f:on3f,
won3f:ev(won3f,vmid,infeval), c2show(won3f), /* 判別 */
if is( ton3j[3] < ton3k[3] ) then (tl:ton3j[3], tr:ton3k[3]),
if is( ton3j[3] >= ton3k[3] ) then (tl:ton3k[3], tr:ton3j[3]),
c2show(progn,ton3j[3],ton3k[3],is( ton3j[3] < ton3k[3] ),tl,tr),
if is( ton3j[3] < ton3k[3] ) # unknown then (
out:l2f(wgtj)*on3(tvar,tl,tr,cc),
cshow("reduced:",gtj),cshow(" and ",gtk),cshow("->",out),
LWT[j]:f2l(out),
LWT:delete(LWT[k],LWT,1) ), /* end of not 'umknown */
if length(LWT)=2 and LWT[1]="+" then LWT:LWT[2],
c1show(LWT),c1show(length(LWT)),
return([LWT,true])
) /* end of then */
) /* end of for-k */
), /* end of for-j */
return([LWT,false])
)$ /* end of acnode_join() */
/*### on3ineq_acnode ######################################################*/
/* <on3ineq_acnode: 孤立点処理 */
/*############################################################################*/
on3ineq_acnode(LF,[args]) := block([progn:"<on3ineq_acnode>",debug,
kend,f,fl,fr,flr, varlt:[], vnoend, swl,swr,swlr,Lout,tmp,display2d_old,
z0,z1,z2,z0num,z0den,z1num,z1den,z2num,z2den, eql,eqr,noreal,ans,tvar,
eqac:[],diffvar,weq,wgcd,rnumlist,ansac,won3f,won3fL,acnode,w0,w1,tt,outs:0,outl:0],
debug:ifargd(),
display2d_old:display2d, display2d:false,
if length(varl) = 1 then return(outs:0),
kend:length(LF),
c1show("===on3ineq_acnode start==="),
c1show(LF),
swl:makelist(null,k,1,kend), swr:makelist(null,k,1,kend),
swlr:makelist(null,k,1,kend),
eql:makelist(null,k,1,kend),eqr:makelist(null,k,1,kend),
for k thru length(LF) do (
f:LF[k][1],fl:LF[k][2],fr:LF[k][3], flr:LF[k][4],
varlt : endcons([listofvars(f),listofvars(fl),listofvars(fr)],varlt),
z0 : fullratsimp(f), z0den : denom(z0), z0num : num(z0),
z1 : fullratsimp(fl), z1den : denom(z1), z1num : num(z1),
z2 : fullratsimp(fr), z2den : denom(z2), z2num : num(z2),
eql[k] : z0num*z1den-z1num*z0den, /* 左境界面・線・点 */
eqr[k] : z0num*z2den-z2num*z0den, /* 右境界面・線・点 */
if fl=minf then eql[k]:null, if fr=inf then eqr[k]:null,
if flr=cc then (swl[k]:c, swr[k]:c, swlr[k]:c)
else if flr=co then (swl[k]:c, swr[k]:o, swlr[k]:o)
else if flr=oc then (swl[k]:o, swr[k]:c, swlr[k]:o)
else if flr=oo then (swl[k]:o, swr[k]:o, swlr[k]:o)
),
c1show("=== START on3ineq_acnode ==="),
varlt:unique(flatten(varlt)),
if atom(varl)=true then (varl:copylist(varlt),cshow(progn,"変数リスト自動生成:",varl)),
vnoend:length(varl),
c1show(eql),c1show(eqr),c1show(eqsing), c1show(varl,vnoend),
/* 追加すべき孤立点候補を得る */
eqac:[], diffvar : makelist(null,vno,1,vnoend),
for k thru kend do (
if swl[k]=c then eqac:endcons(eql[k],eqac),
if swr[k]=c then eqac:endcons(eqr[k],eqac)
),
eqac:unique(eqac), c1show(length(eqac)),c1show(eqac),
acnode:[], rnumlist:[],
for i thru length(eqac) do ( /*** CALL salgall ----------------------------***/
ansac:salgall([eqac[i]],varl), c1show("--",i,varl,ansac),
acnode : append(acnode,ansac)
), /* end of for-i*/
acnode:sort(unique(acnode)),
c1show(acnode),
/* add 2010-08-17 A2:use R30b: time over *****************************/
if true then (
c1show("A1: 交差面・線・点を求める"),
weq : [],
if length(eqac)>1 then for k1 thru length(eqac)-1 do
for k2:k1+1 thru length(eqac) do (
weq:[eqac[k1],eqac[k2]],
c1show(length(weq)), c1show(weq),
wgcd:gcd(weq[1],weq[2]),weq:weq/wgcd,
ans : salgall(weq,varl), /***** Call algall ********/
c1show(ans), acnode:append(acnode,ans),
if wgcd # 1 then ans:salgall(wgcd,varl),
c1show("wgcd",ans), acnode:append(acnode,ans)
),
acnode:sort(unique(acnode))
), /* end of if-false */
/* for i thru length(acnode) do acnode[i]:map('rhs,acnode[i]), */
/* acnode から特異点・線 vsing を除く */
for i thru length(acnode) do (
for vno thru vnoend do
if member(rhs(acnode[i][vno]), flatten(vsing[vno])) then acnode[i]:null
), /* end of for-i */
acnode:delete(null,acnode),
c1show("孤立点・線候補:",acnode),
/* 孤立線の検出 (z=z(x), z=z(y) は処理済み), y=y0 の3種類 */
if false then (
c1show(va), outl:0, won3f:on3f,
for vno:2 thru vnoend-1 do (
for i thru length(va[vno]) do
if length(listofvars(va[vno][i][1])) < vno-1 /* 変数の個数に基づく判定 */
and va[vno][i][2]=c then (
c1show(varl[vno],va[vno][i][1]),
won3f:ev(won3f,ev(varl[vno])=ev(va[vno][i][1]))
) /* end of fit */
),
c1show("---add---"),c1show(won3f),won3fL:f2l(won3f),c1show(won3fL),
if false then outl:funmake(on3ineq, [[won3fL[2],won3fL[3],won3fL[4],won3fL[5]]]),
c1show("--->",outl),
if true then outsum:outsum+outl
), /* end of if-false */
/* 孤立点 acnode が解領域on3f，既存の解領域outsumに含まれるか否かを判定 */
c1show(%rnum_list,rnumlist),
c1show(on3f),c1show(reveal(outsum,8)), outs:0,
for i thru length(acnode) do (
w0:on3f, w1:outsum,
for vno:vnoend step -1 thru 1 do (
if errcatch(w0:ev(w0,ev(varl[vno])=rhs(acnode[i][vno]),infeval), return)=[]
then w0:0,
if errcatch(w1:ev(w1,ev(varl[vno])=rhs(acnode[i][vno]),infeval), return)=[]
then w1:0
), /* end of for-vno */
c1show(i,acnode[i],w0,w1,float(w0),float(w1)),
if constantp(w1) then c1show(i,acnode[i],w0,w1),
tt:1,
for j thru length(acnode[i]) do (
if lhs(acnode[i][j])=rhs(acnode[i][j]) or member(rhs(acnode[i][j]),rnumlist)
then tt:tt*funmake(on3,[lhs(acnode[i][j]),minf,inf,oo])
else tt:tt*funmake(on3,
[lhs(acnode[i][j]),rhs(acnode[i][j]),rhs(acnode[i][j]),cc])
), /* end of for-j */
if constantp(w0) and w0=1 then (c1show(i,acnode[i],w0),c1show("->",tt)),
if w0=1 and constantp(w1) then outs : outs + w0*(w0-w1)*tt,
if w0=1 and constantp(w1)=false then (
c1show("acnode:",float(w1)), outs:outs+tt )
), /* end of for-i */
c1show(reveal(outs,10)),
/* 孤立点の合併 see A2 */
if outs # 0 then
( tvar:varl[vnoend], [Lout,tmp] : acnode_join(f2l(outs)), outs:l2f(Lout) ),
/*========================================================================*/
display2d:display2d_old,
return([acnode,outl,outs])
)$ /* end of on3ineq_acnode() */
/*### on3dplot2 ##############################################################*/
/* <on3dplot2: on3f:on3(fl,f(x,y),fr,flr) の解領域を表示する */
/*############################################################################*/
on3dplot2([args]) := block([progn:"<on3dplot2>",debug,plotmode:false,
argsL0,keyv,keyvx,keyvy,rxrange,ryrange,fo,xsing,ysing,xl,xr,nx,yl,yr,ny,
x,y,xp,yp,g,L:[],fL:[],vys:[],gtitle,gst,xyrange,wL,dlist,swview],
/* 共通変数: vsing=[xsing,ysing] */
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3dplot2('help)--
機能: on3f:on3(f(x,y),fl,fr,flr) の解領域を表示する
文法: on3dplot2([args])
例示:
c0show(\"例0. on3ineq()の結果を用いた実行例\")$
on3ineq([(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co],
’resultonly,'nooutsum,'noview)$
on3dplot2(on3((x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co),
'xrange=[-4,4],'yrange=[0,8],
'title=\"on3dplot2-ex0\",
'file_name=\"on3dplot2-ex0\",
''view)$
メモ: 共通変数: vsing=[xsing,ysing]
--end of on3dplot2('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3dplot2('ex)--"),
/* on3dplot2_ex(), */
block([progn:"<on3dplot2_ex>",debug,argsL,on3func,varl0,vsing0],
c0show("例0. on3ineq()の結果を用いた実行例"),
on3ineq([(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co],
’resultonly,'nooutsum,'noview),
on3dplot2(on3((x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co),
'xrange=[-4,4],'yrange=[0,8],
'title="on3dplot2-ex0",'file_name=sconcat(figs_dir,"/","on3dplot2-ex0"),
swview),
c0show("例1."),
argsL : [title = "on3dplot2",xrange = [-4,4],yrange = [0,8]],
on3func : on3((x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co), /* S1 */
vsing0 : [[[1,s]],[[2,s]]], /* 特異点リスト: on3ineq()で作成され共通変数として参照可 */
on3dplot2(on3func,'argsL=argsL,vsing0,
'title="on3dplot2-ex1",'file_name=sconcat(figs_dir,"/","on3dplot2-ex1"),
swview),
c0show("例2."),
on3dplot2(on3func,'xrange=[-4,4],'yrange=[0,8],vsing0,
'title="on3dplot2-ex2",'file_name=sconcat(figs_dir,"/","on3dplot2-ex2"),
swview),
return("---end of on3dplot2_ex---")
), /* end of block */
print("--end of on3dplot2('ex)--"),
return("--end of on3dplot2('ex)--"),
block_main, /* main ブロック ====================================*/
if member('plot, args) then plotmode:true,
if length(args)>0 then on3func : args[1],
if listp(varl)=false then varl:listofvars(on3func),
c1show(progn,args),
c1show(progn,argsL),
c1show(progn,varl),
c1show(progn,"特異点リスト:",vsing),
if listp(vsing)=false then return("Error: vsing が存在しない"),
/* 描画範囲と検査点数の初期値 */
rxrange : xrange=[-5,5], ryrange : yrange=[-5,5], nx:50, ny:50,
/* 引数から rxrange=[rxl,rxr], ryrange=[ryl,ryr] を設定する */
argsL0 : find_key(args,'argsL), if argsL0 # false then argsL0 : rhs(argsL0),
c1show(progn,argsL0),
if argsL0 # false then (
c1show(progn,"argsL が存在する場合",argsL0),
keyvx : find_key(argsL0,'xrange),
if keyvx # false then ( rxrange : keyvx, c1show(progn,rxrange) ),
keyvy : find_key(argsL0,'yrange),
if keyvy # false then ( ryrange : keyvy, c1show(progn,ryrange) ),
[xl, xr] : rhs(rxrange), [yl,yr] : rhs(ryrange)
),
if argsL0=false or keyvx=false or keyvy=false then (
c1show(progn,"argsL が存在しない場合:args内を検索"),
keyvx : find_key(args,'xrange),
if keyvx # false then ( rxrange : keyvx, c1show(progn,rxrange) ),
keyvy : find_key(args,'yrange),
if keyvy # false then ( ryrange : keyvy, c1show(progn,ryrange) ),
[xl, xr] : rhs(rxrange), [yl,yr] : rhs(ryrange)
), /* end of if-keyvx,keyvy */
/* 解領域の探索と結果リスト L の生成 */
define(fo(x,y),on3func),
xsing:copylist(vsing[1]), for i thru length(xsing) do xsing[i]:xsing[i][1],
ysing:copylist(vsing[2]), for i thru length(ysing) do ysing[i]:ysing[i][1],
for i:0 thru nx do (
xp : xl + (xr-xl)*i/nx,
vys : copylist(ysing),
c1show(vys),
for j thru length(vys) do vys[j]:ev(vys[j],x=xp),
for j:0 thru ny do (
yp : yl + (yr-yl)*j/ny,
if member(xp,xsing)=false and member(yp, vys)=false
and fo(xp,yp)=1 then L:endcons([xp,yp],L)
)), /* end of for-i */
c1show("on3dplot2:",L,length(L)),
gtitle:title="on3plot2d",
keyv : find_key(args,'title),
if keyv # false then ( gtitle : keyv, c1show(gtitle) ),
gst:sconcat("line_width=2.5, grid=true,",gtitle,", yrange=[",yl,",",yr,"]," ),
if length(L) > 0
then gst:sconcat("gr2d(points(",L,"),",gst)
else gst:sconcat("gr2d( ",gst),
c1show(gst),
/* 輪郭線描画 */
fL:f2l_one(on3func), c1show("===on3dplot2===",fL),
xyrange:sconcat(varl[1],",",xl,",",xr,",",varl[2],",",yl,",",yr),
if fL[1]="*" then ( c1show("on3dplot2:連立不等式の場合"),
for k:2 thru length(fL) do (
wL:f2l_one(fL[k]), c1show(wL),
gst:sconcat(gst,"color=blue,implicit(",wL[2]-wL[3],",",xyrange,"),"),
gst:sconcat(gst,"color=red, implicit(",wL[2]-wL[4],",",xyrange,"),")
),gst:strimr(",",gst) ) /* end of 連立不等式 */
else ( c1show("on3dplot2:単一不等式の場合"),
gst:sconcat(gst,"color=blue,implicit(",fL[2]-fL[3],",",xyrange,"),"),
gst:sconcat(gst,"color=red, implicit(",fL[2]-fL[4],",",xyrange,")")
),
gst:sconcat(gst,")"),c1show(gst),
gst : eval_string(gst),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3dplot2-2"),
columns=1, dimensions=[500,500]],
dlist : mergeL(dlist,args,['terminal,'file_name,'columns,'dimensions]),
c1show(progn,dlist),
mk_draw([gst], dlist, swview),
return(gst)
)$
/* ### on3gr2 : on3関数で記述された領域(2変数，孤立点も可)の作図 ################*/
/* outsum = Σ on3(x,xl,xr,lx)*on3(y,yl(x),yr(x),ly) の描画 */
/* 使用例 : on3gr2(outsum), on3gr2(outsum,xrange=[0,3],yrange=[0,3]) */
/*############################################################################*/
on3gr2([args]) := block([progn:"<on3gr2>",debug,
plotmode:true, viewmode:false, swview, dlist,
exp, argsL0,keyvx,keyvy,rxrange,ryrange, nx,ny, svarl, xvar,lastvar,vend,
rxl,rxr,ryl,ryr, gtitle,flw,Lxp,is,iend,
L,fl,fr,flr,xl,xr,xlr,fltype,frtype,xrng,D,FD,Fl,Fr,gst],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3gr2('help)--
機能: on3関数で記述された領域(2変数，孤立点も可)の作図
文法: on3gr2(outsum,...)
例示: on3gr2(outsum)$
on3gr2(outsum,'xrange=[0,3],'yrange=[0,3],'view)$
メモ: 共通変数: vsing=[xsing,ysing]
--end of on3gr2('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3gr2('ex)--"),
/* on3gr2_ex(), */
/*
block([progn:"<on3gr2_ex>",debug],
c0show(gcd2l([a*b*c,b*c*d,c*a*b])),
return("---end of on3gr2_ex---")
), /* end of block */
*/
print("--end of on3gr2('ex)--"),
return("--end of on3gr2('ex)--"),
block_main, /* main ブロック ====================================*/
if member('view,args) then viewmode:true,
if length(args)>0 then exp : args[1], /* 必須の引数 */
c1show(progn,length(args),args),
/* 描画範囲と検査点数の初期値 */
rxrange : xrange=[-2,2], ryrange : yrange=[-2,2], nx:50, ny:50,
/* 引数から rxrange=[rxl,rxr], ryrange=[ryl,ryr] を設定する */
argsL0 : find_key(args,'argsL), if argsL0 # false then argsL0 : rhs(argsL0),
c1show(progn,argsL0),
if argsL0 # false then (
c1show(progn,"argsL が存在する場合",argsL0),
keyvx : find_key(argsL0,'xrange),
if keyvx # false then ( rxrange : keyvx, c1show(progn,rxrange) ),
keyvy : find_key(argsL0,'yrange),
if keyvy # false then ( ryrange : keyvy, c1show(progn,ryrange) ),
[rxl, rxr] : rhs(rxrange), [ryl,ryr] : rhs(ryrange)
),
if argsL0=false or keyvx=false or keyvy=false then (
c1show(progn,"argsL が存在しない場合:args内を検索"),
keyvx : find_key(args,'xrange),
if keyvx # false then ( rxrange : keyvx, c1show(progn,rxrange) ),
keyvy : find_key(args,'yrange),
if keyvy # false then ( ryrange : keyvy, c1show(progn,ryrange) ),
[rxl, rxr] : rhs(rxrange), [ryl,ryr] : rhs(ryrange)
), /* end of if-keyvx,keyvy */
c1show("on3gr2:",exp),
if listp(varl)=true then svarl:sort(varl) else svarl:sort(listofvars(exp)),
c1show(svarl),
if (length(svarl) # 2) then
(cshow(progn,"---> 2変数でないので作図処理を中止する"),return()),
c1show(progn,"変数リスト自動生成:",svarl),
xvar:first(svarl), lastvar:last(svarl), vend:length(svarl),
c1show("on3gr2:",xvar,lastvar,vend),
L : f2l(exp), Fl:[], Fr:[], Lxp:[], FD:[], c1show(L),
if L[1]="*" then (is:1, iend:1, L:[L]) else (is:2,iend:length(L)),
for i:is thru iend do (
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=lastvar then
(fl:u[3], fr:u[4], flr:u[5]) else u ), L[i]),
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=xvar then
(xl:u[3], xr:u[4], xlr:u[5]) else u ), L[i]),
xl:realpart(float(xl)), xr:realpart(float(xr)),
Lxp:append([xl,xr],Lxp),
D:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=lastvar then
u:1 else u ), L[i]),
D : l2f(D), if vend = 3 then (fl:fl*D, fr:fr*D),
if floatnump(xl) or floatnump(xr)
then flw:"line_width=3" else flw:"line_width=5",
if flr=oo then (fltype:"line_type=dots", frtype:"line_type=dots")
else if flr=oc then (fltype:"line_type=dots", frtype:"line_type=solid")
else if flr=co then (fltype:"line_type=solid", frtype:"line_type=dots")
else if flr=cc then (fltype:"line_type=solid", frtype:"line_type=solid"),
if freeof(minf,xl)=false then xl:rxl, if freeof(inf,xr)=false then xr:rxr,
xl:xl+0.00001, xr:xr-0.00001, /**** CAUTION *****/
if freeof(minf,fl)=false then fl:ryl, if freeof(inf,fr)=false then fr:ryr,
xrng:sconcat(xvar,",",xl,",",xr), c1show(xrng),c1show(fl),c1show(fr),
if abs(xr-xl) < 1.0e-3 and length(listofvars(fl))=0
then FD:endcons([xl,fl],FD), /* 立点 */
if abs(xr-xl) > 1.0e-3 then Fl:endcons([fl,fltype,xrng],Fl),
if abs(xr-xl) > 1.0e-3 then Fr:endcons([fr,frtype,xrng],Fr)
), /* end of for-i */
c1show("on3gr2:孤立点:",FD),
for i thru length(Lxp) do (
if Lxp[i]=minf then Lxp[i]:rxl, if Lxp[i]=inf then Lxp[i]:rxr ),
Lxp:unique(Lxp), Lxp:sort(Lxp,"<"),
for i thru length(Lxp) do Lxp[i]:[Lxp[i],ryl], c1show(Lxp),
c1show("on3gr2:X軸上の点:",Lxp),
Lxp : float(Lxp),
c1show(Fl),c1show(Fr), c1show(rxrange,ryrange),
if length(svarl)= 2 then ( /* 2次元プロット */
gtitle:title="Build on3 Func.",
gst : sconcat("gr2d( grid=true, line_width=3, ",gtitle) ,
if rxrange # "" then gst : sconcat(gst, ",",rxrange),
if ryrange # "" then gst : sconcat(gst, ",",ryrange),
c1show(gst),
gst : sconcat(gst,", point_size=1.5, point_type=7, points(",Lxp,")"),
if length(FD)>0 then
gst : sconcat(gst,
", point_size=1.0, point_type=7, color=darkgreen, points(",FD,")"),
c1show(gst),
for i:1 thru length(Fl) do (
gst: sconcat(gst,",color=blue,",flw,",",
Fl[i][2],", explicit(",Fl[i][1],",",Fl[i][3],") "),
gst: sconcat(gst,",color=red,",flw,",",
Fr[i][2],", explicit(",Fr[i][1],",",Fr[i][3],") ")
),
gst : sconcat(gst, ")"),c1show(plotmode),
c1show(gst),
/*
if viewmode then grv(gst,dimensions=[1800,1400])
*/
gst : eval_string(gst),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","tmp-on3gr2"),
columns=1, dimensions=[600,500]],
mk_draw([gst], dlist, swview )
), /* end of plot-2D */
return(gst)
)$ /* end of on3gr2() */
/*############################################################################*/
/*------on3ineq_ex---------------------------------------------------------*/
/*############################################################################*/
on3ineq_ex([args]) := block([progn:"<on3ineq_ex>",
debug,plotmode:true,viewmode:true,swview,ex,excase,
keyL, key, dlist,
display2d_old, /* ex, out, fL, on3func,*/
fL2,dxlr, xl,xr,nx, dylr,yl,yr,ny,gd,gout,
ex12,c2oo,c2oc,c2co,c2cc, c3oo,c3oc,c3co,c3cc, c4oo,c4oc,c4co,c4cc,
A1,A2,R30,R30b,R30c,R31,R32,C1,C2,L3,c4,S0,S1,S2,S3,K1,K2,H1,H1a,H2],
debug:ifargd(),
declare([ex12,c2oo,c2oc,c2co,c2cc, c3oo,c3oc,c3co,c3cc,
c4oo,c4oc,c4co,c4cc,A1,A2,R30,R30b,R30c,R31,R32,
C1,C2,L3,c4,S0,S1,S2,S3,K1,K2,H1,H1a,H2],constant),
c1show("=== Enter ",progn, "==="),
if length(args)>0 then excase : args[1],
if member('noview, args) then swview:'noview else swview:'view,
if member('noplot, args) then (plotmode:false, args:delete('noplot,args)),
if member('view, args) then (viewmode:true, args:delete('view,args)),
if member('noview, args) then viewmode:false,
if length(args) = 0 then ( printf(true,"
[Usage of <'on3ineq_ex([args])>]:~%
Exs: ex12,c1,c2oo,c2oc,c2co,c2cc, c3oo,c3oc,c3co,c3cc,
c4oo,c4oc,c4co,c4cc,A1,A2,R30,R30b,R30c,R31,R32,
c1,C1,C2,L3,c4,S0,S1,S2,S3,K1,K2,H1,H1a,H2 ~%
Ex : on3ineq(c2co,debug1,'view)$
out : 'on3ineq_ex(c3co,'view,file_name=\"tmp-c3co\")$
on3gr(out,view)$ ~%
Ex : ineqex({C1|C2|A1|S1|H1a|H2},file_name=\"tmp-S1\",'view)$ ~%"
),
return("--- args = [] ---") /* end of printf */
) /* end of if-then */
else (excase : args[1], args : rest(args,1)),
/* args で指定できる draw オプション dlist */
if true then (
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","on3ineq_ex"),
columns=2, dimensions=[1000,500]],
keyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,keyL),
c1show(progn,dlist)
), /* end of if-false */
/* end of args dlist */
c1show(progn,excase),
c1show(progn,args),
c1show(progn,dlist),
if member(excase,[A2]) then plotmode:false,
display2d_old:display2d,
display2d:false,
/*
exL : [[x^3-6*x^2+9*x-2,2,inf,co]],
exL : append(exL,dlist,[swview])
ex : funmake(on3ineq,exL)
*/
ex12 : [ [[x^3-6*x^2+9*x-2,2,inf,co]] ],
/* c1:[ [[x^2-3*x+2,0,9,co]] ], */
c2oo:[ [[x^2+y^2,1,9,oo]] ],
c2oc:[ [[x^2+y^2,1,9,oc]] ],
c2co:[ [[x^2+y^2,1,9,co]] ],
c2cc:[ [[x^2+y^2,1,9,cc]] ],
C1:[ [[x^3 + y^2 + x*y,1,9,co]], 'xrange=[-4,4],'yrange=[-4,4] ],
C2:[ [[x^2+y^3+2*x*y,1,9,co]], 'xrange=[-5,5],'yrange=[-5,5] ],
/* reveal(out2,6); */
c3oo:[ [[x^2+y^2+z^2,1,9,oo]] ],
c3oc:[ [[x^2+y^2+z^2,1,9,oc]] ],
c3co:[ [[x^2+y^2+z^2,1,9,co]] ],
c3cc:[ [[x^2+y^2+z^2,1,9,cc]] ],
c4oo:[ [[t^2+x^2+y^2+z^2,1,9,oo]] ],
c4oc:[ [[t^2+x^2+y^2+z^2,1,9,oc]] ],
c4co:[ [[t^2+x^2+y^2+z^2,1,9,co]] ],
c4cc:[ [[t^2+x^2+y^2+z^2,1,9,cc]] ],
L3:[ [[x^4+y^3+2*x*y+z^2,1,9,co]] ],
c4:[ [[x^4+y^3,1,9,co]] ],
A1:[ [[y,(x-1)*(x-5)+5,-(x-1)*(x-5)+5,co], [y,-(x-2)+3,(x-2)+3,co]],
'xrange=[0,6],'yrange=[0,10] ],
/*
A2:[ [[(x^2+y^2+z^2)*(y-2),4*(y-2),(y-2),cc],[z-x^2-y^2,1,2,cc]] ],
*/
/*
R30:[ [[((x-1)^2+(y-2)^2+(z-3)^2)*(x^2+y^2+z^2),
minf,((x-1)^2+(y-2)^2+(z-3)^2),oc]] ],
R30b:[ [[(x-8)^2*((x-6)^2+(y-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2)*(x^2+y^2+z^2),
(x-8)^2*((x-6)^2+(y-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2),
4*(x-8)^2*((x-6)^2+(y-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2),cc]] ],
R30c:[ [[(x-8)^2*((y-6)^2+(z-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2)*(x^2+y^2+z^2),
(x-8)^2*((x-6)^2+(y-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2),
4*(x-8)^2*((x-6)^2+(y-7)^2)*((x-3)^2+(y-4)^2+(z-5)^2),cc]] ],
R31:[ [[((y-2)^2+(z-3)^2)*(x^2+y^2+z^2),
minf,((y-2)^2+(z-3)^2),oc]] ],
R32:[ [[((y-2)^2)*(x^2+y^2+z^2), minf,((y-2)^2),oc]] ],
*/
S0:[ [[(x-y)/((x-1)*(y-2)), 1/(x-1), 1/(y-2),co]],'xrange=[-3,5],'yrange=[-2,5] ],
S1:[ [[(x^2-y)/((x-1)*(y-2)), 1/(x-1), 1/(y-2),co]],'xrange=[-4,4],'yrange=[0,5] ],
S2:[ [[(x^5-x*y-y)/((x^4-2)*(y-2)), 1/(x-1), 1/(y-2),co]],
'xrange=[-2,2],'yrange=[0,4] ],
S3:[ [[(x^5-x*y-y)/((x^4-2)*(y-2*x)), 1/(x-1), 1/(y-2),co]],
'xrange=[-4,3],'yrange=[0,5] ],
K1:[ [[(-1+z^2+y^2+x^2)*((y-3)^2+(x-2)^2),0,0,cc]] ],
K2:[ [[(-1+z^2+y^2+x^2)*(y-2),0,0,cc]] ],
H1:[ [[x^2-y^2-(x^2+y^2)^2,0,0,cc]],'xrange=[-1.5,1.5],'yrange=[-1,1] ],
H1a:[ [[x^2-y^2-(x^2+y^2)^2,-1,0,oc]], 'xrange=[-1.5,1.5],'yrange=[-1.5,1.5] ],
H2:[ [[93392896/15625*y^6
+(94359552/625*x^2+91521024/625*x-249088/125)*y^4
+(1032192/25*x^4-36864*x^3-7732224/25*x^2-207360*x+770048/25)*y^2
+65536*x^6+49152*x^5-135168*x^4-72704*x^3+101376*x^2+27648*x-27648,
0,0,cc]],'xrange=[-1.5,1.5],'yrange=[-1.5,1.5] ],
c1show(progn,"---",excase),
ex:ev(excase),
ex : funmake(on3ineq, append(ex,dlist,[swview])),
cshow("=== ■ ■ ■ ",progn, " ■ ■ ■ ==="),cshow(excase),cshow(ev(excase)),
outsum : ev(ex,infeval), /* on3ineq の評価 */
c1show(progn,vsing,V),
return("--end of on3ineq_ex--")
)$ /* end of on3ineq_ex() */
/*############################################################################*/
/*### on3romberg: 1変数on3式のRomberg積分 2020.07.07 ###########################*/
/*############################################################################*/
on3romberg([args]) := block([progn:"<on3romberg>",debug,on3func,
v,vl,vr,eps,w,wsum],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3romberg('help)--
機能: 1変数on3式のRomberg数値定積分
文法: on3romberg(on3func,...)
例示: on3romberg(x*on3(x,1,3,co))
メモ:
--end of on3romberg('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3romberg('ex)--"),
/* on3romberg_ex(), */
block([progn:"<on3romberg_ex>",debug],
c0show(on3romberg(x*on3(x,1,3,co))),
return("---end of on3romberg_ex---")
), /* end of block */
print("--end of on3romberg('ex)--"),
return("--end of on3romberg('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : expand(args[1]),
outLev(on3info(on3func,x),"w_"),
wsum : 0,
for i:1 thru length(w_Lon3coef) do (
v : w_Lon3[i][2], vl:w_Lon3[i][3],vr:w_Lon3[i][4],
w : romberg(w_Lon3coef[i],v,vl,vr),
if constantp(w)=false then (
eps : (vr-vl)*1e-6,
vl : vl + eps, vr : vr - eps,
w : romberg(w_Lon3coef[i],v,vl,vr)
),
wsum : wsum + w,
c1show(i,w_Lon3[i][3],w_Lon3[i][4],w)
),
c1show(wsum),
killvars(["w_"]),
return(wsum)
)$ /* end of on3romberg() */
/*############################################################################*/
/*### on3integ10: on3多項式の数式積分 #########################################*/
/*############################################################################*/
on3integ10([args]) := block([progn:"<on3integ10>",debug,on3func,var,
L,vl,vr,F,sum],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3integ10('help)--
機能: on3多項式の数式積分
文法: on3integ10(on3func,...)
例示: on3integ10(x*on3(x,1,3,co),x)
メモ:
--end of on3integ10('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3integ10('ex)--"),
/* on3integ10_ex(), */
block([progn:"<on3integ10_ex>",debug],
c0show(on3integ10(x*on3(x,1,3,co), x)),
return("---end of on3integ10_ex---")
), /* end of block */
print("--end of on3integ10('ex)--"),
return("--end of on3integ10('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1], var : args[2],
L:f2l(on3std(on3func)), c1show(L), /* change 2012.01.25 */
if L[1]="+" then L:delete(L[1],L) else if L[1]="*" then L:[L], c1show("chk:",L),
sum :0, for i thru length(L) do (
c1show(L[i]),
L[i]:scanmap(lambda([u],if listp(u) and u[1]=on3 and u[2]=var
then (vl:u[3],vr:u[4], u:null) else u),L[i]),
L[i]:delete(null,L[i]),c1show(L[i]),
c1show(vl,vr), ratprint:false,
F : integrate(L[i][2],var), /* 不定積分から */
L[i][2] : ev(F,ev(var)=vr) - ev(F,ev(var)=vl),
c1show(L[i][2]),
sum : l2f(L[i]) + sum
), /* end of for-i */
c1show(sum),
return(sum)
)$ /* end of on3integ10() */
/*############################################################################*/
/*### nor2d : 2変量正規分布の密度関数 ##########################################*/
/*############################################################################*/
nor2d([args]) := block([progn:"<nor2d>",debug,x,y,mx,my,sx,sy,r,
c1,c2,zx,zy,out,swview,figfile],
debug:ifargd(),
if member('noview,args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of nor2d('help)--
機能: 2変量正規分布の密度関数
文法: nor2d(x,y,mx,my,sx,sy,r,...)
例示: nor2d(x,y,0,0,1,1,0.7)
--end of nor2d('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of nor2d('ex)--"),
/* nor2d_ex(), */
block([cmds,f],
figfile : sconcat(figs_dir,"/","nor2d"),
cmds : sconcat("( ",
"f : nor2d(x,y,0,0,1,1,0.7), /* 2次元正規分布の密度関数置数 */ @",
"gr3v([explicit(f,x,-4,4,y,-4,4)],'title=\"plot of nor2d\",@",
"'file_name=",figfile,", ", swview, "), /* fの描画 */ @",
"c0show(f) /* f の標示 */",
" )"),
chk1show(cmds,""),
return(f)
), /* end of block */
print("--end of nor2d('ex)--"),
return("--end of nor2d('ex)--"),
block_main, /* main ブロック ====================================*/
x:args[1], y:args[2], mx:args[3], my:args[4], sx:args[5], sy:args[6], r:args[7],
c1:1/(2*%pi*sx*sy*sqrt(1-r^2)),
zx:(x-mx)/sx, zy:(y-my)/sy,
c2:-1/(2*(1-r^2))*(zx^2 -2*r*zx*zy+zy^2),
out: c1 * exp(c2), c1show(out),
return(out)
)$ /* end of nor2d() */
/*############################################################################*/
/*### q3 : 2変量正規分布の領域確率 ############################################*/
/*############################################################################*/
q3([args]) := block([progn:"<q3>",debug,swview,plotmode:true,viewmode:true,cmds,
D0,x,y,f,Fxy0,Fx0,F0,F0ans,fdens,D,Fxy,Fx,P,Pans,dlist, keyL, key, g0,g],
debug:ifargd(),
if member('noview,args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of q3('help)--
機能: 2変量正規分布の領域[[x+y,2,inf,co],[x,-4,1,cc],[y,-4,4,cc]]の確率を求め図示する
文法: q3({'help|'ex|'go},...)
例示: q3('go, 'file_name=\"sconcat(figs_dir,'/','q3')\", 'columns=2, 'dimensions=[1000,500])
--end of q3('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of q3('ex)--"),
print(" --> q3('go))"),
/* q3_ex(), */
print("--end of q3('ex)--"),
return("--end of q3('ex)--"),
block_main, /* main ブロック ====================================*/
/* args で指定できる draw オプション dlist */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","q3"),
columns=2, dimensions=[1000,500]],
keyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,keyL),
cshow(progn,dlist),
if member('noplot,args) then plotmode:false,
if member('noview,args) then viewmode:false,
cmds : sconcat("( ",
"/* 領域D0の設定, 相関のある2変量標準正規分布の確率密度関数 f の設定 */ @",
"D0:on3ineq([[x,-4,4,cc],[y,-4,4,cc]],'resultonly,'noview), @",
"f:nor2d(x,y, 0,0, 1,1, 0.7), /* 相関のある2変量標準正規分布の確率密度関数 */ @",
"Fxy0:expand(f*D0), Fx0:on3integ19(Fxy0,y,minf,inf), F0:on3romberg(Fx0),",
"cshow(F0) @",
" )"),
F0ans : 0.99987821,
chk1show(cmds,F0ans),
cmds : sconcat("( ",
"fdens:f/F0, /* 打ち切り領域 D0 上の確率密度関数 */ @",
"cshow(f,F0,fdens), @",
"D:on3ineq([[x+y,2,inf,co],[x,-4,1,cc],[y,-4,4,cc]],'resultonly,'noplot,'noview), @",
"Fxy:expand(fdens*D), Fx:on3integ19(Fxy,y,minf,inf), P : on3romberg(Fx)",
" )"),
Pans : 0.027532472,
chk1show(cmds,Pans),
if plotmode then (
g0:gr3d(title="fdens",line_width=1,xu_grid=60,yv_grid=60,
enhanced3d=false, zrange=[0,0.25],
explicit(fdens,x,-4,4,y,-4,4)),
g:gr3d(title="fdens on D", line_width=1,xu_grid=60,yv_grid=60,
enhanced3d=false, zrange=[0,0.25],
explicit(Fxy,x,-4,4,y,-4,4)),
mk_draw([g0, g], dlist, swview)
),
return(P)
)$ /* end of q3() */
/*############################################################################*/
/*### q4 : 2変量正規分布の領域確率2 ############################################*/
/*############################################################################*/
q4([args]) := block([progn:"<q4>",debug, plotmode:true, viewmode:true, swview,
dlist, keyL, key, cmds, Pans,
D,x,y,f,Fxy,Fx,P,g2,g],
debug:ifargd(),
if member('noview,args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of q4('help)--
機能: 2変量正規分布の領域[[x^3+x*y+y^2,1,9,co],[y,-4,4,co]]の確率を求め図示する
文法: q4({'help|'ex|'go},...)
例示: q4('go, 'file_name=\"q4\", 'columns=2, 'dimensions=[1000,500])
--end of q4('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of q4('ex)--"),
print(" --> q4('go))"),
/* q4_ex(), */
print("--end of q4('ex)--"),
return("--end of q4('ex)--"),
block_main, /* main ブロック ====================================*/
c1show(args),
/* args で指定できる draw オプション dlist */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","q4"),
columns=2, dimensions=[1000,500]],
keyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,keyL),
c1show(dlist),
if member('noplot,args) then plotmode:false,
if member('noview,args) then viewmode:false,
cmds : sconcat("( ",
"/* 定義域 D 上の関数 f=f(x,Y) の積分 */ @",
"D:on3ineq([[x^3+x*y+y^2,1,9,co],[y,-4,4,co]],'resultonly,'noplot,'noview), @",
"print(\"D = \",D), @",
"f0:exp(-(x^2+y^2)/2)/(2*%pi), Fxy:expand(f0 * D), @",
"print(\"Fxy=\",Fxy), @",
"Fx:on3integ19(Fxy,y,minf,inf), @",
"print(\"Fx=\",Fx), @",
"P:on3romberg(expand(Fx)), @",
"print(\"P=\",P) ",
" )"),
Pans : 0.36309648,
chk1show(cmds,Pans),
if plotmode then (
g2:on3gr2(D,'argsL=['xrange=[-4,4],'yrange=[-4.5,4.5]],'noview), /* caution */
if stringp(g2) then g2 : eval_string(g2), /* 注意 */
g:gr3d(line_width=1,xu_grid=60,yv_grid=60,enhanced3d=false,
explicit(Fxy,x,-4,4,y,-4,4)),
mk_draw([g2, g], dlist, swview)
),
return(P)
)$ /* end of q4() */
/* ex1: on3ineq([(x-y)/((x-1)*(y-2)), 1/(x-1), 1/(y-2),co])
ex2: C2 C2:funmake(on3ineq,[[x^2+y^3+2*x*y,1,9,co]]),
ex3: H1a H1a:funmake(on3ineq,[[x^2-y^2-(x^2+y^2)^2,-1,0,oc]]),
ex4: H2:funmake(on3ineq,
[[(93392896/15625)*y^6
+((94359552/625)*x^2+(91521024/625)*x +(-249088)/125)*y^4
+((1032192/25)*x^4-36864*x^3+((-7732224)/25)*x^2
+(-207360)*x+770048/25)*y^2
+65536*x^6+49152*x^5+(-135168)*x^4
+(-72704)*x^3+101376*x^2+27648*x-27648, 0,0,cc]]),
ex5: S1:funmake(on3ineq,[[(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co]]),
ex6: A1:funmake(on3ineq,
[[[y,(x-1)*(x-5)+5,(-(x-1))*(x-5)+5,co],[y,(-(x-2))+3,(x-2)+3,co]]]),
ex7: q3(file_name="tmp-q3",'noview)$
ex8: q4(file_name="tmp-q4",'noview)$
if member(excase,['H1,'H2,'H1a])
then (dxlr:[xl,xr,nx]:[-2,2,50], dylr:[yl,yr,ny]:[-2,2,50])
else if member(excase,['A1]) then
(dxlr:[xl,xr,nx]:[0, 6, 50], dylr:[yl,yr,ny]:[-2, 10, 50])
else if member(excase,['S1]) then
(dxlr:[xl,xr,nx]:[-4, 4, 50], dylr:[yl,yr,ny]:[0, 5, 50])
else if member(excase,['S2]) then
(dxlr:[xl,xr,nx]:[-2, 2, 50], dylr:[yl,yr,ny]:[0, 3, 50])
else if member(excase,['c3oo,'c3oc,'c3co,'c3cc]) then
(dxlr:[xl,xr,nx]:[-3, 3, 50], dylr:[yl,yr,ny]:[-3, 3, 50])
else (dxlr:[xl,xr,nx]:[-5, 5, 50], dylr:[yl,yr,ny]:[-5, 5, 50]),
*/
/*############################################################################*/
/*### extry : yrange の指定方法の試み ##################################*/
/*############################################################################*/
extry([args]) := block([progn:"<extry>",debug],
debug: ifargd(),
/* yrange の指定方法の試み */
gr2L0 : [title="gr2v plot",
grid=true, line_width=1.8,
color=colorL[1], key=keyL[1], line_type=line_typeL[1], yrange='auto
/* yrange=[yl,yr], key_pos=top_right, */
/* explicit(sin(x), x,-%pi,%pi), */
],
c1show(gr2L0),
gr2L : copylist(gr2L0),
/* gr2L の更新･追加 */
tlist : ['yrange='auto],
gkeyL : ['title, 'grid, 'line_width, 'color, 'key, 'line_type,
'xrange, 'yrange, 'zrange, 'key_pos],
gr2L : mergeL(gr2L,tlist,gkeyL), /* call mergeL */
/* yrange='auto の場合 */
c1show(progn,"start auto yrange"),
c1show(funcs),c1show(gr2L),c1show(find_key(gr2L,'yrange)),
if rhs(find_key(gr2L,'yrange)) = 'auto then (
yexp : exp2l(funcs[1],'explicit)[1],
cshow(yexp),
/* [func,var,vl,vr] : exp,
autoyrange : mk_range(func,ev(var),vl,vr),
*/
autoyrange : mk_range(yexp), /* yrange を自動作成 */
cshow(autoyrange),
gr2L[find_key_no(gr2L,'yrange)] : 'yrange = autoyrange,
cshow(gr2L)
),
c1show(progn, gr2L),
return("--end of extry--")
)$ /* end of extry() */
/*############################################################################*/
/*### on3ineq_jex : JJAS の例 ##########################################*/
/*############################################################################*/
on3ineq_jex([args]) := block([progn:"<on3ineq_jex>",debug,Lex0,ex7,ex8,swview],
debug: ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3ineq_jex('help)--
機能: JJAS 2011 の例題を検証する
文法: on3ineq_jex({'help|'ex|'go},...)
例示: on3ineq_jex('go)$ 全ての例題ex0,ex1,...,ex8 を実行
on3ineq_jex('go, [ex0,ex3])$ 例題ex0,ex3のみ実行
--end of on3ineq_jex('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3ineq_jex('ex)--"),
/* on3ineq_jex_ex(), */
on3ineq_jex('go, [ex0,ex1,ex2,ex3,ex4,ex5,ex6,ex7,ex8],swview),
print("--end of on3ineq_jex('ex)--"),
return("--end of on3ineq_jex('ex)--"),
block_main, /* main ブロック ====================================*/
Lex0 : ['ex0,'ex1,'ex2,'ex3,'ex4,'ex5,'ex6,'ex7,'ex8],
if length(args) >= 2 and listp(args[2]) then Lex0 : args[2],
print("実行例リスト: Lex = ",Lex0),
/* system("mkdir /tmp/fig > /dev/null 2>&1 "), */
if false then on3ineq(), /* on3ineq('help), */
if false then on3ineq('ex),
if member('ex0,Lex0) then
on3ineq([x^2+y^2,1,9,co],
'title="ex0:c2co",'xrange=[-3.5, 3.5],'yrange=[-3.5, 3.5],
'file_name=sconcat(figs_dir,"/","jjas-ex0"),swview,'resultonly,'nooutsum),
if member('ex1,Lex0) then
on3ineq([(x-y)/((x-1)*(y-2)), 1/(x-1), 1/(y-2),co],
'title="ex1", 'xrange=[-2, 6],'yrange=[0, 4],
'file_name=sconcat(figs_dir,"/","jjas-ex1"),swview,'resultonly,'nooutsum),
if member('ex2,Lex0) then
on3ineq([[x^2+y^3+2*x*y,1,9,co]],
'title="ex2:C2", 'xrange=[-5, 5],'yrange=[-5, 5],
'file_name=sconcat(figs_dir,"/","jjas-ex2"),swview,'resultonly,'nooutsum),
if member('ex3,Lex0) then
on3ineq([[x^2-y^2-(x^2+y^2)^2,-1,0,oc]],
'title="ex3:H1a", 'xrange=[-1.5, 1.5],'yrange=[-1.5, 1.5],
'file_name=sconcat(figs_dir,"/","jjas-ex3"),swview,'resultonly,'nooutsum),
if member('ex4,Lex0) then
on3ineq([[(93392896/15625)*y^6
+((94359552/625)*x^2+(91521024/625)*x +(-249088)/125)*y^4
+((1032192/25)*x^4-36864*x^3+((-7732224)/25)*x^2
+(-207360)*x+770048/25)*y^2
+65536*x^6+49152*x^5+(-135168)*x^4
+(-72704)*x^3+101376*x^2+27648*x-27648, 0,0,cc]],
'title="ex4:H2",'xrange=[-1.5, 1.5],'yrange=[-1.5, 1.5],
'file_name=sconcat(figs_dir,"/","jjas-ex4"),swview,'resultonly,'nooutsum),
if member('ex5,Lex0) then
on3ineq([[(x^2-y)/((x-1)*(y-2)),1/(x-1),1/(y-2),co]],
'title="ex5:S1",'xrange=[-4, 4],'yrange=[0, 5],
'file_name=sconcat(figs_dir,"/","jjas-ex5"),swview,'resultonly,'nooutsum),
if member('ex6,Lex0) then
on3ineq([[y,(x-1)*(x-5)+5,(-(x-1))*(x-5)+5,co],[y,(-(x-2))+3,(x-2)+3,co]],
'title="ex6:A1",'xrange=[0, 6],'yrange=[-2, 10],
'file_name=sconcat(figs_dir,"/","jjas-ex6"),swview,'resultonly,'nooutsum),
if member('ex7,Lex0) then
q3('go,'file_name=sconcat(figs_dir,"/","jjas-ex7"),swview,'resultonly,'nooutsum),
if member('ex8,Lex0) then
q4('go,'file_name=sconcat(figs_dir,"/","jjas-ex8"),swview,'resultonly,'nooutsum),
return("--end of on3ineq_jex--")
)$ /* end of on3ineq_jex */
/*############################################################################*/
/*### chk1g ####################################################################*/
/*############################################################################*/
chk1g([args]) := block([progn:"<chk1g>",debug, plotmode:true, viewmode:true,
x,y,z,x0,ex,out,ex1,out1],
debug:ifargd(),
if member('noplot,args) then plotmode:false,
if member('noview,args) then viewmode:false,
if length(args)>0 and numberp(args[1]) then x0:args[1] else x0:1/2, cshow(x0),
/* epsk:[1.e-5,1.e-2], */ epsk:[1.e-5,1.e-2],
ex: x^4+y^3+y*z+z^2, /* x0:1/2, x0:1 */
out:on3ineq([[ex,1,9,co]]),
out:ev(out,x=x0), out:l2f(map(expand,f2l(out))), cshow(out),
ex1:ev(ex,x=x0),
out1:on3ineq([[ex1,1,9,co]]), cshow(out1),
cshow(out-out1),
if plotmode=true then (
gout : on3gr2(out, xrange=[-3,3],yrange=[-4,4]),
gout1 : on3gr2(out1,xrange=[-3,3],yrange=[-4,4]),
c1show(gout), c1show(gout1),
grv(gout, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk1g-1"),'noview),
grv(gout1, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk1g-2"),'noview),
if viewmode then grv(gout,gout1,dimensions=[1800,2700])
), /* end of if-plotmode */
return("---end of chk1g ---")
)$ /* end of chk1g() */
/*############################################################################*/
/*### chk2g ####################################################################*/
/*############################################################################*/
chk2g([args]) := block([progn:"<chk2g>",debug, plotmode:true, viewmode:true,
x,y,z,x0,ex,out,ex1,out1],
debug:ifargd(),
if member('noplot,args) then plotmode:false,
if member('noview,args) then viewmode:false,
epsk:[1.e-8,1.e-5],
ex: z^4+x^3+x*y+x^2,x0:-1,
out:on3ineq([[ex,1,9,co]]),
out:ev(out,x=x0), cshow(out),
ex1:ev(ex,x=x0),
out1:on3ineq([[ex1,1,9,co]]), cshow(out1),
cshow(out-out1),
if plotmode then (
gout : on3gr2(out, xrange=[-15,55],yrange=[-5,5]),
gout1 : on3gr2(out1,xrange=[-15,55],yrange=[-5,5]),
c1show(gout),c1show(gout1),
grv(gout, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk2g-1"),'noview),
grv(gout1, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk2g-2"),'noview),
if viewmode then grv(gout,gout1,dimensions=[1800,2700])
), /* end of if-plotmode */
return("---end of chk2g ---")
)$ /* end of chk2g() */
/*############################################################################*/
/*### chk3g ####################################################################*/
/*############################################################################*/
chk3g([args]) := block([progn:"<chk3g>",debug, plotmode:true, viewmode:true,
x,y,z,x0,ex,out,ex1,out1],
debug:ifargd(),
if member('noplot,args) then plotmode:false,
if member('noview,args) then viewmode:false,
epsk:[1.e-8,1.e-5],
ex: y^4+z^3+z*x+x^2,x0:1,
out:on3ineq([[ex,1,9,co]]),
out:ev(out,x=x0), cshow(out),
ex1:ev(ex,x=x0),
out1:on3ineq([[ex1,1,9,co]]), cshow(out1),
cshow(out-out1),
if plotmode then (
gout : on3gr2(out, xrange=[-5,5],yrange=[-5,5]),
gout1 : on3gr2(out1,xrange=[-5,5],yrange=[-5,5]),
c1show(gout), c1show(gout1),
grv(gout, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk3g-1"),'noview),
grv(gout1, dimensions=[1000,700],file_name=sconcat(figs_dir,"/","chk3g-2"),'noview),
if viewmode then grv(gout,gout1,dimensions=[1800,2700])
), /* end of if-plotmode */
return("---end of chk3g ---")
)$ /* end of chk3g() */
/*############################################################################*/
/*### globalvar: Maxima Global Variable Display ##############################*/
/*############################################################################*/
globalvar([args]) := block([progn:"<globalvar>",debug],
debug:ifargd(),
c0show("=== Maxima Global Variable Display ==="),
c0show(domain,"{real*,complex}:多項式の係数環を指定（参照 m1pbranch)"),
c0show(fpprec,"{16*,正整数}:bigfloat型の桁数指定"),
c0show(fpprintprec,"{0*,正整数}:bigfloat型の表示桁数指定"),
c0show(float2bf,"{true*,false}:float->bigfloat変換時に計算精度落ち警告表示の有無"),
c0show(m1pbranch,
"{true,false*}:(-1)^(1/4) -> (1+%i)/sqrt(2)等の自動変換の有無(domain:complexで使用)"),
c0show(radexpand,"{true*,false}:sqrt(a^2*b) -> abs(a)*sqrt(b) の自動変換の有無"),
c0show(keepfloat,"{true,false*}:浮動小数の有理数表現への近似の有無(参照 rat)"),
c0show(ratepsilon,"{2.0E-8*}:浮動小数の有理数近似の誤差"),
c0show(ratalgdenom,"{true*,false}:代数的整数(sqrt(2)等)を分母とする項の有理化を制御"),
c0show(ratprint,"{true*,false}:CRE表現への変換時の警告表示の有無"),
c0show(ratdenomdivide,"{true*,false}:(a1+a2)/b -> a1/b + a2/b の分離の有無"),
c0show(ratexpand,"{true,false*}: CRE表現の展開の制御"),
c0show(ratfac,"{true,false*}:CRE表現の因子分解の制御"),
c0show(ratsimpexpons,"{true,false*}:式中の冪に対しratsimpの自動実行制御"),
c0show(rootsconmode,"{true*,false,all}:冪の合併a^(1/2)*y^(1/4)->(a*b^(1/2)^(1/2)"),
c0show(algexact,"{true,false*}:厳密解のみを求めるか近似解を許すかを指定"),
c0show(realonly,"{true,false*}:実数解(%iを含まない解)に限定するか否かを指定"),
c0show(algepsilon,"{10^8*}:algsysの精度指定 (低<->高精度)"),
c0show("=== on3ineqlib 関連 ===================================================="),
c0show(on3floatnump,"{true,false}:algsysの結果:近似解(true),厳密解(false)を返す"),
c0show(restlr,"{[minf,inf]*,[xl,xr]}:第1変数解の範囲を制限したいときに指定する"),
c0show(outlineonly,"{true,false*}:開閉処理をしないときtrueとする"),
c0show(flimitmode,"{true*,false}:左右極限値評価を浮動小数モードで行うときtrueとする"),
c0show(resultonly,"{true,false*}:最終結果のみを表示する場合にtrueとする"),
c0show(chkerrsum,":結果を事前に設定された解と照合し,不一致となった回数を計測する"),
return("==========================")
)$
/*####### begin replace 2019.07.26 ####################################*/
/*############################################################################*/
/*** リストからキー名を含む最初の要素を取り出す ***/
/*############################################################################*/
find_key([args]) := block([progn:"<find_key>",list,key, a,w,out],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of find_key('help)--
機能: キー付きリストからキー名を含む最初の要素を取り出す. キー名がない場合はFALSEを返す.
文法: find_key(list,key,...)
例示: find_key([key1=a,key2=b,key3=c],key2) -> key2=b
--end of find_key('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of find_key('ex)--"),
/* find_key_ex(), */
block([progn:"<find_key_ex>",debug,dlist],
debug:ifargd(),
print("--begin of find_key_ex"),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","find_key-1"),
columns=2, dimensions=[1000,400]],
c0show(dlist),
c0show(find_key(dlist,'columns)),
c0show(find_key(dlist,'file_name)),
c0show(find_key(dlist,'not_key_name)),
return("--end of find_key_ex--")
), /* end of block */
print("--end of find_key('ex)--"),
return("--end of find_key('ex)--"),
block_main, /* main ブロック ====================================*/
list : args[1], key : args[2],
if listp(list) = false then (
cshow(progn,list,"-> not list"), return(false)),
chk(a) := if lhs(a) = key then true,
w : sublist(list,chk), /* call sublist */
c1show(progn," : w = ",w),
if length(w) > 0 then out : w[1] else out : false,
return(out)
)$ /* end of find_key() */
/*+++ find_key_ex +++++++++++++++++++++++++++++++++++++++++*/
find_key_ex([args]) := block([progn:"<find_key_ex>",debug,dlist],
debug:ifargd(),
print("--begin of find_key_ex"),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","find_key-2"),
columns=2, dimensions=[1000,400]],
cshow(dlist),
cshow(find_key(dlist,'columns)),
cshow(find_key(dlist,'file_name)),
cshow(find_key(dlist,'not_key_name)),
return("--end of find_key_ex--")
)$ /* end of find_key_ex() */
/*############################################################################*/
/*** リストからキー名を含む要素の位置を取り出す ***/
/*############################################################################*/
find_key_no([args]) := block([progn:"<find_key_no>",debug,list,key, klist,ii],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of find_key_no('help)--
機能: キー付きリストからキー名を含む要素の位置を取り出す
文法: find_key_no(list,key,...)
例示: find_key_no([key1=a,key2=b,key3=c],key2); -> 2
find_key_no([key1=a,key2=b,key3=c],key4); -> 0
--end of find_key_no('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of find_key_no('ex)--"),
/* find_key_no_ex(), */
block([progn:"<find_key_no_ex>",debug,dlist],
debug:ifargd(),
print("--begin of find_key_no_ex"),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","find_key_no-1"),
columns=2, dimensions=[1000,400]],
c0show(dlist),
c0show(find_key_no(dlist,'columns)),
c0show(find_key_no(dlist,'file_name)),
return("--end of find_key_no_ex")
), /* end of block */
print("--end of find_key_no('ex)--"),
return("--end of find_key_no('ex)--"),
block_main, /* main ブロック ====================================*/
list : args[1], key : args[2],
c1show(list,key),
if listp(list) = false then (
c1show(progn,list,"-> not list"), return(false)),
klist : map(lhs,list), ii : 0,
c1show(klist),
for i thru length(klist) do if klist[i] = key then ii:i,
return(ii)
)$ /* end of find_key_no() */
/*+++ find_key_no_ex +++++++++++++++++++++++++++++++++++++++++*/
find_key_no_ex([args]) := block([progn:"<find_key_no_ex>",debug,dlist],
debug:ifargd(),
print("--begin of find_key_no_ex"),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","find_key_no-2"),
columns=2, dimensions=[1000,400]],
cshow(dlist),
cshow(find_key_no(dlist,'columns)),
cshow(find_key_no(dlist,'file_name)),
return("--end of find_key_no_ex")
)$ /* end of find_key_no() */
/*############################################################################*/
/*### args_flat : 関数引数に'argsL=[..]の要素をフラットにする ###*/
/*############################################################################*/
args_flat([args]) := block([progn:"<args_flat>",debug,
keyno,argsL, args1, argsL0,on3fin,Lin,in,out],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of args_flat('help)--
機能: 関数引数に'argsL=[..]が存在するとき,その要素をフラットにする
文法: args_flat(x,y,...)
例示: args_flat([args])
メモ: args=[a1,[a2,[a31,a32]], 'argsL=['xrange=[1,2], 'yrange=[3,4], ...]]
-> flat_args = [a1,[a2,[a31,a32]], 'xrange=[1,2], 'yrange=[3,4], ...]
注: flatten(args) ではargsの第2成分のリスト構造が壊れる
--end of args_flat('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of args_flat('ex)--"),
/* args_flat_ex(), */
block([on3fin,Lin,argsL0,in,out],
on3fin : x^2*on3(x,1,3,co) + x * on3(x,2,4,co),
Lin : f2l_one(on3fin),
argsL0 : ['xrange=[1,2],'yrange=[3,4]],
print("--begin of args_flat('ex)--"),
print("例1.argsL=が存在するとき"),
in : 'args_flat(on3fin,Lin,'viewmode=true,'argsL=argsL0),
out : ev(in, nouns, infeval),
print("入力",in), print("結果",out),
print("例2.argsL=が存在しないとき"),
in : 'args_flat(on3fin,Lin,'viewmode=true,'xrange=[1,2],'yrange=[3,4]),
out : ev(in, nouns),
print("入力",in), print("結果",out),
return(out)
), /* end of block */
print("--end of args_flat('ex)--"),
return("--end of args_flat('ex)--"),
block_main, /* main ブロック ====================================*/
/* 関数本体 */
if listp(args[1])= true then args1 : copylist(args[1]),
c1show(progn,args1),
c1show(progn,length(args1),length(args1)),
c1show(progn,args1),
keyno : find_key_no(args1,'argsL),
c1show(progn,keyno),
if keyno > 0 then (
argsL : rhs(args1[keyno]),
c1show(progn,"find;",argsL),
args1[keyno] : 'del, args1 : delete('del, args1),
c1show(args1),
args1 : append(args1,argsL)
),
c1show(progn,"after:", args1),
return(args1)
)$ /* end of args_flat() */
/*############################################################################*/
/*** mk_fullname() : draw 関数の引数 file_name, terminal から fullname を生成する */
/*############################################################################*/
mk_fullname([args]) := block([progn:"<mk_fullname>",debug,dlist, sname,ext,fullname],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of mk_fullname('help)--
機能: draw 関数の引数 file_name, terminal から fullname を生成する
文法: mk_fullname(dlist)
例示: mk_fullname([file_name=\"tmp\",'terminal='png])
-> \"tmp.png\"
--end of mk_fullname('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of mk_fullname('ex)--"),
/* mk_fullname_ex(), */
block([],
c0show(mk_fullname([file_name=sconcat(figs_dir,"/","mk_fullname"),'terminal='png])),
return()
), /* end of block */
print("--end of mk_fullname('ex)--"),
return("--end of mk_fullname('ex)--"),
block_main, /* main ブロック ====================================*/
dlist : args[1],
sname : find_key(dlist,'file_name),
ext : find_key(dlist,'terminal),
fullname : sconcat(rhs(sname),".",rhs(ext)),
return(fullname)
)$ /* end of mk_fullname() */
/*############################################################################*/
/*** fna() : fullname から [dir,sname,ext] を生成する ***/
/*############################################################################*/
fna([args]) := block([progn:"<fna>",debug,fullname, dir,sname,ext],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of fna('help)--
機能: 文字列 fullname から 文字列リスト [dir,sname,ext] を生成する
文法: fna(fullname)
例示: fna(\"tmp.png\") -> [\"/tmp/\", \"tmp\", \"png\"]
--end of fna('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of fna('ex)--"),
/* fna_ex(), */
block([],
c0show(fna("/tmp/tmp.png")),
return()
), /* end of block */
print("--end of fna('ex)--"),
return("--end of fna('ex)--"),
block_main, /* main ブロック ====================================*/
fullname : args[1],
dir : pathname_directory(fullname), /* /tmp/lang/ */
sname : pathname_name(fullname), /* tmp1 */
ext : pathname_type(fullname), /* png */
return([dir,sname,ext])
)$ /* end of fna() */
/*############################################################################*/
/*** list2str リストの全ての要素を文字列化する *****************************/
/*############################################################################*/
list2str([args]) := block([progn:"<list2str>",debug,list, str],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of list2str('help)--
機能: リストの全ての要素を文字列化する
文法: list2str(list)
例示: list2str(['color=blue, (x+y)^2, title=\"test\"])
-> \"color = blue, (y+x)^2, title = \"test\"\"
--end of list2str('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of list2str('ex)--"),
/* list2str_ex(), */
block([exp1,L,out],
exp1 :(x+y)^2,
L : ['color=blue, exp1, file_name=sconcat(figs_dir,"/","list2str"), terminal='png],
c0show(exp1),
c0show(L),
c0show(map(stringp,L)),
c0show(list2str(L)),
c0show(stringp(list2str(L))),
return('noormal_return)
), /* end of block */
print("--end of list2str('ex)--"),
return("--end of list2str('ex)--"),
block_main, /* main ブロック ====================================*/
list : args[1],
if listp(list) = false then return("-- not list"),
if length(list) = 1 then (str : string(list[1]), return(str)),
str : string(list[1]),
for i:2 thru length(list) do (
str : sconcat(str,", ",list[i])
),
return(str)
)$ /* end of list2str() */
/*+++ list2str リストの全ての要素を文字列化する ++++++++++++++++++++++++*/
list2str_ex([args]) := block([progn:"<list2str_ex>",exp1,L,out],
cshow("-- begin of ",progn," --"),
exp1 :(x+y)^2,
L : ['color=blue, exp1, file_name=sconcat(figs_dir,"/","lit2str"), terminal='png],
cshow(exp1),
cshow(L),
out : list2str(L),
cshow(out),
return("-- end of <list2str> --")
)$ /* end of list2str_ex() */
/*############################################################################*/
/*### ush : system("unix-shell-command") #############################*/
/*############################################################################*/
ush([args]) := block([progn:"<ush>",debug,swview,script, cmd],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of ush('help)--
機能: xとyの和を求める
文法: ush(script,...)
例示: ush(\"eog tmp.png\")
--end of ush('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of ush('ex)--"),
/* ush_ex(), */
block([script],
script : "eog tmp.png",
c0show(script,",", stringp(script)),
if member('noview,args) then c0show("実行を省略する") else c0show(ush(script)),
return('normal_return)
), /* end of block */
print("--end of ush('ex)--"),
return("--end of ush('ex)--"),
block_main, /* main ブロック ====================================*/
script : args[1],
c1show(progn,script,stringp(script)),
if stringp(script) = false then
return("** Error : <script> is not string **"),
cmd : funmake(system, [script]),
return(ev(cmd))
)$ /* end of ush() */
/*############################################################################*/
/*** mk_draw 2019.07.07 ************************************/
/*############################################################################*/
mk_draw([args]) := block([progn:"<mk_draw>",debug,glist,dlist,cmds,g1,g2,
now,tlist,dlist0,dkeyL, alist,drawfunc,fullname,cmd,swview],
debug : ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of mk_draw('help)--
機能: 複数のグラフィックオブジェクトをdraw()に引き継ぎ作画する
文法: mk_draw(glist,dlist,...)
例示: mk_draw([g1,g2],dlist)
mk_draw()$ or mk_draw('help)$ /* このヘルプを標示する */
mk_draw('ex)$ /* 例を実行する */
g1 : gr2d(title=\"sin(x) and cos(x)\",
grid=true, yrange=[-1.25, 1.25], line_width=1.8,
color=blue, key=\"sin(x)\", line_type=solid,
explicit(sin(x), x,-%pi,%pi),
color=red, key=\"cos(x)\", line_type=dots,
explicit(cos(x), x, -%pi,%pi)
),
f(x,y) := (x+y+5)*on3(sqrt(x^2+y^2),2,3,co),
g2 : gr3d(enhanced3d=false, surface_hide=true, nticks=5, xu_grid=40,
title=\"example of f(x,y)\",
xlabel=\"x\", ylabel=\"y\", zlabel=\"z = f(x,y)\",
explicit(f(x,y), x,-3.5,3.5, y,-3.5,3.5)
),
glist : [g1,g2], /* gr2d, gr3d で生成されたグラフィックオブジェクトのリスト */
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, 'file_name=sconcat(figs_dir,'/','mk_draw-ex'),
columns=2, dimensions=[1000,400]],
if member('noview, args) then mk_draw(glist,dlist,'noview)
else mk_draw(glist,dlist,'view), /* mk_draw 関数の呼び出し */
mk_draw([g1,g2],
['file_name=sconcat(figs_dir,'/','gr2v'), 'columns=2, 'dimensions=[1000, 500]],
'view)$
--end of mk_draw('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of mk_draw('ex)--"),
/* mk_draw_ex(), */
block([cmds,figfile],
figfile : sconcat(figs_dir,"/","mk_draw"),
cmds : sconcat("( ",
" /* 例1. */ @",
sconcat("g1 : gr2v([explicit(sin(x),x,-%pi,%pi), ",
"explicit(cos(x),x,-%pi,%pi)], @",
" 'yrange=[-1.2,1.2], 'title=\"ex1-1 of mk-draw\", 'noview), @"),
sconcat("g2 : gr2v([implicit(x^2+y^2=1, x,-1,1, y,-1,1)], ",
" 'xrange=[-1.1, 1.1], 'yrange=[-1.1, 1.1], ",
" 'title=\"ex1-2 of mk-draw \", 'noview), @"),
sconcat("mk_draw([g1,g2], @",
"['file_name=figfile,'columns=2,'dimensions=[1000, 500]],",
swview, ") @"),
" )"),
chk1show(cmds,""),
return('normal_end)
), /* end of block */
print("--end of mk_draw('ex)--"),
return("--end of mk_draw('ex)--"),
block_main, /* main ブロック ====================================*/
glist : args[1], dlist : args[2], /* 実質引数 */
/* dlist : draw() 関数の引数のリスト : 標準値とその変更*/
tlist : copylist(dlist), /* tlist=dlist をtランザクションとしてdlist0を更新する */
dlist0 : [terminal='png, file_name=sconcat(figs_dir,"/","mk_draw"),
columns=1, dimensions=[600,500]], /* dlistの初期値リスト */
dkeyL : ['terminal, 'file_name, 'columns, 'dimensions], /* 必須項目 */
dlist0 : mergeL(dlist0,tlist,dkeyL), /* call mergeL */
c1show("mk_draw : 更新結果",dlist0),
alist : append(glist,dlist0),
d1show(progn,alist),
drawfunc : funmake(draw, alist), /* draw() 関数の生成 */
( now : display2d, display2d:false,
d1show(progn,drawfunc),
display2d : now),
ev(drawfunc), /* draw 関数の評価実行 dlist[file_name=*.png ファイルに出力 */
/* fna(fullname), */
fullname : mk_fullname(dlist0), /* dlist からグラフ出力ファイル名を生成する */
cmd : funmake(system, [sconcat("eog ",fullname)]),
if member('view, args) then ( /* args に'viewが指定されたとき */
ev(cmd), /* ビューコマンド cmd の実行 */
d1show(progn, cmd),
c0show(progn," : View --->",cmd)
), /* end of 'view */
c1show(progn," : View --->",cmd),
return("-- end of mk_draw --")
)$ /* end of mk_draw() */
/*** mk_draw_ex ***************************************************/
mk_draw_ex([args]) := block([progn:"<mk_draw_ex>",g1,g2,glist,dlist,swview],
if member('noview, args) then swview:'noview else swview:'view,
print("-- ",progn," is started --"),
g1 : gr2d(title="sin(x) and cos(x)",
grid=true, yrange=[-1.25, 1.25], line_width=1.8,
color=blue, key="sin(x)", line_type=solid,
explicit(sin(x), x,-%pi,%pi),
color=red, key="cos(x)", line_type=dots,
explicit(cos(x), x, -%pi,%pi)
),
f(x,y) := (x+y+5)*on3(sqrt(x^2+y^2),2,3,co),
g2 : gr3d(enhanced3d=false, surface_hide=true, nticks=5, xu_grid=40,
title="example of f(x,y)",
xlabel="x", ylabel="y", zlabel="z = f(x,y)",
explicit(f(x,y), x,-3.5,3.5, y,-3.5,3.5)
),
glist : [g1,g2], /* gr2d, gr3d で生成されたグラフィックオブジェクトのリスト */
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","mk_draw_ex"),
columns=2, dimensions=[1000,400]],
dlist : mergeL(dlist,args,['terminal,'file_name,'columns,'dimensions]),
mk_draw(glist,dlist,swview), /* mk_draw 関数の呼び出し */
return("-- end of mk_draw_ex --")
)$ /* end of mk_draw_ex */
/*############################################################################*/
/* mergeL : keylist の項目に従い, トランザクションリストの内容をマスターリストにマージする */
/*############################################################################*/
mergeL([args]) := block([progn:"<mergeL>",debug, mlist,tlist,keylist,outL,
key,t_no,o_no,outlist],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of mergeL('help)--
機能: keylist の項目に従い, トランザクションリストの内容をマスターリストにマージする
文法: mergeL(mlist,tlist,keylist)
例示:
keylistで定義されたキー項目に関して,mlist(マスター)の内容を
tlist(トランザクション)の内容でマージする.
具体的には,キー項目がmlist,tlistに存在する場合はtlistの内容でmlistの内容で更新し,
キー項目がtlistに存在し,mlistに存在しない場合はtlistの内容をmlistに追加する.
なお,キー項目にない内容は対象外とし,無処理とする.
-- example --
mlist : [terminal='png, file_name=\"tmp\", columns=1, dimensions=[600,500] ],
tlist : ['file_name=\"ex-mergeL\", 'columns=2, 'dimensions=[1000,500] ],
keylist : ['terminal, 'file_name, 'columns, 'dimensions],
outL : mergeL(mlit,tlist,keylist),
--end of mergeL('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of mergeL('ex)--"),
/* mergeL_ex(), */
block([mlist,tlist,keylist,outL],
mlist : [terminal='png, file_name=sconcat(figs_dir,"/","mergeL"),
columns=1, dimensions=[600,500]],
tlist : ['file_name=sconcat(figs_dir,"/","ex-mergeL"),
'columns=2, 'dimensions=[1000,500] ],
keylist : ['terminal, 'file_name, 'columns, 'dimensions],
outL : mergeL(mlist,tlist,keylist),
c0show(progn,"--実行例--"),c0show(mlist),c0show(tlist),c0show(keylist),
c0show("outL : mergeL(mlist,tlist,keylist)"),
c0show("結果:",outL),
return(outL)
), /* end of block */
print("--end of mergeL('ex)--"),
return("--end of mergeL('ex)--"),
block_main, /* main ブロック ====================================*/
c1show(progn,"--begin--"),
c1show(length(args),args),
if length(args) >= 3 then (
mlist : args[1], tlist : args[2], keylist : args[3]
),
if length(args) >= 3
and listp(mlist) and listp(tlist) and listp(keylist) then ( /* main part */
outlist : copylist(mlist),
c1show(outlist),
for key in keylist do (
t_no : find_key_no(tlist,key),
o_no : find_key_no(outlist,key),
c1show(key, o_no, t_no),
if o_no > 0 then c1show(outlist[o_no]),
if t_no > 0 then c1show(tlist[t_no]),
if t_no > 0 and o_no > 0 then ( outlist[o_no] : tlist[t_no] ), /* 変更 */
if t_no > 0 and o_no=0 then (
c1show(t_no,tlist[t_no]),
outlist : endcons(tlist[t_no], outlist) ) /* 追加 */
), /* end of for-key */
c1show(progn, outlist),
return(outlist)
) /* end of if-listp */
)$ /* end of mergeL() */
/*+++ mergeL_ex ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
mergeL_ex([args]) := block([progn:"<mergeL_ex>",debug,mlist,tlist,keylist],
mergeL('help),
mergeL(),
mergeL('ex),
mlist : ['terminal='png, 'file_name=sconcat(figs_dir,"/","mergeL_ex"),
'dimensions=[600,500]],
tlist : ['file_name=sconcat(figs_dir,"/","ex-mergeL"), 'columns=2,
'dimensions=[1000,500] ],
keylist : ['terminal, 'file_name, 'columns, 'dimensions],
outL : mergeL(mlist,tlist,keylist),
cshow("結果",outL),
return("--end of mergeL_ex--")
)$ /* end of mergeL_ex() */
/*############################################################################*/
/*** gr2v 2019.10.16 ***************************************************/
/*############################################################################*/
gr2v([args]) := block([progn:"<gr2v>",debug,
colorL,line_typeL,point_typeL,keyL, nopoints,
Ls,Lc,Le, keyLs,keyLc,keyLe, fp,L,Lnew,gxr,gyr,
n, iL, f,var,xl,xr,f2lout, gxrange,gyrange,
SL, SL0, Skey, SLsum, ic,is,ie,
gr2L,g1,g2,g3,F,dF,glist,dlist,tlist, dkey,dkeyL, swview],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_main, /* main ブロック ====================================*/
/* 作図オプションの初期設定 */
c1how("-- ",progn," is started --"),
colorL : [red, blue, dark_green, dark_cyan, magenta, gray60], /* 線カラー */
line_typeL : [solid, solid, solid, solid, dots, dots], /* 線種 */
point_typeL : [filled_circle, circle], /* ポイント記号 */
keyL : ["key1","key2","key3","key4","key5","key6"], /* 凡例キー */
/* Ls:冒頭,Lc:中間,Le:末尾での標準値を陽指定するときに用いる */
Ls : ['grid=true, 'line_width=1.8, 'point_size=1.2],
Le : ['title="Plot by gr2v", 'key_pos=top_right],
/* Ls:冒頭,Lc:中間,Le:末尾の部分で更新対象とするキー付き引数(末尾指定キーに注意) */
keyLs : ['grid, 'line_width, 'point_size],
keyLc : ['color, 'key, 'line_type, 'point_type],
keyLe : ['title, 'xrange, 'yrange, 'key_pos],
/* 引数リストの例 */
if false then (
fp :[[0,0]],
L : ['key="line",explicit(sin(x),x,-%pi,%pi),'color=red,'key="points",points(fp)],
args : [L,'title="ex of gr2v", 'gxyrange,'view]
),
if false then (
f : on3(x,1,3,co) + on3(x,2,4,co),
L : [explicit(f,x,0,5),explicit(sin(x),x,-%pi,2*%pi)],
args : [L,'title="ex of on3func",'xrange=[-0.5,6],'yrange=[-0.2,2.5], 'view]
),
if true then (L : args[1]),
c1show(progn,args),
/* 関数型引数(キー付き引数でない)の位置を検出する : iL : [0,2,5,7] */
n : length(L), iL : [0],
for i:1 thru n do if rhs(L[i])=0 then iL:endcons(i,iL),
if member(n,iL)=false then iL : endcons(n,iL),
c1show(progn,iL),
/** 作画要素リスト L の更新:ジャンプ点の追加処理と作画領域の作成 **/
if true then ( /* L内にpoints()が存在しないとき,不連続点リスト fp の追加処理 */
c1show(progn,"作画要素リスト L の初期内容"),c1show(L),
if (length(exp2l(L,'points))=0) and (length(exp2l(L,'explicit))>0) then
c1show(progn,"Lの更新処理開始"),
if length(exp2l(L,'points))=0 then nopoints:true else nopoints:false,
Lnew : [], gxrange : [inf,minf], gyrange : [inf,minf],
for i:1 thru length(L) do (
c1show(progn,i,L[i]),
Lnew : append(Lnew,[L[i]]),
c1show(f2l_one(L[i])),
f2lout : f2l_one(L[i]),
if (rhs(L[i]) = 0) and (f2lout[1]='explicit) then (
/** L内のexplicit(f,x,xl,xr)の関数fの全てが表示可能な作図領域調べる **/
c1show(progn,i,f2lout),
[f,var,xl,xr] : rest(f2lout,1),
c1show(progn,f,var,xl,xr),
/** ジャンプ点(不連続点), 作図領域の検出 **/
[fp, gxr, gyr] : jumppoints(f, 'gxyrange),
gxr : [xl-(xr-xl)*0.1, xr+(xr-xl)*0.15], gxr : float(gxr),
/** gxrange は explicit(f,x,xl,xr) から算出する **/
c1show(progn,i,fp,gxr,gyr),
gxrange[1] : min(gxrange[1], gxr[1]), gxrange[2] : max(gxrange[2],gxr[2]),
gyrange[1] : min(gyrange[1], gyr[1]), gyrange[2] : max(gyrange[2],gyr[2]),
c1show(progn,i,gxrange,gyrange),
/** 初期の L 内にpoints()がなく,かつ length(fp)>0 のとき points(fp) を追加する **/
if nopoints and (length(fp) > 0)
then Lnew : append(Lnew,['color=red,points(fp)])
), /* end of if */
c1show(progn,i,Lnew)
), /* end of for-i */
L : Lnew.
c1show(progn,"作画要素リスト L の更新結果"),c1show(L),
/** gxrange, gyrange は args内に 'gxyrange があるとき,'xrange, 'yrange 更新対象となる **/
c1show(progn,"作画領域"),c1show(progn,gxrange,gyrange),
L : Lnew,
/* 関数型引数(キー付き引数でない)の位置を検出する : iL : [0,2,5,7] */
n : length(L), iL : [0],
for i:1 thru n do if rhs(L[i])=0 then iL:endcons(i,iL),
if member(n,iL)=false then iL : endcons(n,iL),
c1show(progn,iL)
), /* end if true */
/* gr2v([args]) -> args[1] = L = [gr2dの引数], args[2]={xrange,yrange,title,'view},... */
/* 関数型引数の間のキー付き引数(グラフオプション)をkeyLs,keyLc,keyLe を用いて更新する */
SLsum : [],
for ic:1 thru length(iL)-1 do (
Lc : ['color=colorL[ic], 'key=keyL[ic], 'line_type=line_typeL[ic],
'point_type=filled_circle],
is : iL[ic]+1, ie : iL[ic+1],
c1show(ic,is,ie,n),
if n-ie>0 then SL:rest(L,-1*(n-ie)) else SL:L,
if is>1 then SL:rest(SL,is-1),
c1show("--pre :",SL),
if ic=1 then (SL0:append(Ls,Lc), Skey:append(keyLs,keyLc))
else if ic<=length(iL)-1 then (SL0:Lc, Skey:keyLc)
/* else if ic=length(iL)-1 then (SL0:Le, Skey:keyLe) */
else (SL0:[]),
if is<=ie then (SL : mergeL(SL0,SL,Skey), SL : endcons(L[ie],SL)),
c1show("--post :",SL),
SLsum : append(SLsum,SL)
),
c1show(progn,SLsum),
gr2L : SLsum,
c1show(progn,find_key(args,'title)),
c1show(progn,"--pre args-- ",gr2L),
gr2L : mergeL(gr2L,args,keyLe), /* args[2],..での指定をkeyLeを用いて再度更新する */
c1show(progn,"--post args--",gr2L),
/* gxyrange の適用 */
if member('gxyrange, args) then (
/* gxyrange の試み */
c1show(progn,"xrange yrange の更新適用(設定値 gxrange gyrange)."),
gr2L:mergeL(gr2L,['xrange=gxrange,'yrange=gyrange],['xrange,'yrange])
), /* end of gxyrange */
/* gr2L を引数リストとして gr2d() を実行する */
c1show(progn,"gr2Lの最終結果",gr2L),
g1 : funmake(gr2d, gr2L),
glist : [g1], /* gr2d, gr3d で生成されたグラフィックオブジェクトのリスト */
/* dlist : draw() 関数の引数のリスト : 標準値とargsからの変更*/
tlist : copylist(args),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","gr2v"),
columns=1, dimensions=[600,500]],
dkeyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,tlist,dkeyL), /* call mergeL */
c1show(progn, dlist),
mk_draw(glist, dlist,swview),
c1show("-- end of gr2v --"),
return(g1),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of gr2v('help)--
機能: 2次元(x,y)作図: 関数に不連続点が存在する場合の描画を意識した.
文法: gr2v([args]) 内容的には gr2v([作画要素],その他の設定,...)
その他の設定: 'title=\"...\", 'gxyrange 'xrange 'yrange, 'view
例示:
gr2v()$ or gr2v('help)$ /* このヘルプを標示する */
gr2v('ex)$ /* 例を実行する */
gr2v([explicit(on3(x,1,3,co)+on3(x,2,4,co), x,0,5)],'gxrange, 'view)$
gr2v([explicit(sin(x),x,-%pi,%pi)],'gxyrange,'title=\"ex of gr2v\")$
gr2v([explicit(sin(x),x,-%pi,%pi), explicit(cos(x),x,-%pi,%pi)],'gxyrange)$
gr2v([implicit(x^2+y^2=1, x,-1,1, y,-1,1)])$
gr2v([points(makelist([random(20),random(50)],k,1,10))])$
gr2v([explicit(sin(x),x,-%pi,%pi),
explicit(x,x,-%pi,%pi),
explicit(-x,x,-%pi,%pi)],
'yrange=[-1.2,1.2], 'columns=2)$ /* gr2d にオプションを追加する */
fp : makelist([xv,ev(f1,x=xv)],xv,[1,3]),
g1:gr2v([explicit(f1,x,0,4),'color=red, points(fp)],'gxyrange,'noview),
/* 複数個のgr2dオブジェクトg1,g2,g3,g4を同時に表示する例 */
(g1 : gr2v([explicit(sin(x),x,-%pi,%pi)], 'noview),
g2 : gr2v([explicit(sin(x),x,-%pi,%pi), explicit(cos(x),x,-%pi,%pi)], 'noview),
g3 : gr2v([implicit(x^2+y^2=1, x,-1,1, y,-1,1)], 'noview),
g4 : gr2v([points(makelist([random(20),random(50)],k,1,10))], 'noview) )$
mk_draw([g1,g2,g3,g4],
['file_name=\"gr2v\", 'columns=2, 'dimensions=[1000, 1000]],
'view)$
--end of gr2v('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of gr2v('ex)--"),
/* gr2v_ex(), */
block([cmds,f,F,df,g1,g2,g3,figfile],
figfile : sconcat(figs_dir,"/","gr2v-ex1"),
cmds : sconcat("( ",
" /* 例1. gxyrange の使用例 */ @",
sconcat("gr2v([explicit(sin(t),t,-%pi,%pi), ",
"explicit(cos(t),t,-%pi,%pi)], @",
"'title=\"ex1 of gr2v\", 'gxyrange, @",
"'file_name=",figfile,", ",swview, " ) @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex2"),
cmds : sconcat("( ",
" /* 例2. gxyrange の使用例 */ @",
sconcat("gr2v([explicit(on3(x,1,3,co)+on3(x,2,4,co),x,0,5)], @",
"'title=\"ex2 of gr2v\", 'gxyrange, @",
"'file_name=",figfile,", ",swview, " ) @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex3"),
cmds : sconcat("( ",
" /* 例3. */ @",
sconcat("g1 : gr2v([explicit(sin(x),x,-%pi,%pi), @",
"explicit(cos(x),x,-%pi,%pi)], @",
" 'gxyrange, 'title=\"ex2-1 of gr2v\", 'noview), @"),
sconcat("g2 : gr2v([implicit(x^2+y^2=1, x,-1,1, y,-1,1)], @",
" 'xrange=[-1.1, 1.1], 'yrange=[-1.1, 1.2], @",
" 'title=\"ex2-2 of gr2v \", 'noview), @"),
sconcat("mk_draw([g1,g2], @",
"['file_name=",figfile,", @",
" 'columns=2, 'dimensions=[1000, 500]], ", swview, " ) @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex4"),
cmds : sconcat("( ",
" /* 例4. on3()関数f(x), 不定積分関数F(x), F(x)の微分関数dF(x) */ @",
sconcat("f : on3(x,1,3,co)+on3(x,2,5,co), @",
"g1 : gr2v([explicit(f,x,0,6)],'gxyrange,'title=\"f(x)\",'noview), @",
"F : on3integ19(f,x), @",
"g2 : gr2v([explicit(F,x,0,6)],'gxyrange,'title=\"F(x)\",'noview), @",
"dF : on3diff(F,x), @",
"g3 : gr2v([explicit(dF,x,0,6)],'gxyrange,'title=\"dF(x)\",'noview), @",
"mk_draw([g1,g2,g3], @",
"['file_name=",figfile,", @",
"'columns=3,dimensions=[1500,500]],", swview, " ) @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex5"),
cmds : sconcat("( ",
" /* 例5. on3()関数f(x), 不定積分関数F(x), F(x)の微分関数dF(x) */ @",
sconcat("f : exp(x-1)*on3(x,minf,1,oo)+exp(1-x)*on3(x,1,inf,co), @",
"g1 : gr2v([explicit(f,x,-4,6)],'gxyrange,'title=\"f(x)\",'noview), @",
"F : on3integ19(f,x), @",
"g2 : gr2v([explicit(F,x,-4,6)],'gxyrange,'title=\"F(x)\",'noview), @",
"dF : on3diff(F,x), @",
"g3 : gr2v([explicit(dF,x,-4,6)],'gxyrange,'title=\"dF(x)\",'noview), @",
"mk_draw([g1,g2,g3],@",
"['file_name=",figfile,", @",
"'columns=3,dimensions=[1500,500]],", swview, " ) @"),
" )"),
chk1show(cmds,""),
return('normal_return)
), /* end of block */
print("--end of gr2v('ex)--"),
return("--end of gr2v('ex)--")
)$ /* end of gr2v() */
/*+++ gr2v_ex ++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
gr2v_ex([args]) := block([progn:"<gr2v_ex>",debug,g1,g2,g3,g4,swview],
debug : ifargd(),
if member('noview,args) then swview:'noview else swview:'view,
if false then
gr2v([explicit(sin(x),x,-%pi,%pi),
explicit(x,x,-%pi,%pi),
explicit(-x,x,-%pi,%pi)],
'yrange=[-1.2,1.2], 'columns=2, swview),
if false then (
g1 : gr2v([explicit(sin(x),x,-%pi,%pi)], 'noview),
g2 : gr2v([explicit(sin(x),x,-%pi,%pi), explicit(cos(x),x,-%pi,%pi)], 'noview),
g3 : gr2v([implicit(x^2+y^2=1, x,-1,1, y,-1,1)], 'noview),
g4 : gr2v([points(makelist([random(20),random(50)],k,1,10))], 'noview),
mk_draw([g1,g2,g3,g4],
['file_name=sconcat(figs_dir,"/","gr2v_ex"), 'columns=2,
'dimensions=[1000, 1000]],
swview)
),
gr2v('help), /* gr2v() も可 */
gr2v('ex,swview),
return("end of gr2v_ex")
)$ /* end of gr2v_ex() */
/*##########################################################################*/
/*### jumppoints : on3関数(1変数)式fのジャンプ点リストを作成 2019.10.04 ##########*/
/*##########################################################################*/
jumppoints([args]) := block([progn:"<jumppoints>",debug, f,var, gxyrange:false,
xp, w, fkn, fp, gxl,gxr, gyl,gyr, xlist,ylist,ymin,ymax, out],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of jumppoints('help)--
機能: 関数(1変数)式fのジャンプ点リストfpを作成する.
また,引数に'gxrangeが指定され,かつジャンプ点が2点以上のときに
gxrange,gyrangeを提案する.
文法: jumppoints(func,...)
例示: jumppoints(on3(x.1.3.co) + on3(x,2,4,co)) -> fp=[[x1,y1],[x2,y2],...]
-> [[1,1],[2,2],[3,1],[4,0]]
jumppoints(on3(x.1.3.co) + on3(x,2,4,co),'gxyrange) -> [fp,gxrange,gyrange]
-> [[[1,1],[2,2],[3,1],[4,0]],[-0.5,5.5],[-0.4,2.4]]
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of jumppoints('ex)--"),
/* ush_ex(), */
block([script],
cashow(jumppoints(on3(x,1,3,co)+on3(x,2,4,co))),
cashow(jumppoints(on3(x,1,3,co)+on3(x,2,4,co),'gxyrange)),
cashow(jumppoints(exp(x-1)*on3(x,minf,1,oo)+exp(1-x)*on3(x,1,inf,co))),
return('normal_return)
), /* end of block */
print("--end of jumppoints('ex)--"),
return("--end of jumppoints('ex)--"),
block_main, /* main ブロック ====================================*/
f : args[1],
var : listofvars(f)[1],
if member('gxyrange, args) then gxyrange:true,
c1show(progn,f,gxyrange),
/* on3関数fの不連続点をxpとして取り出す */
xp : [],
w : on3lrl(f), /* w = [[x],[[minf,1,3,inf]],[true]] */
if length(w[1]) = 1 then (
var : ev(w[1][1]),
xp : w[2][1], xp : delete(minf,xp), xp : delete(inf,xp),
c1show(progn,var,xp)
),
/* on3関数fの不連続点リストxpでの関数値fpを求める -> points(fp)で用いる */
fp : [],
if length(xp) > 0 then (
fp : makelist([xv,ev(f,ev(var)=xv)],xv,xp),
/* fp : [[xv1,fp1],[xp2,fp2],...] g1 での描画で用いる */
c1show(progn,xp,fp,length(fp))
),
out : fp,
c1show(progn,fp),
/* 描画領域[[gxl,gxr],[gyl,gyr]]を設定する */
if gxyrange then (
/* gxl,gxr の仮設定 */
gxl : -10, gxr : 10,
/* 引数 args に xrange=[gxl,gxr] の指定があるとき fkn >0 */
fkn:find_key_no(args,'xrange), c1show(progn,fkn),
if fkn > 0 then (
cashow(args[fkn]),
gxl : rhs(args[fkn])[1],
gxr : rhs(args[fkn])[2],
cashow(gxl,gxr)
),
/* on3関数fの不連続点の個数が2以上のとき,両端の値から描画領域[[gxl,gxr],[gyl,gyr]]を設定する */
if (length(xp) > 1) and gxyrange then (
gxl : first(xp) - (last(xp)-first(xp))*0.5,
gxr : last(xp) + (last(xp)-first(xp))*0.5
),
/* on3関数fの関数値リストから yrange=[gyl,gyr] を作成する */
xlist : makelist(gxl+(gxr-gxl)*i/50, i,0,50),
if length(xp)>0 then xlist : append(xlist,xp),
ylist : makelist(ev(f,ev(var)=xv), xv, xlist),
ymin : lmin(ylist), ymax : lmax(ylist),
gyl : ymin - (ymax-ymin)*0.2, gyr : ymax + (ymax-ymin)*0.2,
c1show(progn,ymin,ymax,gyl,gyr),
out : [fp, [gxl,gxr], [float(gyl),float(gyr)]]
), /* end of if-gxyrange */
c1show(progn,out),
return(out)
)$ /* end of jumppoints() */
/*##########################################################################*/
/*### gr2vf : on3関数(1変数)式fの自動描画(閉点描画) 2019.10.03 ##########*/
/*##########################################################################*/
gr2vf([args]) := block([progn:"<gr2vf>",debug, f,var, atitle:"Plot by gr2vf",
fp, gxl,gxr,gyl,gyr, g1,g2,glist,dlist,dkeyL,swview],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of gr2vf('help)--
機能: on3関数(1変数)式fの自動描画(閉点描画)
文法: gr2vf(f,[args])
例示:
gr2vf()$ or gr2vf('help)$ /* このヘルプを標示する */
gr2vf('ex)$ /* 例を実行する */
f : on3(x,1,3,co) + on3(x,2,5,co),
gr2vf(f)$
gr2vf(f, 'xrange=[0,6], 'title=\"f(x)\")$
--end of gr2vf('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of gr2vf('ex)--"),
/* gr2v_ex(), */
block([cmds],
figfile : sconcat(figs_dir,"/","gr2vf-ex0"),
cmds : sconcat("( ",
" /* 例0. */ @",
sconcat("f:sin(t), ",
"c0show(f), gr2vf(f,'xrange=[-%pi,%pi],'file_name=",figfile,", ",
swview, ") @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex1"),
cmds : sconcat("( ",
" /* 例1. */ @",
sconcat("f:on3(t,1,3,co)+on3(t,2,5,co), @ ",
"c0show(f), gr2vf(f,'file_name=",figfile,", ", swview, ") @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr2v-ex2"),
cmds : sconcat("( ",
" /* 例2. */ @",
sconcat("f:exp(x-1)*on3(x,minf,1,oo)+exp(1-x)*on3(x,1,inf,co), @",
"c0show(f), gr2vf(f,'file_name=",figfile,", ", swview, ") @"),
" )"),
chk1show(cmds,""),
return('normal_return)
), /* end of block */
print("--end of gr2vf('ex)--"),
return("--end of gr2vf('ex)--"),
block_main, /* main ブロック ====================================*/
f : args[1],
c1show(progn,f),
if length(listofvars(f)) > 1 then (
cashow(progn,"==Error 1変数関数でない =="),
return("error")
),
var : listofvars(f)[1], c1show(progn,var),
[fp, [gxl,gxr], [gyl,gyr]] : jumppoints(f,'gxyrange),
c1show(prong,fp,gxl,gxr,gyl,gyr),
/* 引数 args に 'title="..." の指定があるとき fkn >0 */
fkn:find_key_no(args,'title), c1show(fkn),
if fkn > 0 then (
c1show(progn,args[fkn]),
atitle : rhs(args[fkn]),
c1show(progn,atitle)
),
if length(fp)=0 then
g1:gr2v([explicit(f,ev(var),gxl,gxr),
color=red],
'title=atitle,'xrange=[gxl,gxr],'yrange=[gyl,gyr], 'noview),
if length(fp) > 0 then
g1:gr2v([explicit(f,ev(var),gxl,gxr),'color=red,
points(fp)],
'title=atitle,'xrange=[gxl,gxr],'yrange=[gyl,gyr], 'noview),
/* color=red,point_type=filled_circle,point_size=1.2 */
c1show(g1),
/* dlist : draw() 関数の引数のリスト : 標準値とargsからの変更*/
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","gr2vf"),
columns=1, dimensions=[600,500]],
dkeyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,dkeyL), /* call mergeL */
c1show(progn, dlist),
mk_draw([g1],dlist,swview), /* mk_draw 関数の呼び出し */
c1show(progn,"---end of view---"),
return(g1)
)$ /* end of gr2vf() */
/*############################################################################*/
/*** gr3v 2019.07.04 *******on3lib();********************************************/
/*############################################################################*/
gr3v([args]) := block([progn:"<gr3v>",debug, figfile, funcs,cmds,gkeyL,dkeyL,
gr3L,g1,g2,glist,dlist,swview],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of gr3v('help)--
機能: 3次元グラフの作図
文法: gr3v(funcs,...)
例示:
gr3v()$ or gr3v('help)$ /* このヘルプを標示する */
gr3v('ex)$ /* 例を実行する */
gr3v([explicit((x+y+5)*on3(sqrt(x^2+y^2),2,3,co),
x,-3.5,3.5, y,-3.5, 3.5)], 'title=\"ex1 of gr3v\")$
gr3v([implicit(x^2+y^2+z^2=1, x,-1,1, y,-1,1, z,-1,1)])$
gr3v([points(makelist([random(20),random(50),random(50)],k,1,10))])$
--end of gr3v('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of gr3v('ex)--"),
/* gr3v_ex(), */
block([cmds,figfile],
figfile : sconcat(figs_dir,"/","gr3v-ex1"),
cmds : sconcat("( ",
" /* 例1. */ @",
sconcat("gr3v([explicit((x+y+5)*on3(sqrt(x^2+y^2),2,3,co), ",
"x,-3.5,3.5, y,-3.5, 3.5)], @",
"'title=\"ex1 of gr3v\", 'file_name=",figfile,",",swview, " ) @"),
" )"),
chk1show(cmds,""),
figfile : sconcat(figs_dir,"/","gr3v-ex2"),
cmds : sconcat("( ",
" /* 例2. */ @",
sconcat("g1 : gr3v([explicit((x+y+5)*on3(sqrt(x^2+y^2),2,3,co), ",
"x,-3.5,3.5, y,-3.5, 3.5)], @",
"'title=\"ex1 of gr3v\", 'noview), @"),
sconcat("g2 : gr3v([implicit(x^2+y^2+z^2=1, x,-1,1, y,-1,1, z,-1,1)], @",
" 'xrange=[-1.1, 1.1], 'yrange=[-1.1, 1.1], ",
" 'title=\"ex2 of gr3v \", 'noview), @"),
sconcat("mk_draw([g1,g2], @",
"['file_name=",figfile,", @",
" 'columns=2, 'dimensions=[1000, 500]], ",swview," ) @"),
" )"),
chk1show(cmds,""),
return('normal_end)
), /* end of block */
print("--end of gr3v('ex)--"),
return("--end of gr3v('ex)--"),
block_main, /* main ブロック ====================================*/
funcs : args[1],
if length(funcs) > 1 then (
print(" -- 描画関数は1本までとする.", length(funcs)), return()
),
gr3L : [title="gr3v plot",
enhanced3d=true, /*surface_hide = true,*/
/* cbrange=[-3,10], nticks = 5,xu_grid = 40, zrange = [zl, zr], */
color=green, view=[60, 30],
interpolate_color=true, contour=none,
/* explicit(f(x,y), x,-%pi,%pi, y,-%pi,%pi), */
funcs[1]],
gkeyL : ['title, 'enhanced3d, 'cbrange, 'nticks, 'xu_grid,
'xrange, 'yrange, 'zrange, 'interpolate_color, 'contour],
gr3L : mergeL(gr3L,args,gkeyL), /* call mergeL */
c1show(progn, gr3L),
g1 : funmake(gr3d, gr3L),
glist : [g1], /* gr2d, gr3d で生成されたグラフィックオブジェクトのリスト */
/* dlist : draw() 関数の引数のリスト : 標準値とその変更*/
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","gr3v"),
columns=1, dimensions=[600,500]],
dkeyL : ['terminal, 'file_name, 'columns, 'dimensions],
dlist : mergeL(dlist,args,dkeyL), /* call mergeL */
mk_draw(glist,dlist,swview), /* mk_draw 関数の呼び出し */
c1show("-- end of gr3v --"),
return(g1)
)$ /* end of gr3v() */
/*+++ gr3v_ex ++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
gr3v_ex([args]) := block([progn:"<gr3v_ex>",debug,g1,g2,g3,g4,swview],
debug : ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
gr3v('help),
g1 : gr3v([explicit((x+y+5)*on3(sqrt(x^2+y^2),2,3,co),
x,-3.5,3.5, y,-3.5, 3.5)], 'noview),
g2 : gr3v([implicit(x^2+y^2+z^2=1, x,-1,1, y,-1,1, z,-1,1)], 'noview),
g3 : gr3v([points(makelist([random(20),random(50),random(50)],k,1,10))], 'noview),
mk_draw([g1,g2,g3],
['file_name=sconcat(figs_dir,"/","gr3v_ex"),
'columns=2, 'dimensions=[1000, 1000]],
swview),
return("end of gr3v_ex")
)$ /* end of gr3v_ex() */
/*############################################################################*/
/*### mk_yrange : 関数func of var の定義域[xl,xr]での[最大値,最小値]を求める #########*/
/*############################################################################*/
mk_yrange([args]) := block([progn:"<mk_yrange>",debug,func,var,vl,vr,n:30,xvL,yvL,
ymin,ymax,yl,yr,out],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of mk_yrange('help)--
機能: 関数func of var の定義域[xl,xr]での[最大値,最小値]を求める
文法: mk_yrange([args],...)
例示:
mk_yrange(func,var,vl,vr)$
/* 変数varの関数funcの区間[vl,vr]における[min,max]をリストで返す*/
mk_yrange(sin(x),x,-%pi/2,%pi/2)$ -> [-1.3,1.3]
mk_yrange([sin(x),x,-%pi/2,%pi/2])$ /* リスト形式も可 */
--end of mk_yrange('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of mk_yrange('ex)--"),
/* mk_range_ex(), */
block([],
cshow("--ex of mk_yrange(sin(x),x,-%pi/2,%pi/2)--"),
cashow(mk_yrange(sin(x),x,-%pi/2,%pi/2)),
cshow("--ex of mk_yrange([sin(x),x,-%pi/2,%pi/2])--"),
cashow(mk_yrange([sin(x),x,-%pi/2,%pi/2])),
cashow(mk_yrange(on3(t,1,3,co)+on3(t,2,4,co),t,0,5)),
return("end from mk_yrange('ex)")
), /* end of block */
print("--end of mk_yrange('ex)--"),
return("--end of mk_yrange('ex)--"),
block_main, /* main ブロック ====================================*/
if length(args) >= 4 then ( /* 引数exp,keyfuncを取り出す */
func:args[1] ,var:args[2], vl:args[3], vr:args[4]
),
if length(args)>0 and listp(args[1]) and length(args[1])=4 then (
func:args[1][1] ,var:args[1][2], vl:args[1][3], vr:args[1][4]
),
c1show(func,var,xl,xr),
n : 30,
xvL : makelist(vl+(vr-vl)*i/n, i,0,n),
if true then (
cshow(func,ev(func)),
w : on3lrl(ev(func)),
/* 式内のon3()から,またはその完全リストからon3関数端点リストを取り出す.
また,端点リストに非数値が含まれるときFALSEを含まれないときTRUEを返す. */
cshow(w),
if length(w[1]) > 0 then (
wx : w[2][1], wx: delete(minf,wx), wx : delete(inf,wx),
if length(wx) > 1 then (
xl : first(wx) - (last(wx)-first(wx))*0.25,
xr : last(wx) + (last(wx)-first(wx))*0.25
) else (xl:-10, xr:10),
cshow(wx), cshow(xl,xr),
if length(wx)#0 then xvL : append(xvL,wx)
) /* end of if-length */
),
c1show(xvL),
yvL : makelist(ev(func,ev(var)=xvL[i]), i,1,length(xvL)),
c1show(yvL),
ymin : lmin(yvL),
ymax : lmax(yvL),
c1show(ymin,ymax),
yl : ymin - (ymax-ymin)*0.15,
yr : ymax + (ymax-ymin)*0.15,
out : float([yl,yr]),
c1show(out),
return(out)
)$ /* end of mk_yrange */
/*###########################################################################*/
/* <exp2l>: exp内に使われているkeyfuncで指定された関数(複数回使用可)の引数リストを返す */
/*###########################################################################*/
exp2l([args]) := block([progn:"<exp2l>",debug,exp,keyfunc,
exp1,exp2,exp3,out,outfind,outf,outa],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of exp2l('help)--
機能: exp内に使われているkeyfuncで指定された関数(複数回使用可)の引数リストを返す
文法: exp2l(exp,keyfunc,...)
例示:
exp2l(exp,keyfunc)$ /* 表現exp内において,keyfuncで指定された関数を検出し,その引数を返す */
exp1 : 'gr2v([explicit(sin(x),x,-%pi,%pi)], 'noview)$
exp2l(exp1,'explicit)$
exp2 : 'gr2v([explicit(sin(x),x,-%pi,%pi),
explicit(x^2,x,-%pi,%pi)], 'noview)$
exp2l(exp2,'explicit)$
exp3 : 'gr3v([implicit(x^2+y^2+z^2=1, x,-1,1, y,-1,1, z,-1,1)], 'noview)$
exp2l(exp3,explicit)$ /* 未検出の例 */
--end of exp2l('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of exp2l('ex)--"),
/* exp2l_ex(), */
block([exp1,exp2,exp3],
exp1 : 'gr2v([explicit(sin(x),x,-%pi,%pi)], 'noview),
c0show(exp1), cashow(exp2l(exp1,'explicit)),
exp2 : 'gr2v([explicit(sin(x),x,-%pi,%pi),
explicit(x^2,x,-%pi,%pi)], 'noview),
c0show(exp2),cashow(exp2l(exp2,'explicit)),
exp3 : 'gr3v([implicit(x^2+y^2+z^2=1, x,-1,1, y,-1,1, z,-1,1)], 'noview),
c0show(exp3),cashow(exp2l(exp3,explicit)), /* 未検出の例 */
return("end from exp2l('ex)")
), /* end of block */
print("--end of exp2l('ex)--"),
return("--end of exp2l('ex)--"),
block_main, /* main ブロック ====================================*/
if length(args) >= 2 then (exp:args[1], keyfunc:args[2]), /* 引数exp,keyfuncを取り出す */
c1show("S0:入力関数:",exp, keyfunc),
/* 式表現から完全リストを作成する */
out: scanmap(lambda([u], if atom(u)=false
then u:cons(op(u),args(u)) else u), exp),
c1show("S1:完全リスト:",out),
outfind :[],
c2show(outfind),
/* exp のリスト表現からkeyfuncを含むサブリストoutfindを作成する */
out : scanmap(lambda([u], if listp(u) and u[1]=keyfunc
then (outfind : endcons(u,outfind), u) else u ), out),
c1show("S2:explicit関数部抽出:",outfind),
if length(outfind)=0 then
(c1show(progn,"結果:",keyfunc,"を検出しなかったので空リスト[]を返す"),
return([]))
else if length(outfind)>0 then
(outf:copylist(outfind), outa:copylist(outfind),
for i:1 thru length(outfind) do (
outf[i] : l2f(outfind[i]),
c1show("S3:explicit関数部抽出:",outf[i]),
outa[i] : args(outf[i]),
c1show("S4:explicit関数の引数部抽出:",outa[i])
), /* end of do */
c1show(progn,"結果:",keyfunc),c1show(outa),
return(outa)
) /* end of else-if */
)$ /* end of exp2l() */
/*############################################################################*/
/*### grv: draw out in png/pdf-file and view ##########################*/
/* 使用例 XXX 廃止予定
g1 : gr2d(explicit(sin(x)/x, x, -10,10))$
c2co : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co)$
g2 : on3gr2(c2co)$
mk_draw mk_draw([g1,g2],
[terminal="png, file_name=sconcat(figs_dir,"/","grv"),
columns=1, dimensions=[900,1350]],'view)$
*/
/*############################################################################*/
grv([args]) := block([progn:"<grv>",debug,swview,plotmode:true,viewmode:true,ii:0,
inparm : "",
cmd0 : "system(\"convert /tmp/tmp.png /tmp/tmp.pdf\")",
cmd1 : "system(\"eog /tmp/tmp.png > /dev/null 2>&1 \" )"],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of grv('help)--
機能: grオブジェクトの描画
文法: grv([g1])
例示: grv(exp)
g1 : gr2d(explicit(sin(x)/x, x, -10,10))$
c2co : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co)$
g2 : on3gr(c2co)$ /* on3() を含む2変数関数をgr2d()で表現する */
grv([g1,g2],columns=2,dimensions=[1000,500])$
--end of grv('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of grv('ex)--"),
grv_ex(swview),
print("--end of grv('ex)--"),
return("--end of grv('ex)--"),
block_main, /* main ブロック ====================================*/
if member('noview, args) then swview:'noview else swview:'view,
c1show(progn,"1---",args),
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","grv_ex"),
columns=2, dimensions=[1000,500]],
dlist : mergeL(dlist,args,['terminal,'file_name,'columns,'dimensions]),
mk_draw(glist,dlist,swview), /* mk_draw 関数の呼び出し */
print(" => grv out :",cmd1),
return("")
)$
/*-------------------------------------------------------------------------*/
grv_ex([args]) := block([progn:"<grv_ex>",debug,swview],
if member('noview, args) then swview:'noview else swview:'view,
display2d:false,
cshow("--- begin of grv_ex ---"),
g1 : gr2d(explicit(sin(x)/x, x, -10,10)),
c2co : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co),
cshow(c2co),
g2 : on3gr(c2co), /* on3() を含む2変数関数をgr2d()で表現する */
glist : [g1,g2], /* gr2d, gr3d で生成されたグラフィックオブジェクトのリスト */
/* dlist : draw() 関数の引数のリスト */
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","grv_ex"),
columns=2, dimensions=[1000,500]],
dlist : mergeL(dlist,args,['terminal,'file_name,'columns,'dimensions]),
mk_draw(glist,dlist,swview), /* mk_draw 関数の呼び出し */
return("--- end of grv_ex ---")
)$ /* end of grv_ex() */
/*############################################################################*/
/* ### on3gr : on3関数で記述された領域(3変数も可，孤立点は不可)の作図 ##########*/
/* 使用例 : on3gr(ex2), on3gr(ex2,xrange=[0,3],yrange=[0,3]), */
/* on3gr(ex3co,xrange=[-3,3],yrange=[-3,3],zrange=[-3,3],noview) */
/*############################################################################*/
on3gr([args]) :=
block([progn:"<on3gr>",debug,exp, plotmode:true,viewmode:false,swview,
varl,xvar,lastvar,vend,rxrange:"",ryrange:"",rzrange:"",
rxl:-3.1,rxr:3.1,ryl:-3.1,ryr:3.1,rzl,rzr,
L,fl,fr,flr,xl,xr,xlr,fltype,frtype,xrng,D,Fl,Fr,gst,gout:""],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3gr('help)--
機能: on3関数で記述された領域(3変数も可，孤立点は不可)の作図
文法: on3gr(exp,...)
例示: on3gr(exp)
ex2 : on3(x,0,3/5,co)*on3(y,sqrt(1-x^2),x+1,cc)
+on3(x,sqrt(17)/2-1/2,4*sqrt(11)/5-1/5,co)*on3(y,(x+1)/2,sqrt(9-x^2),cc)
+on3(x,3/5,sqrt(17)/2-1/2,co)*on3(y,(x+1)/2,x+1,cc),
grex1 : ev(on3gr(ex2)),
c0show(\"実行例:\",grex1),
glist : [grex1],
dlist : [terminal=png, file_name=sconcat(figs_dir,'/','on3gr')],
mk_draw(glist,dlist,'view)
--end of on3gr('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3gr('ex)--"),
on3gr_ex(swview),
print("--end of on3gr('ex)--"),
return("--end of on3gr('ex)--"),
block_main, /* main ブロック ====================================*/
exp : args[1],
/*** 作図，表示の選択 ***/
if member(noplot,args) then (plotmode:false, args:delete(noplot,args)),
if member(view,args) then (viewmode:true, args:delete(view,args)),
varl : listofvars(exp), for lr in [cc,co,oc,oo] do varl : delete(lr,varl),
xvar:first(varl), lastvar:last(varl), vend:length(varl),
d1show(xvar,lastvar,vend),
rzrange : 'zrange=[-5,5],
for i thru length(args) do (
if lhs(args[i])='xrange then (
rxrange : string(args[i]), rxl:rhs(args[i])[1], rxr:rhs(args[i])[2] )
else if lhs(args[i])='yrange then (
ryrange : string(args[i]), ryl:rhs(args[i])[1], ryr:rhs(args[i])[2] )
else if lhs(args[i])='zrange then (
rzrange : string(args[i]), rzl:rhs(args[i])[1], rzr:rhs(args[i])[2] )
), /* end of for-i */
d1show(rxrange,rxl,rxr),
L : f2l(exp), Fl:[], Fr:[],
for i:2 thru length(L) do (
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=lastvar then
(fl:u[3], fr:u[4], flr:u[5]) else u ), L[i]),
scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=xvar then
(xl:u[3], xr:u[4], xlr:u[5]) else u ), L[i]),
D:scanmap(lambda([u], if listp(u) and u[1]=on3 and u[2]=lastvar then
u:1 else u ), L[i]),
D : l2f(D), if vend = 3 then (fl:fl*D, fr:fr*D),
if flr=oo then (fltype:line_type=dots, frtype:line_type=dots)
else if flr=oc then (fltype:line_type=dots, frtype:line_type=solid)
else if flr=co then (fltype:line_type=solid, frtype:line_type=dots)
else if flr=cc then (fltype:line_type=solid, frtype:line_type=solid),
xrng: [xvar,xl,xr],
Fl:endcons([fl,fltype,xvar,xl,xr],Fl),
Fr:endcons([fr,frtype,xvar,xl,xr],Fr)
),
d1show(Fl),d1show(Fr),
if length(varl) = 2 then ( /* 2次元プロット */
cshow(progn,":2次元プロット: 1個のgr2d()オブジェクト"),
gL : [line_width=2],
if rxrange # "" then gL : endcons(rxrange,gL),
if ryrange # "" then gL : endcons(ryrange,gL),
for i thru length(Fl) do (
gL: append(gL,[color=blue,
Fl[i][2], explicit(Fl[i][1],Fl[i][3],Fl[i][4],Fl[i][5])] ),
gL: append(gL, [color=red,
Fr[i][2], explicit(Fr[i][1],Fr[i][3],Fr[i][4],Fr[i][5])] )
),
d1show(progn,gL),
gout : funmake(gr2d,gL),
d1show(progn,gout)
), /* end of plot-2D */
if length(varl) = 3 then ( /* 3次元プロット */
cshow(progn,":3次元プロット: 複数個のgr3d()オブジェクト"),
gout:[],
for i:1 thru length(Fl) do (
gL : [line_width=2],
if rxrange # "" then gL : endcons(rxrange, gL),
if ryrange # "" then gL : endcons(ryrange, gL),
if rzrange # "" then gL : endcons(rzrange, gL),
/* 作図見本 */
gL: append(gL,[color=blue,xu_grid=40,yv_grid=40,
Fl[i][2], parametric_surface(x,y,Fl[i][1],
x,rxl,rxr, y,ryl,ryr)] ),
gL: append(gL,[color=red,xu_grid=40,yv_grid=40,
Fr[i][2], parametric_surface(x,y,Fr[i][1],
x,rxl,rxr, y,ryl,ryr)] ),
gst : funmake(gr3d,gL), d1show(gst),
gout : endcons(gst,gout)
), /* end of do */
d1show(progn,gout)
), /* end of plot-3D */
return(gout)
)$ /* end of on3gr() */
/*--- on3gr_ex --------------------------------------------------------------*/
on3gr_ex([args]) := block([progn:"<on3gr_ex>",
debug, plotmode:true, viewmode:false, ex2,ex3co,ex3oc, ex,gex,swview],
debug : ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
display2d:false,
ex2 : on3(x,0,3/5,co)*on3(y,sqrt(1-x^2),x+1,cc)
+on3(x,sqrt(17)/2-1/2,4*sqrt(11)/5-1/5,co)*on3(y,(x+1)/2,sqrt(9-x^2),cc)
+on3(x,3/5,sqrt(17)/2-1/2,co)*on3(y,(x+1)/2,x+1,cc),
ex3co : on3(x,1,3,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),oo)
+on3(x,-3,-1,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),oo)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),oc)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,sqrt(1-x^2),sqrt(9-x^2),co)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),oo)
+on3(x,-1,1,oo)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),oo)
*on3(z,-sqrt(-y^2-x^2+9),-sqrt(-y^2-x^2+1),oc)
+on3(x,-1,1,oo)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),oo)
*on3(z,sqrt(-y^2-x^2+1),sqrt(-y^2-x^2+9),co),
ex3oc : on3(x,1,3,oc)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),cc)
+on3(x,-3,-1,co)*on3(y,-sqrt(9-x^2),sqrt(9-x^2),cc)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),cc)
+on3(x,-1,1,cc)*on3(y,-sqrt(9-x^2),-sqrt(1-x^2),co)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),cc)
+on3(x,-1,1,cc)*on3(y,sqrt(1-x^2),sqrt(9-x^2),oc)
*on3(z,-sqrt(-y^2-x^2+9),sqrt(-y^2-x^2+9),cc)
+on3(x,-1,1,cc)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),cc)
*on3(z,-sqrt(-y^2-x^2+9),-sqrt(-y^2-x^2+1),co)
+on3(x,-1,1,cc)*on3(y,-sqrt(1-x^2),sqrt(1-x^2),cc)
*on3(z,sqrt(-y^2-x^2+1),sqrt(-y^2-x^2+9),oc),
argL1 : [ex2,xrange=[0,3],yrange=[0,3]],
argL2 : [ex3co,xrange=[-3,3],yrange=[-3,3],zrange=[-3,3]],
grex1 : ev(on3gr(ex2)),
cshow("実行例:",grex1),
glist : [grex1],
dlist : [terminal=png, file_name=sconcat(figs_dir,"/","on3gr-ex1")],
mk_draw(glist,dlist,swview),
c0show(progn,"on3gr(ex3co) を実行しています."),
grex2 : ev(on3gr(ex3co)),
cshow("実行例:",grex2),
glist : [grex2],
dlist : [terminal=png, file_name=sconcat(figs_dir,"/","on3gr-ex2"),
columns=2, dimensions=[900,1350]],
mk_draw(glist,dlist,swview),
return("--- end of on3gr_ex ---")
)$ /* end of on3gr_ex() */
/*############################################################################*/
/* ### on3funcdraw() : gr3d + mk_draw による描画 ###############################*/
/*############################################################################*/
on3funcdraw([args]) := block([progn:"<on3funcdraw>",debug,
g,g1,g2,swview],
debug:ifargd(),
if member('noview, args) then swview:'noview else swview:'view,
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3funcdraw('help)--
機能: gr3d + mk_draw による描画
文法: on3funcdraw([args],...)
例示:
g(x,y) := (x+y+5)*on3(sqrt(x^2+y^2), 2, 3, co),
g1 : gr3d(enhanced3d=true, color=green, cbrange=[-3,10],
view=[60, 30],
title=\"example of on3-func, and contour\",
interpolate_color=true, contour=none,
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
g2 : gr3d(view=map,enhanced3d=true, color=green, cbrange=[-3,10],
interpolate_color=true, contour=none,
title=\"example of contour \",
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
mk_draw([g1,g2],[terminal=png, file_name=\"tmp\",
columns=2, dimensions=[900,500]],'view),
--end of on3funcdraw('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3funcdraw('ex)--"),
/* on3funcdraw_ex(), */
block([g,g1,g2,viewmode,strview],
if member('noview, args) then strview:'noview else strview:'view,
g(x,y) := (x+y+5)*on3(sqrt(x^2+y^2), 2, 3, co),
g1 : gr3d(enhanced3d=true, color=green, cbrange=[-3,10],
view=[60, 30],
title="example of on3-func, and contour",
interpolate_color=true, contour=none,
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
g2 : gr3d(view=map,enhanced3d=true, color=green, cbrange=[-3,10],
interpolate_color=true, contour=none,
title="example of contour ",
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
mk_draw([g1,g2],[terminal=png, file_name=sconcat(figs_dir,"/","on3funcdraw"),
columns=2, dimensions=[900,500]],swview),
return("-- end of on3funcdraw_ex --")
), /* end of block */
print("--end of on3funcdraw('ex)--"),
return("--end of on3funcdraw('ex)--"),
block_main, /* main ブロック ====================================*/
g(x,y) := (x+y+5)*on3(sqrt(x^2+y^2), 2, 3, co),
g1 : gr3d(enhanced3d=true, color=green, cbrange=[-3,10],
view=[60, 30],
title="example of on3-func, and contour",
interpolate_color=true, contour=none,
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
g2 : gr3d(view=map,enhanced3d=true, color=green, cbrange=[-3,10],
interpolate_color=true, contour=none,
title="example of contour ",
explicit(g(x,y), x, -3.5, 3.5, y, -3.5, 3.5)),
if member('noview,args) then strview:'noview else strview:'view,
mk_draw([g1,g2],[terminal=png, file_name=sconcat(figs_dir,"/","on3funcdraw"),
columns=2, dimensions=[900,500]],swview),
return("-- end of on3funcdraw --")
)$ /* end of on3funcdraw() */
/*** ###### end of replace 2019.04.05 #################################*/
/*** ###### 2019.05.04 add ############################################*/
/*############################################################################*/
/*### on3varfix on3関数on3(x,xl,xr,xlr)の第1引数xをx_fixに変更する（2019.04.19）###*/
/*############################################################################*/
on3varfix([args]) := block([progn:"<on3fix>", debug,on3func,var,fix,
on3varsL, L, var_fix, one, out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3varfix('help)--
機能: on3関数on3(x,xl,xr,xlr)の第1引数xをx_fixに変更する
文法: on3varfix(on3func,var,'on,...)
例示: on3func : a*on3(x,a,b,co)*on3(y,c,d,co),
on3varfix(on3func,x,'on)
on3varfix(on3func,x,'off)
--end of on3varfix('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3varfix('ex)--"),
/* on3varfix_ex(), */
block([ex0,ex1,ex2,ex,out_on,out_off],
ex0 : a*x+b,
ex1 : on3(x,a,b,co),
ex2 : a*on3(x,a,b,co)*on3(y,c,d,co),
for ex in [ex0,ex1,ex2] do (
c0show(ex),
out_on : on3varfix(ex,x,'on),
c0show(" -> ", out_on),
out_off : on3varfix(out_on,x,'off),
c0show(" -> ", out_off)
),
return('normal_return)
), /* end of block */
print("--end of on3varfix('ex)--"),
return("--end of on3varfix('ex)--"),
block_main, /* main ブロック ====================================*/
if length(args) < 3 then (
c0show(progn, "Errror in number of arguments"), return('error)
),
on3func : args[1], var : args[2], fix : args[3],
on3varsL : on3vars(on3func),
c2show(progn, var, fix, on3varsL),
if length(on3varsL) = 0 then return(on3func),
L:f2l(on3func), c1show(L), /* change 2012.01.25, 2019.04.14 */
if L[1] = on3 then L : f2l(one*on3func),
var_fix : eval_string(sconcat(var,"_fix")),
c1show(progn,var,var_fix,fix),
c2show(properties(var),properties(var_fix)),
c1show(progn,"before",L),
if fix='on then (
/* on3(x,xl,xr,xlr)-> on3(x_fix,xl,xr,xlr)とし,積分に反応しないようにする */
L:scanmap(lambda([u],if listp(u) and u[1]='on3 and u[2]=var
then (u[2]:ev(var_fix), u) else u),L)
) else (
/* on3(x_fix,xl,xr,xlr) -> on3(x,xl,xr,xlr)とする */
L:scanmap(lambda([u],if listp(u) and u[1]='on3 and u[2]=ev(var_fix)
then (u[2]:ev(var), u) else u),L)
/* out1 : ev(l2f(L), ev(var_fix)=ev(var)), cshow(out1) */
),
c1show(progn,"after",L),
out : ev(l2f(L), one=1),
c1show(out),
return(out)
)$ /* end of on3varfix() */
chkerrsum : 0$ /* グローバル(Global)変数 */
/*############################################################################*/
/*### chkshow : 入力履歴と結果の検証 #########################################*/
/*############################################################################*/
chkshow([args]) := block([progn:"<chkshow>",debug,input,out,ans, chk,chkm],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of chkshow('help)--
機能: xとyの和を求める
文法: chkshow(input,out,ans,...)
例示: chkshow(\"1+2\",3,3) -> ★ 1+2 ◎ out = 3
chkshow(\"1+2\",2,3) -> ★ 1+2 ❌ out = 2 <- ans = 3
--end of chkshow('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of chkshow('ex)--"),
/* chkshow_ex(), */
print("--end of chkshow('ex)--"),
return("--end of chkshow('ex)--"),
block_main, /* main ブロック ====================================*/
if length(args) < 3 then (
c0show(progn,"Error: 引数の個数が少ない"), return('error)
),
input : args[1], out : args[2], ans : args[3],
if stringp(input) and slength(input)>0 then print("★ ",input),
c1show(progn,out), c1show(progn,ans),
if is(equal(out,ans)) then (chk:true, chkm:"◎ "),
if is(equal(out,ans)) # true then (chkm:"❌ ", chkerrsum : chkerrsum + 1),
print(chkm,"out =",out),
if is(equal(out,ans)) # true then print(" <- ans =",ans),
return(chkerrsum)
)$ /* end of chkshow */
/*############################################################################*/
/*### chk1show : 入力履歴と結果の検証 #########################################*/
/*############################################################################*/
chk1show([args]) := block([progn:"<chkshow>",debug,cmds,ans, hlp,hlpL,
cmdsL,out,chk,chkm],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of chk1show('help)--
機能: 入力履歴と結果の検証
文法: chk1show(cmds,ans,...)
例示:
cmds : sconcat(\"(\",
\"/* chk1showの使用例 */ @\",
\"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @\",
\"F : on3integ19(f,x), \",
\"F : on3decomp(F) \",
\")\"
),
Fans : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)
+2*f1*on3(x,3,4,co)+f1*(x-1)*on3(x,1,3,co),
chk1show(cmds,Fans),
--end of chk1show('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of chk1show('ex)--"),
chk1show_ex(),
print("--end of chk1show('ex)--"),
return("--end of chk1show('ex)--"),
block_main, /* main ブロック ====================================*/
cmds : args[1], ans : args[2],
cmdsL : split(cmds,"@"),
cmds : sremove("@",cmds),
for i thru length(cmdsL) do
if i=1 then print("★ ",cmdsL[1]) else print(" ",cmdsL[i]),
out : eval_string(cmds), /* 入力履歴(文字列)の一括評価 */
if ans="" then return("no check of ans"),
if listp(out) and is(equal(out,ans)) then (chk:true, chkm:"◎ ")
else (chk:false, chkm:"❌ ", chkerrsum : chkerrsum + 1),
if listp(out)=false then (
if numberp(out) and abs(out-ans) < 1.0E-8
then (chk:true, chkm:"◎ ")
else if is(equal(expand(out),expand(ans))) then (chk:true, chkm:"◎ ")
else (chk:false, chkm:"❌ ", chkerrsum : chkerrsum + 1)
),
if slength(sconcat(out)) < 500
then print(chkm,"out =",out)
else print(chkm,"reveal(out,6) =", reveal(out,6)),
if chk=false then print(" <- ans =",ans),
return(out)
)$ /* end of chkshow */
/*+++ chk1show_ex +++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
chk1show_ex([args]) := block([progn:"<chk1show_ex>",debug,cmds,Fans],
cmds : sconcat("(",
"/* chk1showの使用例 */ @",
"f : f1*on3(x,1,3,co) + f2*on3(x,4,6,co), /* fの定義 */ @",
"F : on3integ19(f,x), ",
"F : on3decomp(F) ",
")"),
Fans : 2*(f2+f1)*on3(x,6,inf,co)+(f2*x-4*f2+2*f1)*on3(x,4,6,co)+2*f1*on3(x,3,4,co)
+f1*(x-1)*on3(x,1,3,co),
chk1show(cmds,Fans),
display2d:true, on3show(F), display2d:false,
return("--end of chk1show_ex--")
)$ /* end of chk1show_ex */
/*############################################################################*/
/*### logshow : 入力履歴と結果の検証 #########################################*/
/*############################################################################*/
logshow([args]) := block([progn:"<chkshow>",debug,cmds, cmdsL,out],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of logshow('help)--
機能: 入力履歴と結果の検証
文法: logshow(cmds,...)
例示: logshow(cmds)
--end of logshow('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of logshow('ex)--"),
/* logshow_ex(), */
cmds : sconcat("( /* Ex. of on3diff(f,x) */ ",
"f : x^3*on3(x,1,3,co), df : on3diff(f,x) ) "),
out : logshow(cmds),
c0show(out),
print("--end of logshow('ex)--"),
return("--end of logshow('ex)--"),
block_main, /* main ブロック ====================================*/
cmds : args[1],
cmdsL : split(cmds,"@"),
cmds : sremove("@",cmds),
for i thru length(cmdsL) do
if i=1 then print("★ ",cmdsL[1]) else print(" ",cmdsL[i]),
out : eval_string(cmds), /* 入力履歴(文字列)の一括評価 */
return(out)
)$ /* end of logshow() */
/*############################################################################*/
/*### on3chgvar3_ex([args]) ######################################*/
/*** 2019.04.19 *************************************************
3変数矩形領域 D : [0 < x <1, 0 < y < 1, 0 < z < 1] から
変換 [t = x + y + z, u = y, v = z] のとき (t,u,v) の領域Gを求める
G = on3(t,2,3,oc)*on3(u,t-2,1,cc)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,0,t-1,co)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,t-1,1,cc)*on3(v,0,t-u,cc)
+on3(t,0,1,cc)*on3(u,0,t,cc)*on3(v,0,t-u,cc)
? on3ineq([[t-u-v, 0, 1, cc], [u, 0, 1, cc], [v, 0, 1, cc]]) では失敗する??
(1) (2) (3)
k1; t-u を tu として (1),(3)の不等式を tu, v について解き 結果を c0 とする.
c0 = on3(t-u,1,2,oc)*on3(v,(-u)+t-1,1,cc)+on3(t-u,0,1,cc)*on3(v,0,t-u,cc)
= c01 * c0v1 + c02 * c0v2
k2: c0の t-u に関する不等式 c01 と(2)の不等式を解き,結果を out01 とする.
k3: c0の t-u に関する不等式 c02 と(2)の不等式を解き,結果を out02 とする.
k4: 解 out : out01*c0v1 + out02*c0v2
****************************************************************/
/*############################################################################*/
on3chgvar3([args]) := block([progn:"<on3chgvar3>",debug,
c0,c0ans,c0v1,c0v2,c01,c02,out01,out02,out,outans, G_tuv,G_tu,G_t,G],
debug : ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3chgvar3('help)--
機能: 3変数矩形領域 D : [0 < x <1, 0 < y < 1, 0 < z < 1] から
変換 [t = x + y + z, u = y, v = z] のとき (t,u,v) の領域Gを求める
文法: on3chgvar3(...)
例示: on3chgvar3('go')
G = on3(t,2,3,oc)*on3(u,t-2,1,cc)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,0,t-1,co)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,t-1,1,cc)*on3(v,0,t-u,cc)
+on3(t,0,1,cc)*on3(u,0,t,cc)*on3(v,0,t-u,cc)
? on3ineq([[t-u-v, 0, 1, cc], [u, 0, 1, cc], [v, 0, 1, cc]]) では失敗する??
(1) (2) (3)
k1; t-u を tu として (1),(3)の不等式を tu, v について解き 結果を c0 とする.
c0 = on3(t-u,1,2,oc)*on3(v,(-u)+t-1,1,cc)+on3(t-u,0,1,cc)*on3(v,0,t-u,cc)
= c01 * c0v1 + c02 * c0v2
k2: c0の t-u に関する不等式 c01 と(2)の不等式を解き,結果を out01 とする.
k3: c0の t-u に関する不等式 c02 と(2)の不等式を解き,結果を out02 とする.
k4: 解 out : out01*c0v1 + out02*c0v2
--end of on3chgvar3('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3chgvar3('ex)--"),
/* on3chgvar3_ex(), */
/*
block([],
return('normal_return)
), /* end of block */
*/
print("--end of on3chgvar3('ex)--"),
return("--end of on3chgvar3('ex)--"),
block_main, /* main ブロック ====================================*/
print("--begin ",progn,"--"),
c0 : on3ineq([[tu-v,0,1,cc],[v,0,1,cc]],'resultonly,'noview),
c0 : ratsubst(t-u,tu,c0),
c0ans : on3(t-u,1,2,oc)*on3(v,(-u)+t-1,1,cc)+on3(t-u,0,1,cc)*on3(v,0,t-u,cc),
/*
input : sconcat("c0 : on3ineq([[tu-v,0,1,cc],[v,0,1,cc]],'resultonly)",
", c0 : ratsubst(t-u,tu,c0)"),
*/
cshow(c0),cshow(c0ans),
if false then chkshow(input,c0,c0ans), /* 検証 call chkshow */
cshow(f2l(c0)),
c0v1 : l2f(f2l(c0)[2][4]), /* c0v1 = on3(v,(-u)+t-1,1,cc) */
c0v2 : l2f(f2l(c0)[3][4]), /* c0v2 = on3(v,0,t-u,cc) */
cshow(progn,c0v1,c0v2),
c01 : f2l(c0)[2][3], /* [on3, t-u,1,2,oc] */
c02 : f2l(c0)[3][3], /* [on3 t-u,0,1,cc] */
cshow(progn,c01,c02),
out01 : on3ineq([rest(c01,1),[u,0,1,cc]],'resultonly,'noview),
out02 : on3ineq([rest(c02,1),[u,0,1,cc]],'resultonly,'noview),
out : out01*c0v1 + out02*c0v2,
out : expand(out),
outans : on3(t,2,3,oc)*on3(u,t-2,1,cc)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,0,t-1,co)*on3(v,(-u)+t-1,1,cc)
+on3(t,1,2,oc)*on3(u,t-1,1,cc)*on3(v,0,t-u,cc)
+on3(t,0,1,cc)*on3(u,0,t,cc)*on3(v,0,t-u,cc),
c1show(out),c1show(outans),
chkshow("",out,outans), /* 検証 call chkshow */
/* 検算 */
print("変換後の定義域 G_tuv=out においてp.d.f.が g(t,u,v)=1 on G とする"),
G_tuv : out,
cshow(G_tuv),
G_tu : on3integ19(G_tuv,v,minf,inf),
cshow(G_tuv),
cshow(G_tu),
G_t : on3integ19(G_tu,u,minf,inf), /* G_t : on3decomp(G_t), */
gtans : (t-3)^2/2*on3(t,2,3,oc)
+(-(2*t^2-6*t+3)/2)*on3(t,1,2,oc)
+t^2/2*on3(t,0,1,cc) ,
/* gtans : on3decomp(gtans), */
chkshow("G_t: T=X+y+Z の確率密度関数", G_t, gtans),
G : on3integ19(G_t,t,minf,inf), cshow("全確率の確認:",G),
return(out)
)$ /* end of on3chgvar3 */
/*############################################################################*/
/*### on3find #########2019.04.21 ###*/
/* on3()の積の項において指定した変数Varに関するon3(var,,,,)を検索する */
/*############################################################################*/
on3find([args]) := block([progn:"<on3find>",debug,on3func,var],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of on3find('help)--
機能: on3()の積の項において指定した変数Varに関するon3(var,,,,)を検索する
文法: on3find(on3func,var,...)
例示:
ex = on3(x,a,b,co)*on3(y,yl,yr,oo)+x*on3(x,c,d,cc)$
on3typep(on3func) = on3poly , on3vars(on3func) = [x,y]
** find ic = 1 , u = [on3,x,a,b,co]
** find ic = 2 , u = [on3,x,c,d,cc]
L = [\"+\",[\"*\",1,\"<<here-1>>\",[on3,y,yl,yr,oo]],[\"*\",x,\"<<here-2>>\"]]
--end of on3find('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of on3find('ex)--"),
/* on3find_ex(), */
block([progn:"<on3find('ex)>",debug,ex,x,out],
debug: ifargd(),
ex : on3(x,a,b,co)*on3(y,yl,yr,oo) + x*on3(x,c,d,cc),
c0show(ex),
out : on3find(ex,x),
c0show(out),
return("-- end of on3find_ex --")
), /* end of block */
print("--end of on3find('ex)--"),
return("--end of on3find('ex)--"),
block_main, /* main ブロック ====================================*/
on3func : args[1],
cshow(on3typep(on3func), on3vars(on3func)),
if (length(args)=1) and (length(on3vars(on3func))=1)
then var: on3vars(on3func)[1]
else if (length(args) > 1) and member(args[2],on3vars(on3func))
then var : args[2]
else (c0show("Error in ",progn),return()),
cshow(var),
L : f2l(on3func),
ic : 0,
L : scanmap(lambda([u],
if listp(u) and u[1]=on3 and u[2]=ev(var) then (
ic:ic+1, cshow("** find ",ic,u),
u:sconcat("<<here-",ic,">>"), u) else u), L),
cshow(L),
return(l2f(L))
)$ /* end of on3find() */
on3find_ex([args]) := block([progn:"<on3find_ex>",debug],
debug: ifargd(),
ex : on3(x,a,b,co)*on3(y,yl,yr,oo) + x*on3(x,c,d,cc),
cshow(ex),
out : on3find(ex,x),
cshow(out),
return("-- end of on3find_ex --")
)$ /* end of on3find_ex() */
/* ### From: interpol.mac (引用)#######################################################*/
/* Cubic splines interpolation. The argument must be either: */
/* a) a two column matrix, p:matrix([2,4],[5,6],[9,3]) */
/* b) a list of pairs, p: [[2,4],[5,6],[9,3]] */
/* c) a list of numbers, p: [4,6,3], in which case the abscissas will be */
/* assigned automatically to 1, 2, 3, etc. */
/* In cases a) and b) the pairs are ordered wrt the 1st. coordinate before any */
/* computation is made. Options: */
/* 'd1='unknown: 1st derivative at x_1; if it is 'unknown, the second derivative */
/* at x_1 is made equal to 0 (natural cubic spline); if it is equal to a */
/* number, the second derivative is estimated based on this number */
/* 'd2='unknown: 1st derivative at x_n; if it is 'unknown, the second derivative */
/* at x_n is made equal to 0 (natural cubic spline); if it is equal to a */
/* number, the second derivative is estimated based on this number */
/* 'varname='x: the name of the independent variable */
/* Reference: this algorithm is based on 'Numerical Recipes in C', section 3.3 */
/*### on3cspline ######################################################################*/
on3cspline(tab,[select]):= block([options, defaults, n, aux, y2, u, sig, p,
qn, un, a, b, s:0, aj, bj, cj, dj, lr:'co, ratprint:false],
/*--- block -----------------------------------------------------------------------*/
interpol_check_input(data,funame):=
block([n,out],
if not listp(data) and not matrixp(data)
then error("Argument to '",funame,"' must be a list or matrix"),
n: length(data),
if n<2
then error("Argument to '",funame,"' has too few sample points")
elseif listp(data) and
every('identity,map(lambda([x], listp(x) and length(x)=2),data))
then out: sort(data)
elseif matrixp(data) and length(data[1]) = 2
then out: sort(args(data))
elseif listp(data) and every('identity,map(lambda([x], not listp(x)),data))
then out: makelist([i,data[i]],i,1,n)
else error("Error in arguments to '",funame,"' function"),
/* controlling duplicated x's */
for i:2 thru n do
if out[i-1][1] = out[i][1]
then error("Duplicated abscissas are not allowed"),
out ),
/*--------------------------------------------------------------------------------*/
tab: interpol_check_input(tab,"cspline"), remfunction(interpol_check_input),
options: ['d1, 'dn, 'varname],
defaults: ['unknown, 'unknown, 'x],
for i in select do(
aux: ?position(lhs(i),options),
if numberp(aux) and aux <= length(options) and aux >= 1
then defaults[aux]: rhs(i)),
if not numberp(defaults[1]) and defaults[1] # 'unknown
then error("Option 'd1' is not correct"),
if not numberp(defaults[2]) and defaults[2] # 'unknown
then error("Option 'dn' is not correct"),
if not symbolp(defaults[3])
then error("Option 'varname' is not correct"),
/* if tab contains only two points, linear interpolation */
n: length(tab),
if n=2 /* case of two points */
then return(ratsimp( tab[2][2] + (tab[2][2]-tab[1][2]) *
(defaults[3]-tab[2][1]) / (tab[2][1]-tab[1][1]))),
/* constructing the interpolating polynomial */
y2: makelist(0,i,1,n),
u: makelist(0,i,1,n-1),
/* controlling the lower boundary condition */
if /*d1*/ defaults[1] = 'unknown
then (y2[1]: 0, u[1]: 0)
else (y2[1]: -1/2,
u[1]: 3 / (tab[2][1]-tab[1][1]) *
((tab[2][2] - tab[1][2])/(tab[2][1] - tab[1][1]) - defaults[1]) ),
/* decomposition loop of the triangular algorithm */
for i:2 thru n-1 do (
sig: (tab[i][1] - tab[i-1][1]) / (tab[i+1][1] - tab[i-1][1]),
p: sig * y2[i-1] + 2,
y2[i]: (sig - 1) / p,
u[i]: (tab[i+1][2] - tab[i][2]) /(tab[i+1][1] - tab[i][1]) -
(tab[i][2] - tab[i-1][2]) /(tab[i][1] - tab[i-1][1]),
u[i]: (6 * u[i] / (tab[i+1][1] - tab[i-1][1]) - sig * u[i-1]) / p ) ,
/* controlling the upper boundary condition */
if /*dn*/ defaults[2] = 'unknown
then (qn: 0, un: 0)
else (qn: 1/2, un: 3 / (tab[n][1] - tab[n-1][1]) *
(defaults[2] - (tab[n][2] - tab[n-1][2]) / (tab[n][1] - tab[n-1][1]))),
y2[n]: (un - qn * u[n-1]) / (qn * y2[n-1] + 1),
/* backsubstitution loop of the tridiagonal algorithm */
for k: n-1 thru 1 step -1 do
y2[k]: y2[k] * y2[k+1] + u[k],
/* constructing the cubic splines */
for j:2 thru n do (
if j=2 then (a: 'minf, b: tab[j][1], lr:oo )
else if j=n then (a: tab[j-1][1], b: 'inf, lr:co)
else (a: tab[j-1][1], b: tab[j][1], lr:co),
/* in the following sentences, defaults[3] is variable's name */
aux: (tab[j][1] - tab[j-1][1]),
aj: (tab[j][1] - defaults[3]) / aux, bj: (defaults[3] - tab[j-1][1]) / aux,
aux: aux * aux /6,
cj: (aj^3 - aj) * aux, dj: (bj^3 - bj) * aux,
s: s + funmake('on3,[defaults[3], a, b, lr]) *
expand(aj * tab[j-1][2] + bj * tab[j][2] + cj * y2[j-1] + dj * y2[j]) ),
s )$ /* end of on3cspline() */
/*--- on3cspline_ex ------------------------------------------------------------*/
on3cspline_ex([args]) := block([progn:"<on3cspline_ex>",debug],
debug:ifargd(),
p:[[7,2],[8,2],[1,5],[3,2],[6,7]], cshow(p),
/* cspline(p); ==> natural cubic spline (second derivatives are zero in both extremes) */
f(x):=on3cspline(p),
map(f,[2.3,5/7,%pi]),
g1:gr2d(
explicit(f(x),x,0,9),
title = concat("cspline: default"), yrange=[0,10],
point_size = 3,
points(p)),
g(x) := on3cspline(p,d1=0,dn=0),
g2:gr2d(
explicit(g(x),x,0,9),
title = concat("cspline: d1=0, dn=0"), yrange=[0,10],
point_size = 3,
points(p)),
grv(g1,g2,dimensions=[1800,2800]),
return()
)$ /* end of on3cspline_ex() */
/*############################################################################*/
/*### on3lspline #############################################################*/
/*############################################################################*/
on3lspline(tab,[select]) := block([n,s:0,a,b,options, defaults,ratprint:false,lr],
/*--- block -----------------------------------------------------------------------*/
interpol_check_input(data,funame):=
block([n,out],
if not listp(data) and not matrixp(data)
then error("Argument to '",funame,"' must be a list or matrix"),
n: length(data),
if n<2
then error("Argument to '",funame,"' has too few sample points")
elseif listp(data) and
every('identity,map(lambda([x], listp(x) and length(x)=2),data))
then out: sort(data)
elseif matrixp(data) and length(data[1]) = 2
then out: sort(args(data))
elseif listp(data) and every('identity,map(lambda([x], not listp(x)),data))
then out: makelist([i,data[i]],i,1,n)
else error("Error in arguments to '",funame,"' function"),
/* controlling duplicated x's */
for i:2 thru n do
if out[i-1][1] = out[i][1]
then error("Duplicated abscissas are not allowed"),
out ),
/*--------------------------------------------------------------------------------*/
tab: interpol_check_input(tab,"linearinterpol"), remfunction(interpol_check_input),
options: ['varname],
defaults: ['x],
for i in select do(
aux: ?position(lhs(i),options),
if numberp(aux) and aux <= length(options) and aux >= 1
then defaults[aux]: rhs(i)),
if not symbolp(defaults[1])
then error("Option 'varname' is not correct"),
/* constructing the interpolating polynomial */
n: length(tab),
if n=2 /* case of two points */
then s: tab[2][2] + (tab[2][2]-tab[1][2]) *
(defaults[1]-tab[2][1]) / (tab[2][1]-tab[1][1])
else for i:2 thru n do(
if i=2
then (a: 'minf, b: tab[i][1], lr:oo)
else if i=n then (a: tab[i-1][1], b: 'inf, lr:co)
else (a: tab[i-1][1], b: tab[i][1], lr:co),
s: s + funmake('on3,[defaults[1], a, b, lr]) *
expand( tab[i][2] + (tab[i][2]-tab[i-1][2]) *
(defaults[1]-tab[i][1]) / (tab[i][1]-tab[i-1][1]) ) ),
s )$ /* end of on3lspline() */
/*--- on3lspline_ex ------------------------------------------------------------*/
on3lspline_ex([args]) := block([progn:"<on3lspline_ex>",debug],
debug:ifargd(),
p:[[7,2],[8,2],[1,5],[3,2],[6,7]], cshow(p),
/* cspline(p);
==> natural cubic spline (second derivatives are zero in both extremes) */
f(x):=on3lspline(p),
map(f,[2.3,5/7,%pi]),
g1:gr2d(
explicit(f(x),x,0,9),
title = concat("cspline: default"), yrange=[0,10],
point_size = 3,
points(p)),
g(x) := on3lspline(p,d1=0,dn=0),
g2:gr2d(
explicit(g(x),x,0,9),
title = concat("cspline: d1=0, dn=0"), yrange=[0,10],
point_size = 3,
points(p)),
grv(g1,g2,dimensions=[1800,2800]),
return()
)$ /* end of on3lspline_ex() */
/*############################################################################*/
/*### funcxyp : F(x,y)=0 の零点リスト LL=[[x1,y1],[x2,y2],...]を返す ############*/
/*############################################################################*/
/* 2変数高次(4次以上)陰関数の描画と関数化を目指す
Fx+Fy*y'=0 -> y'(x) = -Fx/Fy
(Fxx+Fxy*y')+(Fyx+Fyy*y')*y' + Fy*y''=0
-> y''(x) = -{Fxx +(Fxy+Fyx)*y'+Fyy*(y')^2}/Fy
*/
funcxy([args]) := block([progn:"<funcxy>",debug, func,xs,xe,
realonly_old,ratprint_old,plotmode:true,
Fx,Fy,send,ans0,ans,order,ansy,xmid,ymid,xys,xye,xw,yw,wansy,
dis,dmin,dy1,dy2,dy,MR,ML,LL, spline,lend,ys,ye,g0,gall,gxs,gxe,dlist],
debug:ifargd(),
if length(args)=0 or args[1]='help then go(block_help),
if args[1]='ex then go(block_ex),
go(block_main),
block_help, /* help ブロック ====================================*/
printf(true,"
--begin of funcxy('help)--
機能: 2変数高次陰関数 F(x,y)=0 の描画と近似関数表現
文法: funcxy(func,xs,xe,...)
例示: funcxy(x^5-2*x^2*y+y^5,-2,2,'plot);
funcxy(x^2+2*x*y+y^3-1,-4,4);
--end of funcxy('help')--
"
),
return('normal_return),
block_ex, /* example ブロック ===================================*/
print("--begin of funcxy('ex)--"),
block([out,strview],
c0show("== 2変数高次陰関数 F(x,y)=0 の描画と近似関数表現==="),
if member('noview, args) then strview:'noview else strview:'view,
out:funcxy(x^5-2*x^2*y+y^5,-2,2,'file_name=sconcat(figs_dir,"/","funcxy-ex1"),strview),
c1show(out),
out:funcxy(x^2+2*x*y+y^3-1,-4,4,'file_name=sconcat(figs_dir,"/","funcxy-ex2"),strview),
c1show(out),
return('normal_return)
), /* end of block */
print("--end of funcxy('ex)--"),
return("--end of funcxy('ex)--"),
block_main, /* main ブロック ====================================*/
if length(args) < 3 then (
c0show(progn, "Erroor; 引数の個数が3未満です"),return("Error")),
func : args[1], xs : args[2], xe : args[3],
c1show(xs,xe),
if member('plot,args) then plotmode:true,
if member('noplot,args) then plotmode:false,
define(F(x,y),func), Fx:diff(F(x,y),x), Fy:diff(F(x,y),y),
realonly_old:realonly, realonly:true,
ratprint_old:ratprint, ratprint:false,
send:10, /* 分点数 */
ans0:algsys([F(x,y),Fy],[x,y]), /* Fy=0 となる(x,y)を求める */
for i thru length(ans0) do ans0[i]:map(rhs,ans0[i]), c2show(ans0),
if length(ans0) > 1 then (
order:msort(ans0,1),
ans:copylist(ans0),
for i thru length(order) do ans[i]:ans0[order[i]], c2show(ans)
) else ans:[],
if length(ans)=0 or xs < ans[1][1] then (
ansy:flatten(algsys([F(xs,y)],[y])),
if length(ansy) > 0 then ans : cons([xs,rhs(ansy[1])], ans)
),
if length(ans)=0 or xe > last(ans)[1] then (
ansy:flatten(algsys([F(xe,y)],[y])),
if length(ansy) > 0 then ans : endcons([xe,rhs(ansy[1])], ans)
),
ans:float(ans),
cshow(ans),
if length(ans)=0 then (cshow("範囲 xs,xe で零点は存在しない"), return([])),
/***********************************************************/
LL:[],
for ll:1 thru length(ans)-1 do (
xmid:(ans[ll][1]+ans[ll+1][1])/2, xys:copylist(ans[ll]), xye:ans[ll+1],
ansy:algsys([F(xmid,y)],[y]), ansy:map(rhs,flatten(ansy)),
/* yに関する多価関数に対応 */
for kk:1 thru length(ansy) do (
ymid:ansy[kk], c1show(xmid,ymid), c1show("===START:",xys,xye,send,MR),
/* xの中間点xmidから右の評価 */
MR:[[xmid,ymid]],
for s in [4,7,8,9,9.5,10] do (
xw: xmid+(xye[1]-xmid)*s/send,
if s=send and floatnump(xye[1]) then xw:xw-1.e-5,
wansy:algsys([F(xw,y)],[y]), wansy:map(rhs,flatten(wansy)), wansy:float(wansy),
dis:copylist(wansy),
for i thru length(wansy) do dis[i]:(last(MR)[2]-wansy[i])^2,
dmin:dis[1],
if length(dis)>1 then for i:2 thru length(dis) do dmin:min(dmin,dis[i]),
c2show(dis,dmin),
for i thru length(dis) do if dis[i]=dmin then yw:wansy[i],
lend:length(MR),
if lend > 2 then (
dy1 : (MR[lend][2]-MR[lend-1][2])/(MR[lend][1]-MR[lend-1][1]),
dy2 : (MR[lend-1][2]-MR[lend-2][2])/(MR[lend-1][1]-MR[lend-2][1]),
dy : dy2/dy1
),
if lend > 2
and ((0.9 < dy and dy < 1.1) or abs(dy1) < 0.1) and s # 10
then c2show("--skip---")
else ( c1show(xw,yw), MR:endcons([xw,yw],MR) )
),
c1show("Right:",MR),
/* xの中間点xmidから左の評価 */
ML:[[xmid,ymid]],
for s in [4,7,8,9,9.5,10] do (
xw: xmid+(xys[1]-xmid)*s/send,
if s=send and floatnump(xys[1]) then xw:xw+1.0e-5,
wansy:algsys([F(xw,y)],[y]),
wansy:map(rhs,flatten(wansy)), wansy:float(wansy),
dis:copylist(wansy),
for i thru length(wansy) do dis[i]:(first(ML)[2]-wansy[i])^2,
dmin:dis[1],
if length(dis)>1 then for i:2 thru length(dis) do dmin:min(dmin,dis[i]),
c2show(dis,dmin),
for i thru length(dis) do if dis[i]=dmin then yw:wansy[i],
lend:length(ML),
if lend > 2 then (
dy1 : (ML[2][2]-ML[1][2])/(ML[2][1]-ML[1][1]),
dy2 : (ML[3][2]-ML[2][2])/(ML[3][1]-ML[2][1]),
dy : dy2/dy1
),
if lend > 2
and ((0.9 < dy and dy < 1.1) or abs(dy1) < 0.1) and s # 10
then c2show("---skip---")
else ( c1show(xw,yw), ML:cons([xw,yw],ML) )
),
c1show("Left:",ML),
LL : endcons( append(ML,rest(MR,1)), LL)
), /* end of for-kk 多価関数 */
c1show(LL)
), /* end of for-ll */
if plotmode then (
ys:inf, ye:minf,
for i thru length(LL) do for j thru length(LL[i]) do
(ys:min(ys,LL[i][j][2]), ye:max(ye,LL[i][j][2])),
dy:max(abs(ys),abs(ye))*0.1, ys:ys-dy, ye:ye+dy,
g0:gr2d(implicit(F(x,y),x,xs,xe,y,ys,ye),
title=concat("Implicit Func."),
grid=true,xrange=[xs,xe]),
gall:sconcat("gr2d(grid=true,point_size=1,xrange=[xs,xe],yrange=[ys,ye]"),
gall:sconcat(gall,",title=\"cspline in funcxy\" "),
spline:makelist(null,i,1,length(LL)),
for kk:1 thru length(LL) do (
spline[kk]:on3cspline(LL[kk]), gxs:LL[kk][1][1], gxe:last(LL[kk])[1],
gall:sconcat(gall,", explicit(",spline[kk],",x,",gxs,",",gxe,
"), points(",LL[kk],")"),
c2show(kk,gall)
),
gall:sconcat(gall,")"), gall : eval_string(gall),
c2show(gall),
dlist : [terminal='png, file_name=sconcat(figs_dir,"/","fig/funcxy"),
columns=2, dimensions=[1000,500]],
dlist : mergeL(dlist, args, ['terminal, 'file_name, 'columns, 'dimensions]),
c1show(progn,dlist),
if member('view,args) then mk_draw([g0,gall], dlist, 'view )
else mk_draw([g0,gall], dlist, 'noview )
),
realonly:realonly_old, ratprint:ratprint_old, remfunction(F),
return(LL)
)$ /* end of funcxy() */
/*--- funcxy_ex ----------------------------------------------------------------*/
funcxy_ex([args]) := block([progn:"<funcxy_ex>",debug,out],
debug:ifargd(),
cshow("== 2変数高次陰関数 F(x,y)=0 の描画と近似関数表現==="),
out:funcxy(x^5-2*x^2*y+y^5,-2,2,'plot),
cshow(out),
if true then out:funcxy(x^2+2*x*y+y^3-1,-4,4),
cshow(out)
)$ /* end of funcxy_ex() */
/*#############################################################################*/
/* end of on3lib20all.mx */
/*#############################################################################*/