100 REM Differentiator.Derivative$(expr$,dvar$) is the derivative of expr$ with respect to dvar$
110 REM Functions are only  SIN，COS，TAN, LOG, EXP, SQR, ATN, ASIN, ACOS
120 REM Syntax according to Full BASIC but the parentheses must follow the function name without a space.
130 REM Ignores the case in alphabet.
140 REM The variable can be a Greek small letter.
150 REM Constant letters can be included, but indexed variable can not included.
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 "Differentiate", s$,"with", ;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 differentiate expr$ with respect to 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   ! Read out spaces
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$)  !Additions or subtractions
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$)    !Multiplications or Divisions
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$)    !exponentiation
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       ! e1$,e2$,exp$ are factors on lines 2420～2580.
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
