Re: 数式の微分（導関数） - SHIRAISHI Kazuo

2025/11/11 (Tue) 18:53:56

2320行の外部副プログラムfactor(exp$,dev$)を実行すると，因数をexp$に，その導関数をdev$に代入します。
2100行の外部副プログラムtermは，項をexp$に代入し，その導関数をdev$に代入します。
y=u*vの導関数は，y'=u'*v+u*v'です。
なので，積u*vの導関数を求めるためには，u,vとその導関数u',v'を求めてu'*v+u*v'を作ればよいことになります。
それを実行しているのが2240行です。
factorを実行して求めたe1$とe2$は因数ですが，その導関数のd1$とd2$は因数の形をしているとは限りません。
積u'*vを作るときにu'を括弧で括ることが不可欠です。
一方で，u'が0であるとき，u'*vは不要になります。
そのために，積を作る関数prod$を定義しています。
1610行の　POS(s$,"+")>0 OR POS(s$,"-")>0　は過剰ですが，最適化しようとするとかなり面倒なことになります。

Re: 数式の微分（導関数） - SHIRAISHI Kazuo

2025/11/11 (Tue) 19:00:57

factorでの処理は複雑です。factorはu^vの形の因子(因数)を対象にします。
y=u^vの導関数は，
y'=y*(v'*LOG(u)+u'*v/u)
ですが，これはu>0の場合に限定されます。
vが変数を含まなければ，
y=u^nに対して
y'=n*u^(n-1)*u'
です。
v，すなわち，e2$が変数を含むかどうかは，その導関数d2$を見ればわかります。
vが変数を含まないときの導関数を2550行で，vが変数を含むときの導関数を2580行で求めています。

Re: 数式の微分（導関数） - SHIRAISHI Kazuo

2025/11/11 (Tue) 20:51:29

変数としてギリシャ文字の小文字も使えるようにしています。多バイト文字を1文字として扱うために，MODULE Differentiator で
MODULE option character kanji
を宣言しています。Ver.8 やVer.0.9では
OPTION CHARACTER MULTIBYTE
を書くことになっていますが，互換性保持を目的に
option character kanji
を書いても同じ意味になります。
呼び出し側のプログラム単位では，文字を単位とする処理をしないので
option character kanji
を書く必要はありません。

Re: 数式の微分（導関数） - SHIRAISHI Kazuo

2025/11/12 (Wed) 10:45:41

Paren$を修正して無駄な括弧を付加しないようにしました。

