1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
TTYOFF: NOLABELS: TRUE $
%SIGNUMDISTRIBUTE:%ABSDISTRIBUTE:FALSE $
%ELIGIBLE:'[SINH,ATAN,TANH,ATANH,ERF,ASINH,CSCH,COTH,ASIN] $
UNITSTEP(U) := (1+SIGNUM(U))/2 $
UNITRAMP(U) := (U+ABS(U))/2 $
MATCHDECLARE([UTRUE, VTRUE], TRUE, EVENINTEGER, EVENINTEGERP) $
ODDINTEGERP(U):=
IF INTEGERP(U) AND INTEGERP((U+1)/2) OR ?MODDP(U)
THEN TRUE ELSE FALSE $
EVENINTEGERP(U):=
IF INTEGERP(U) AND INTEGERP(U/2) OR ?MEVENP(U)
THEN TRUE ELSE FALSE $
TELLSIMPAFTER(ABS(UTRUE)^EVENINTEGER, UTRUE^EVENINTEGER) $
TELLSIMPAFTER('DIFF(ABS(UTRUE),VTRUE),SIGNUM(UTRUE)*DIFF(UTRUE,VTRUE))$
TELLSIMPAFTER(COSH(ABS(UTRUE)), COSH(UTRUE)) $
TELLSIMPAFTER(SECH(ABS(UTRUE)), SECH(UTRUE)) $
TELLSIMPAFTER(COS(ABS(UTRUE)), COS(UTRUE)) $
TELLSIMPAFTER(SEC(ABS(UTRUE)), SEC(UTRUE)) $
TELLSIMPAFTER(ABS(UTRUE), ABSIMP(UTRUE)) $
ABSIMP(UT) :=BLOCK(
[PARTSWITCH, PREDERROR, U, V, W, B, NOMATCH],
PARTSWITCH:TRUE, PREDERROR:FALSE,
IF ATOM(UT) OR INPART(UT,0)="+" THEN
IF IS(UT>0 or ut=0)=TRUE THEN RETURN(UT)
ELSE IF IS(UT<0 or ut=0)=TRUE THEN RETURN(-UT)
ELSE RETURN(ABS(UT)),
IF PIECE="*" THEN(U:V:1,
W:[],
FOR J:1 STEP 1 WHILE(B:INPART(UT,J))#END DO
IF IS(B>0 or b=0)=TRUE THEN U:U*B
ELSE IF IS(B<0 or b=0)=TRUE THEN U:-U*B
ELSE IF ATOM(B) OR NOT(MEMBER(INPART(B,0), %ELIGIBLE) OR
PIECE="^" AND ODDINTEGERP(INPART(B,2))) THEN(NOMATCH:TRUE,
FOR WW IN W WHILE NOMATCH DO
IF B=FIRST(WW) THEN (NOMATCH:FALSE,
U: U*B*FIRST(REST(WW)),
W:DELETE(WW,W)),
IF NOMATCH THEN W:CONS([B,B],W))
ELSE (NOMATCH:TRUE,
INPART(B,1),
FOR WW IN W WHILE NOMATCH DO
IF PIECE=FIRST(WW) THEN (NOMATCH:FALSE,
U: U*B*FIRST(REST(WW)),
W:DELETE(WW,W)),
IF NOMATCH THEN W: CONS([PIECE,B], W)),
IF W=[] THEN RETURN(U),
IF %ABSDISTRIBUTE THEN FOR WW IN W DO U:U*ABSIMP(FIRST(REST(WW)))
ELSE (FOR WW IN W DO V:V*FIRST(REST(WW)),
U:U*(IF REST(W)=[] THEN ABSIMP(V) ELSE 'ABS(V))),
RETURN(U)),
IF PIECE="^" THEN (U:INPART(UT,1),
IF IS(U>0 or u=0)=TRUE THEN RETURN(UT),
V:INPART(UT,2),
IF EVENINTEGERP(V) THEN RETURN(UT),
IF ODDINTEGERP(V) AND IS(U<0 or u=0) THEN RETURN(-UT),
RETURN(ABS(UT))),
IF PIECE='LOG THEN(B:INPART(UT,1),
IF IS(B>1 or b=1)=TRUE THEN RETURN(UT),
IF IS(B<1 or b=1)=TRUE THEN RETURN(-UT),
RETURN(ABS(UT))),
IF PIECE='COSH OR PIECE='SECH OR PIECE='ABS THEN RETURN(UT),
IF MEMBER(PIECE, %ELIGIBLE)
then RETURN(APPLY(PIECE, [ABSIMP(INPART(UT,1))])),
RETURN(ABS(UT))) $
MATCHDECLARE(NONZERO,NONZEROP, ODDINTEGER,ODDINTEGERP) $
NONZEROP(U) :=
IF EV(IS(U>0 OR U<0),PREDERROR:FALSE)=TRUE THEN TRUE
ELSE FALSE $
TELLSIMPAFTER(SIGNUM(UTRUE)^ODDINTEGER, SIGNUM(UTRUE)) $
TELLSIMPAFTER(SIGNUM(NONZERO)^EVENINTEGER, 1) $
TELLSIMPAFTER('DIFF(SIGNUM(UTRUE),VTRUE),
2*DELTA(UTRUE)*DIFF(UTRUE,VTRUE))$
TELLSIMPAFTER(COSH(SIGNUM(NONZERO)), COSH(1)) $
TELLSIMPAFTER(SECH(SIGNUM(NONZERO)), SECH(1)) $
TELLSIMPAFTER(UTRUE*SIGNUM(UTRUE), ABSIMP(UTRUE)) $
TELLSIMPAFTER(COS(SIGNUM(UTRUE)), COS(1)) $
TELLSIMPAFTER(SEC(SIGNUM(UTRUE)), SEC(1)) $
TELLSIMPAFTER(SIGNUM(UTRUE), SIGNUMSIMP(UTRUE)) $
SIGNUMSIMP(UT) := BLOCK(
[PARTSWITCH, PREDERROR, U, V, B, NOMATCH],
PARTSWITCH:TRUE, PREDERROR:FALSE,
IF ATOM(UT) OR INPART(UT,0)="+" THEN
IF IS(UT>0)=TRUE THEN RETURN(1)
ELSE IF IS(UT<0)=TRUE THEN RETURN(-1)
ELSE RETURN(SIGNUM(UT)),
IF PIECE="*" THEN(U:V:1, W:[],
FOR J:1 STEP 1 WHILE(B:INPART(UT,J))#END DO
IF IS(B<0)=TRUE THEN U:-U
ELSE IF IS(B>0)#TRUE THEN
IF ATOM(B) OR NOT(MEMBER(INPART(B,0),%ELIGIBLE) OR
PIECE="^" AND ODDINTEGERP(INPART(B,2))) THEN(
NOMATCH:TRUE,
FOR WW IN W WHILE NOMATCH DO
IF B=FIRST(WW) THEN (NOMATCH:FALSE,
W:CONS([B,NOT FIRST(REST(WW))], DELETE(WW,W))),
IF NOMATCH THEN W:CONS([B,TRUE],W))
ELSE (NOMATCH:TRUE,
INPART(B,1),
FOR WW IN W WHILE NOMATCH DO
IF PIECE=FIRST(WW) THEN (NOMATCH:FALSE,
W:CONS([PIECE,NOT FIRST(REST(WW))],DELETE(WW,W))),
IF NOMATCH THEN W:CONS([PIECE,TRUE],W)),
IF W=[] THEN RETURN(U),
IF %SIGNUMDISTRIBUTE THEN FOR WW IN W DO U:U*
(IF FIRST(REST(WW)) THEN SIGNUMSIMP(FIRST(WW))
ELSE SIGNUMSIMP(FIRST(WW)^2))
ELSE (
FOR WW IN W DO V:V*(IF FIRST(REST(WW)) THEN FIRST(WW)
ELSE FIRST(WW)^2),
U:U*(IF REST(W)=[] THEN SIGNUMSIMP(V) ELSE 'SIGNUM(V))),
RETURN(U)),
IF PIECE="^" THEN(U:INPART(UT,1),
IF IS(U>0)=TRUE THEN RETURN(1),
V:INPART(UT,2),
IF EVENINTEGERP(V) AND NONZEROP(U) THEN RETURN(1),
IF ODDINTEGERP(V) THEN RETURN(SIGNUMSIMP(U)),
RETURN(SIGNUM(UT))),
IF PIECE='LOG THEN(B:INPART(UT,1),
IF IS(B>1)=TRUE THEN RETURN(1),
IF IS(B<1)=TRUE THEN RETURN(-1),
IF IS(B=1)=TRUE THEN RETURN(0),
RETURN(SIGNUM(UT))),
IF PIECE='COSH OR PIECE='SECH THEN RETURN(1),
IF PIECE='SIGNUM THEN RETURN(UT),
IF MEMBER(PIECE, %ELIGIBLE) THEN RETURN(SIGNUMSIMP(INPART(UT,1))),
RETURN(SIGNUM(UT))) $
TTYOFF: NOLABELS: FALSE $
|