100 REM Differentiator.Derivative$(expr$,dvar$)は，数式expr$を変数dvar$で微分して得られる導関数。
110 REM 関数は，SIN，COS，TAN, LOG, EXP, SQR, ATN, ASIN, ACOS のみ
120 REM 数値式の文法はほぼFull BASICに準ずるが，関数名に続く括弧は空白を入れずに書く。
130 REM 英字の小文字と大文字を同一視する。
140 REM 変数名はギリシャ文字の小文字α,…,ω も可。
150 REM 微分変数以外の変数(文字定数)を含んでよいが，配列(添字付き変数)は不可。
160 REM
170 DECLARE EXTERNAL FUNCTION Differentiator.Derivative$
180 DECLARE STRING s$,t$
190 !
200 DATA "x^3-a*x^2+b*x+c","x"
210 DATA "x^2+3*x*y-2*y^2", "x"
220 DATA "x^2+3*x*y-2*y^2", "y"
230 DATA "(x+1)*(x+2)*(x+3)","x"
240 DATA "x/x^2/x^3","x"
250 DATA "2*x/(3*x)/(4*x)*(5*x)","x"
260 DATA "EXP(-2*(x-k)^2)","x"
270 DATA "exp(-2*x^2-8*x)","x"
280 DATA "sqr(-2*x)","x"
290 DATA "SQR(2*X^2)","x"
300 DATA "SIN(-2*x^2-3*x+1)","x"
310 DATA "COS(-3*x^3-2*x)","x"
320 DATA "sin(a1*x^3+a2*x^2+a3*x+a4)","x"
330 DATA "exp(-2*sin(x^2+1))","x"
340 DATA "TAN(x)*COS(x)","x"
350 DATA "ATN(SIN(x))","x"
360 DATA "ASIN(x/180*PI)","x"
370 DATA "x^(n+1)","x"
380 DATA "x^x","x"
390 DATA "x^(x^2)","x"
400 DATA "x^(x*x)","x"
410 DATA "(x^x)^x","x"
420 DATA "x^x^x","x"
430 DATA "EXP(x*LOG(x))","x"
440 !
450 DO
460 READ IF MISSING THEN EXIT DO:s$,t$
470 PRINT s$,"を";t$;"で微分"
480 PRINT Derivative$(s$,t$)
490 PRINT
500 LOOP
510 END
520 !
1000 MODULE Differentiator
1010 MODULE OPTION CHARACTER kanji
1020 PUBLIC FUNCTION Derivative$
1030 SHARE STRING s$
1040 SHARE STRING DiffVar$
1050 SHARE NUMERIC i
1060 SHARE SUB skip
1070 SHARE SUB expression,term,factor,primary,numeric
1080 SHARE FUNCTION prod$,add$,sbt$,div$,Paren$,UnParen$
1090 !
1100 EXTERNAL FUNCTION Derivative$(expr$,dvar$)
1110 REM expr$の数式をdvar$で微分する
1120 DECLARE STRING exp$,dev$
1130 LET diffvar$=dvar$
1140 LET s$=expr$
1150 LET i=1
1160 CALL skip
1170 CALL expression(exp$,dev$)
1180 IF i<LEN(s$) THEN PRINT i,"Syntax error"
1190 let Derivative$=dev$
1200 end function
1210 !
1220 EXTERNAL SUB skip ! 空白を読み飛ばす
1230 DO WHILE s$(i:i)=" "
1240 LET i=i+1
1250 LOOP
1260 END SUB
1270 !
1280 EXTERNAL FUNCTION add$(s$,t$)
1290 IF s$="0" THEN
1300 LET add$=t$
1310 ELSEIF t$="0" THEN
1320 LET add$=s$
1330 ELSE
1340 LET add$=s$ & "+" & t$
1350 END IF
1360 END FUNCTION
1370 !
1380 EXTERNAL FUNCTION sbt$(s$,t$)
1390 IF s$=t$ THEN
1400 LET sbt$="0"
1410 ELSEIF s$="" AND t$="0" THEN
1420 LET sbt$="0"
1430 ELSEIF s$="0" THEN
1440 LET sbt$="(-" & t$ &")"
1450 ELSEIF t$="0" THEN
1460 LET sbt$=s$
1470 ELSE
1480 IF POS(t$,"+")>0 OR POS(t$,"-")>0 THEN LET t$=Paren$(t$)
1490 LET sbt$=s$ & "-" & t$
1500 END IF
1510 END FUNCTION
1520 !
1530 EXTERNAL FUNCTION prod$(s$,t$)
1540 IF s$="1" THEN
1550 LET prod$=t$
1560 ELSEIF t$="1" THEN
1570 LET prod$=s$
1580 ELSEIF s$="0" OR t$="0" THEN
1590 LET prod$="0"
1600 ELSE
1610 IF POS(s$,"+")>0 OR POS(s$,"-")>0 THEN LET s$=Paren$(s$)
1620 IF POS(t$,"+")>0 OR POS(t$,"-")>0 THEN LET t$=Paren$(t$)
1630 LET prod$=s$ & "*" & t$
1640 END IF
1650 END FUNCTION
1660 !
1670 EXTERNAL FUNCTION div$(s$,t$)
1680 IF s$=t$ THEN
1690 LET div$="1"
1700 ELSEIF t$="1" THEN
1710 LET div$=s$
1720 ELSEIF s$="0" THEN
1730 LET div$="0"
1740 ELSE
1750 IF POS(s$,"+")>0 OR POS(s$,"-")>0 THEN LET s$=Paren$(s$)
1760 IF POS(t$,"+")>0 OR POS(t$,"-")>0 OR POS(t$,"*")>0 OR POS(t$,"/")>0THEN LET t$=Paren$(t$)
1770 LET div$=s$ & "/" & t$
1780 END IF
1790 END FUNCTION
1800 !
1810 EXTERNAL SUB expression(exp$,dev$) !加減式
1820 DECLARE NUMERIC i0
1830 DECLARE STRING op$,e1$,d1$,e2$,d2$
1840 IF s$(i:i)="+" OR s$(i:i)="-" THEN
1850 LET exp$=""
1860 LET dev$=""
1870 ELSE
1880 CALL term(exp$,dev$)
1890 END IF
1900 DO WHILE s$(i:i)="+" OR s$(i:i)="-"
1910 LET op$=s$(i:i)
1920 LET i=i+1
1930 CALL skip
1940 LET e1$=exp$
1950 LET d1$=dev$
1960 CALL term(e2$,d2$)
1970 LET exp$=e1$ & op$ & e2$
1980 SELECT CASE op$
1990 CASE "+"
2000 LET dev$=add$(d1$,d2$)
2010 CASE "-"
2020 LET dev$=sbt$(d1$,d2$)
2030 END SELECT
2040 LOOP
2050 CALL skip
2060 END SUB
2070 !
2080 EXTERNAL SUB term(exp$,dev$) !項(乗除)
2090 DECLARE NUMERIC i0
2100 DECLARE STRING op$,e1$,d1$,e2$,d2$
2110 CALL factor(exp$,dev$)
2120 DO WHILE s$(i:i)="*" OR s$(i:i)="/"
2130 LET op$=s$(i:i)
2140 LET i=i+1
2150 CALL skip
2160 LET e1$=exp$
2170 LET d1$=dev$
2180 CALL factor(e2$,d2$)
2190 LET exp$=e1$ & op$ & e2$
2200 SELECT CASE op$
2210 CASE "*"
2220 LET dev$=add$(prod$(d1$,e2$),prod$(e1$,d2$))
2230 CASE "/"
2240 LET dev$=div$(Paren$(sbt$(prod$(d1$,e2$),prod$(e1$,d2$))), Paren$(e2$) & "^2")
2250 END SELECT
2260 LOOP
2270 CALL skip
2280 END SUB
2290 !
2300 EXTERNAL SUB factor(exp$,dev$) !因子(冪乗)
2310 DECLARE NUMERIC i0,n
2320 DECLARE STRING e1$,d1$,e2$,d2$
2330 CALL primary(exp$,dev$)
2340 DO WHILE s$(i:i)="^"
2350 LET i=i+1
2360 CALL skip
2370 LET e1$=exp$
2380 LET d1$=dev$
2390 CALL primary(e2$,d2$)
2400 LET exp$=e1$ & "^" & e2$
2410 ! 2420行～2580行で，e1$,e2$,exp$は因子(factor)
2420 IF d2$="0" THEN
2430 WHEN EXCEPTION IN
2440 LET n=VAL(e2$)-1
2450 IF n=1 THEN
2460 LET dev$=prod$(prod$(e2$,e1$) ,d1$)
2470 ELSEIF n>0 THEN
2480 LET dev$=prod$(prod$(e2$, e1$ & "^" & STR$(n)) ,d1$)
2490 ELSE
2500 LET dev$=prod$(prod$(e2$, e1$ & "^(" & STR$(n) & ")"),d1$)
2510 END IF
2520 USE
2530 LET dev$=prod$(e2$ & "*" & e1$ & "^(" & e2$ & "-1)",d1$)
2540 END WHEN
2550 ELSE
2560 LET dev$=prod$(exp$ , add$( prod$(d2$, "LOG(" & e1$ & ")"), prod$(div$(e2$,e1$),d1$)))
2570 END IF
2580 LOOP
2590 CALL skip
2600 END SUB
2610 !
2620 EXTERNAL SUB primary(exp$,dev$)
2630 DECLARE NUMERIC i0
2640 DECLARE STRING op$,e1$,d1$,e2$,d2$
2650 LET i0=i
2660 IF s$(i:i)="(" THEN
2670 LET i=i+1
2680 CALL SKIP
2690 CALL expression(e1$,d1$)
2700 LET exp$="(" & e1$ & ")"
2710 !LET dev$="(" & d1$ & ")"
2720 LET dev$=Paren$(d1$)
2730 ELSEIF UCASE$(s$(i:i+3))="SIN(" THEN
2740 LET i=i+4
2750 CALL SKIP
2760 CALL expression(e1$,d1$)
2770 LET exp$="SIN(" & e1$ & ")"
2780 LET dev$=prod$(d1$,"COS(" & e1$ & ")")
2790 ELSEIF UCASE$(s$(i:i+3))="COS(" THEN
2800 LET i=i+4
2810 CALL SKIP
2820 CALL expression(e1$,d1$)
2830 LET exp$="COS(" & e1$ & ")"
2840 LET dev$=prod$(d1$,"(-SIN(" & e1$ & "))")
2850 ELSEIF UCASE$(s$(i:i+3))="TAN(" THEN
2860 LET i=i+4
2870 CALL SKIP
2880 CALL expression(e1$,d1$)
2890 LET exp$="TAN(" & e1$ & ")"
2900 LET dev$=prod$( d1$, "SEC(" & e1$ & ")^2")
2910 ELSEIF UCASE$(s$(i:i+3))="LOG(" THEN
2920 LET i=i+4
2930 CALL SKIP
2940 CALL expression(e1$,d1$)
2950 LET exp$="LOG(" & e1$ & ")"
2960 LET dev$=Div$(Paren$(d1$),Paren$(e1$))
2970 ELSEIF UCASE$(s$(i:i+3))="EXP(" THEN
2980 LET i=i+4
2990 CALL SKIP
3000 CALL expression(e1$,d1$)
3010 LET exp$="EXP(" & e1$ & ")"
3020 LET dev$=prod$( d1$ ,"EXP(" & e1$ & ")")
3030 ELSEIF UCASE$(s$(i:i+3))="SQR(" THEN
3040 LET i=i+4
3050 CALL SKIP
3060 CALL expression(e1$,d1$)
3070 LET exp$="SQR(" & e1$ & ")"
3080 LET dev$=div$(d1$,"(2*SQR(" & e1$ & "))")
3090 ELSEIF UCASE$(s$(i:i+3))="ATN(" THEN
3100 LET i=i+4
3110 CALL SKIP
3120 CALL expression(e1$,d1$)
3130 LET exp$="ATN(" & e1$ & ")"
3140 LET dev$=div$(Paren$(d1$), "(1+" & Paren$(e1$) & "^2)")
3150 ELSEIF UCASE$(s$(i:i+4))="ASIN(" THEN
3160 LET i=i+5
3170 CALL SKIP
3180 CALL expression(e1$,d1$)
3190 LET exp$="ASIN(" & e1$ & ")"
3200 LET dev$=Paren$(d1$) & "/SQR(1-(" & e1$ & ")^2)"
3210 ELSEIF UCASE$(s$(i:i+4))="ACOS(" THEN
3220 LET i=i+5
3230 CALL SKIP
3240 CALL expression(e1$,d1$)
3250 LET exp$="ACOS(" & e1$ & ")"
3260 LET dev$="(-" & Paren$(d1$) & ")/SQR(1-(" & e1$ & ")^2)"
3270 END IF
3280 IF i>i0 THEN
3290 IF s$(i:i)=")" THEN
3300 LET i=i+1
3310 CALL skip
3320 ELSE
3330 PRINT i, ") expected"
3340 STOP
3350 END IF
3360 ELSE
3370 IF s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)="." THEN
3380 CALL NUMERIC(exp$,dev$)
3390 ELSEIF s$(i:i)>="a" AND s$(i:i)<="z" OR s$(i:i)>="A" AND s$(i:i)<="Z" OR s$(i:i)>="α" AND s$(i:i)<="ω" THEN
3400 CALL identif(exp$,dev$)
3410 ELSE
3420 END IF
3430 END IF
3440 END SUB
3450 !
3460 EXTERNAL SUB numeric(exp$,dev$)
3470 DECLARE NUMERIC i0
3480 LET i0=i
3490 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)="."
3500 LET i=i+1
3510 LOOP
3520 IF UCASE$(s$(i:i))="E" THEN
3530 LET i=i+1
3540 IF s$(i:i)="+" OR s$(i:i)="-" THEN LET i=i+1
3550 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9"
3560 LET i=i+1
3570 LOOP
3580 END IF
3590 LET exp$=s$(i0:i-1)
3600 LET dev$="0"
3610 CALL skip
3620 END SUB
3630 !
3640 EXTERNAL SUB identif(exp$,dev$)
3650 DECLARE NUMERIC i0
3660 LET i0=i
3670 DO WHILE s$(i:i)>="a" AND s$(i:i)<="z" OR s$(i:i)>="A" AND s$(i:i)<="Z" OR s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)>="α" AND s$(i:i)<="ω"
3680 LET i=i+1
3690 LOOP
3700 LET exp$=s$(i0:i-1)
3710 IF UCASE$(exp$)=UCASE$(DiffVar$) THEN LET dev$="1" ELSE LET dev$="0"
3720 CALL skip
3730 END SUB
3740 !
3750 EXTERNAL FUNCTION Paren$(s$)
3760 DECLARE NUMERIC i
3770 SUB EndParen
3780 let i=i+1
3790 DO UNTIL s$(i:i)=")"
3800 LET i=i+1
3810 IF s$(i:i)="(" THEN CALL EndParen
3820 LOOP
3830 END SUB
3840 LET i=1
3850 DO WHILE s$(i:i)=" "
3860 LET i=i+1
3870 LOOP
3880 IF s$(i:i)="(" THEN
3890 CALL EndParen
3900 ELSEIF s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)="." THEN
3910 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)="."
3920 LET i=i+1
3930 LOOP
3940 IF UCASE$(s$(i:i))="E" THEN
3950 LET i=i+1
3960 IF s$(i:i)="+" OR s$(i:i)="-" THEN LET i=i+1
3970 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9"
3980 LET i=i+1
3990 LOOP
4000 END IF
4010 ELSEIF s$(i:i)>="a" AND s$(i:i)<="z" OR s$(i:i)>="A" AND s$(i:i)<="Z" OR s$(i:i)>="α" AND s$(i:i)<="ω" THEN
4020 DO WHILE s$(i:i)>="a" AND s$(i:i)<="z" OR s$(i:i)>="A" AND s$(i:i)<="Z" OR s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)>="α" AND s$(i:i)<="ω"
4030 LET i=i+1
4040 LOOP
4050 IF s$(i:i)="(" THEN CALL EndParen
4060 END IF
4070 DO WHILE s$(i:i)=" "
4080 LET i=i+1
4090 LOOP
4100 IF i<LEN(s$) THEN
4110 LET Paren$="(" & s$ & ")"
4120 ELSE
4130 LET Paren$=s$
4140 END IF
4150 END FUNCTION
4250 END MODULE