1(* ::Package:: *)
2
3(************************************************************************)
4(* This file was generated automatically by the Mathematica front end.  *)
5(* It contains Initialization cells from a Notebook file, which         *)
6(* typically will have the same name as this file except ending in      *)
7(* ".nb" instead of ".m".                                               *)
8(*                                                                      *)
9(* This file is intended to be loaded into the Mathematica kernel using *)
10(* the package loading commands Get or Needs.  Doing so is equivalent   *)
11(* to using the Evaluate Initialization Cells menu command in the front *)
12(* end.                                                                 *)
13(*                                                                      *)
14(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
15(* automatically each time the parent Notebook file is saved in the     *)
16(* Mathematica front end.  Any changes you make to this file will be    *)
17(* overwritten.                                                         *)
18(************************************************************************)
19
20
21
22(* TimeLimit is the time constraint in seconds on some potentially expensive routines. *)
23If[Not[NumberQ[TimeLimit]], TimeLimit=1.0];
24
25
26(* Note: Clear[func] also eliminates 2-D display of functions like Integrate. *)
27ClearDownValues[func_Symbol] := (
28  Unprotect[func];
29  DownValues[func]={};
30  Protect[func])
31
32
33SetDownValues[func_Symbol,lst_List] := (
34  Unprotect[func];
35  DownValues[func]=Take[lst,Min[529,Length[lst]]];
36  Scan[Function[ReplacePart[ReplacePart[#,#[[1,1]],1],SetDelayed,0]],Drop[lst,Min[529,Length[lst]]]];
37  Protect[func])
38
39
40(* MoveDownValues[func1,func2] moves func1's DownValues to func2, and deletes them from func1. *)
41MoveDownValues[func1_Symbol,func2_Symbol] := Module[{lst},
42  SetDownValues[func2,ReplaceAll[DownValues[func1],{func1->func2}]];
43  ClearDownValues[func1]]
44
45
46Map2[func_,lst1_,lst2_] :=
47  ReapList[Do[Sow[func[lst1[[i]],lst2[[i]]]],{i,Length[lst1]}]]
48
49
50ReapList[u_] :=
51  Module[{lst=Reap[u][[2]]},
52  If[lst==={}, lst, lst[[1]]]]
53
54SetAttributes[ReapList,HoldFirst]
55
56
57(* MapAnd[f,l] applies f to the elements of list l until False is returned; else returns True *)
58MapAnd[f_,lst_] :=
59  Catch[Scan[Function[If[f[#],Null,Throw[False]]],lst];True]
60
61MapAnd[f_,lst_,x_] :=
62  Catch[Scan[Function[If[f[#,x],Null,Throw[False]]],lst];True]
63
64
65(* MapOr[f,l] applies f to the elements of list l until True is return; else returns False *)
66MapOr[f_,lst_] :=
67  Catch[Scan[Function[If[f[#],Throw[True],Null]],lst];False]
68
69
70(* If u is a sum, MapSum[f,u,x] applies f to the terms of u; else it applies f to u. *)
71(* MapSum[f_,u_,x_Symbol] :=
72  If[SumQ[u],
73    Map[Function[f[#,x]],u],
74  f[u,x]] *)
75
76
77(* NotIntegrableQ[u,x] returns True if u is definitely not integrable wrt x; else it returns
78	False if u is, or might be, integrable wrt x. *)
79NotIntegrableQ[u_,x_Symbol] :=
80  MatchQ[u,x^m_*Log[a_+b_.*x]^n_ /; FreeQ[{a,b},x] && IntegersQ[m,n] && m<0 && n<0] ||
81  MatchQ[u,f_[x^m_.*Log[a_.+b_.*x]] /; FreeQ[{a,b},x] && IntegerQ[m] && (TrigQ[f] || HyperbolicQ[f])]
82
83
84(* ZeroQ[u1,u2,...] returns True if u1, u2, ... are all 0; else returns False *)
85ZeroQ[u_] := Quiet[PossibleZeroQ[u]]
86NonzeroQ[u_] := Not[Quiet[PossibleZeroQ[u]]]
87
88ZeroQ[u__] := Catch[Scan[Function[If[ZeroQ[#],Null,Throw[False]]],{u}];True]
89
90
91(* OneQ[u1,u2,...] returns True if u1, u2, ... are all 1; else returns False *)
92OneQ[u_] := PossibleZeroQ[u-1]
93
94OneQ[u__] := Catch[Scan[Function[If[OneQ[#],Null,Throw[False]]],{u}];True]
95
96
97(* RealNumericQ[u] returns True if u is a real numeric quantity, else returns False. *)
98RealNumericQ[u_] := NumericQ[u] && PossibleZeroQ[Im[N[u]]]
99
100
101(* ImaginaryNumericQ[u] returns True if u is an imaginary numeric quantity, else returns False. *)
102ImaginaryNumericQ[u_] :=
103  NumericQ[u] && PossibleZeroQ[Re[N[u]]] && Not[PossibleZeroQ[Im[N[u]]]]
104
105
106(* PositiveQ[u] returns True if u is a positive numeric quantity, else returns False. *)
107PositiveQ[u_] :=
108  Module[{v=Simplify[u]},
109  RealNumericQ[v] && Re[N[v]]>0]
110
111
112(* PositiveOrZeroQ[u] returns True if u is a nonpositive numeric quantity, else returns False. *)
113PositiveOrZeroQ[u_] :=
114  Module[{v=Simplify[u]},
115  RealNumericQ[v] && Re[N[v]]>=0]
116
117
118(* NegativeQ[u] returns True if u is a negative numeric quantity, else returns False. *)
119NegativeQ[u_] :=
120  Module[{v=Simplify[u]},
121  RealNumericQ[v] && Re[N[v]]<0]
122
123
124(* NegativeQ[u] returns True if u is a negative numeric quantity, else returns False. *)
125NegativeOrZeroQ[u_] :=
126  Module[{v=Simplify[u]},
127  RealNumericQ[v] && Re[N[v]]<=0]
128
129
130(* IntegersQ[m,n,...] returns True if m, n, ... are all explicit integers; else it returns False. *)
131IntegersQ[u__] := Catch[Scan[Function[If[IntegerQ[#],Null,Throw[False]]],{u}]; True];
132
133
134(* PositiveIntegerQ[m,n,...] returns True if m, n, ... are all explicit positive integers; else it returns False. *)
135PositiveIntegerQ[u__] := Catch[Scan[Function[If[IntegerQ[#] && #>0,Null,Throw[False]]],{u}]; True];
136
137
138(* NegativeIntegerQ[m,n,...] returns True if m, n, ... are all explicit negative integers; else it returns False. *)
139NegativeIntegerQ[u__] := Catch[Scan[Function[If[IntegerQ[#] && #<0,Null,Throw[False]]],{u}]; True];
140
141
142(* FractionQ[m,n,...] returns True if m, n, ... are all explicit fractions; else it returns False. *)
143FractionQ[u__] := Catch[Scan[Function[If[Head[#]===Rational,Null,Throw[False]]],{u}]; True]
144
145
146(* RationalQ[m,n,...] returns True if m, n, ... are all explicit integers or fractions; else it returns False. *)
147RationalQ[u__] := Catch[Scan[Function[If[IntegerQ[#] || Head[#]===Rational,Null,Throw[False]]],{u}]; True]
148
149
150(* FractionOrNegativeQ[u] returns True if u is a fraction or negative number; else returns False *)
151FractionOrNegativeQ[u__] := Catch[Scan[Function[If[FractionQ[#] || IntegerQ[#] && #<0,Null,Throw[False]]],{u}]; True]
152
153
154(* SqrtNumberQ[u] returns True if u^2 is a rational number; else it returns False. *)
155SqrtNumberQ[m_^n_] :=
156  IntegerQ[n] && SqrtNumberQ[m] || IntegerQ[n-1/2] && RationalQ[m]
157
158SqrtNumberQ[u_*v_] :=
159  SqrtNumberQ[u] && SqrtNumberQ[v]
160
161SqrtNumberQ[u_] :=
162  RationalQ[u] || u===I
163
164
165SqrtNumberSumQ[u_] :=
166  SumQ[u] && SqrtNumberQ[First[u]] && SqrtNumberQ[Rest[u]] ||
167  ProductQ[u] && SqrtNumberQ[First[u]] && SqrtNumberSumQ[Rest[u]]
168
169
170(* AlgebraicNumberQ[u] returns True if u is a real-valued algebraic number (a rational number,
171   an algebraic number raised to an integer power, a positive algebraic number raised to a
172   fractional power, or a product or sum of algebraic numbers); else returns False. *)
173(* AlgebraicNumberQ[u_] :=
174  MapAnd[AlgebraicNumberQ,u] /;
175ListQ[u]
176
177AlgebraicNumberQ[u_^v_] :=
178  AlgebraicNumberQ[u] && (IntegerQ[v] || PositiveQ[u] && FractionQ[v])
179
180AlgebraicNumberQ[u_*v_] :=
181  AlgebraicNumberQ[u] && AlgebraicNumberQ[v]
182
183AlgebraicNumberQ[u_+v_] :=
184  AlgebraicNumberQ[u] && AlgebraicNumberQ[v]
185
186AlgebraicNumberQ[u_] :=
187  RationalQ[u] *)
188
189
190NiceSqrtQ[u_] :=
191  Not[NegativeQ[u]] && NiceSqrtAuxQ[u]
192
193NiceSqrtAuxQ[u_] :=
194  If[RationalQ[u],
195    u>0,
196  If[PowerQ[u],
197    EvenQ[u[[2]]],
198  If[ProductQ[u],
199    NiceSqrtAuxQ[First[u]] && NiceSqrtAuxQ[Rest[u]],
200  If[SumQ[u],
201    Function[NonsumQ[#] && NiceSqrtAuxQ[#]] [Simplify[u]],
202  False]]]]
203
204
205(* If u is a rational number whose squareroot is rational or if u is of the form u1^n1 u2^n2 ...
206	and n1, n2, ... are even, PerfectSquareQ[u] returns True; else it returns False. *)
207PerfectSquareQ[u_] :=
208  If[RationalQ[u],
209    u>0 && u!=1 && RationalQ[Sqrt[u]],
210  If[PowerQ[u],
211    EvenQ[u[[2]]],
212  If[ProductQ[u],
213    PerfectSquareQ[First[u]] && PerfectSquareQ[Rest[u]],
214  If[SumQ[u],
215    Function[NonsumQ[#] && PerfectSquareQ[#]] [Simplify[u]],
216  False]]]]
217
218
219(* If u is a perfect square, PerfectSquareRoot[u] returns the squareroot of u. *)
220(* PerfectSquareRoot[u_] :=
221  If[RationalQ[u],
222    Sqrt[u],
223  If[PowerQ[u],
224    u[[1]]^(u[[2]]/2),
225  If[ProductQ[u],
226    PerfectSquareRoot[First[u]]*PerfectSquareRoot[Rest[u]],
227  If[SumQ[u],
228    PerfectSquareRoot[Simplify[u]],
229  False]]]] *)
230
231
232FalseQ[u_] :=
233  u===False
234
235
236NotFalseQ[u_] :=
237  u=!=False
238
239
240SumQ[u_] :=
241  Head[u]===Plus
242
243NonsumQ[u_] :=
244  Head[u]=!=Plus
245
246ProductQ[u_] :=
247  Head[u]===Times
248
249PowerQ[u_] :=
250  Head[u]===Power
251
252IntegerPowerQ[u_] :=
253  PowerQ[u] && IntegerQ[u[[2]]]
254
255PositiveIntegerPowerQ[u_] :=
256  PowerQ[u] && IntegerQ[u[[2]]] && u[[2]]>0
257
258FractionalPowerQ[u_] :=
259  PowerQ[u] && FractionQ[u[[2]]]
260
261RationalPowerQ[u_] :=
262  PowerQ[u] && RationalQ[u[[2]]]
263
264SqrtQ[u_] :=
265  PowerQ[u] && u[[2]]===1/2
266
267ExpQ[u_] :=
268  PowerQ[u] && u[[1]]===E
269
270ImaginaryQ[u_] :=\
271  Head[u]===Complex && Re[u]===0
272
273
274FractionalPowerFreeQ[u_] :=
275  If[AtomQ[u],
276    True,
277  If[FractionalPowerQ[u] && Not[AtomQ[u[[1]]]],
278    False,
279  Catch[Scan[Function[If[FractionalPowerFreeQ[#],Null,Throw[False]]],u];True]]]
280
281
282ComplexFreeQ[u_] :=
283  If[AtomQ[u],
284    Head[u]=!=Complex,
285  Catch[Scan[Function[If[ComplexFreeQ[#],Null,Throw[False]]],u];True]]
286
287
288LogQ[u_] :=
289  Head[u]===Log
290
291
292SinQ[u_] :=
293  Head[u]===Sin
294
295CosQ[u_] :=
296  Head[u]===Cos
297
298TanQ[u_] :=
299  Head[u]===Tan
300
301CotQ[u_] :=
302  Head[u]===Cot
303
304SecQ[u_] :=
305  Head[u]===Sec
306
307CscQ[u_] :=
308  Head[u]===Csc
309
310
311SinhQ[u_] :=
312  Head[u]===Sinh
313
314CoshQ[u_] :=
315  Head[u]===Cosh
316
317TanhQ[u_] :=
318  Head[u]===Tanh
319
320CothQ[u_] :=
321  Head[u]===Coth
322
323SechQ[u_] :=
324  Head[u]===Sech
325
326CschQ[u_] :=
327  Head[u]===Csch
328
329
330(* TrigQ[u] returns True if u or the head of u is a trig function; else returns False *)
331TrigQ[u_] :=
332  MemberQ[{Sin,Cos,Tan,Cot,Sec,Csc},If[AtomQ[u],u,Head[u]]]
333
334(* InverseTrigQ[u] returns True if u or the head of u is an inverse trig function; else returns False *)
335InverseTrigQ[u_] :=
336  MemberQ[{ArcSin,ArcCos,ArcTan,ArcCot,ArcSec,ArcCsc},If[AtomQ[u],u,Head[u]]]
337
338(* HyperbolicQ[u] returns True if u or the head of u is a trig function; else returns False *)
339HyperbolicQ[u_] :=
340  MemberQ[{Sinh,Cosh,Tanh,Coth,Sech,Csch},If[AtomQ[u],u,Head[u]]]
341
342(* InverseHyperbolicQ[u] returns True if u or the head of u is an inverse trig function; else returns False *)
343InverseHyperbolicQ[u_] :=
344  MemberQ[{ArcSinh,ArcCosh,ArcTanh,ArcCoth,ArcSech,ArcCsch},If[AtomQ[u],u,Head[u]]]
345
346
347SinCosQ[f_] :=
348  MemberQ[{Sin,Cos,Sec,Csc},f]
349
350
351SinhCoshQ[f_] :=
352  MemberQ[{Sinh,Cosh,Sech,Csch},f]
353
354
355CalculusFunctions={D,Integrate,Sum,Product,Int,Dif,Subst};
356
357(* CalculusQ[u] returns True if the head of u is a calculus function; else returns False *)
358CalculusQ[u_] :=
359  MemberQ[CalculusFunctions,Head[u]]
360
361CalculusFreeQ[u_,x_] :=
362  If[AtomQ[u],
363    True,
364  If[CalculusQ[u] && u[[2]]===x || HeldFormQ[u],
365    False,
366  Catch[Scan[Function[If[CalculusFreeQ[#,x],Null,Throw[False]]],u];True]]]
367
368
369HeldFormQ[u_] :=
370  If[AtomQ[Head[u]],
371    MemberQ[{Hold,HoldForm,Defer,Pattern},Head[u]],
372  HeldFormQ[Head[u]]]
373
374
375(* InverseFunctionQ[u] returns True if u is a call on an inverse function; else returns False. *)
376InverseFunctionQ[u_] :=
377  LogQ[u] || InverseTrigQ[u] && Length[u]==1 || InverseHyperbolicQ[u] || Head[u]===Mods
378
379
380(* If u is free of inverse or calculus functions involving x,
381	InverseFunctionFreeQ[u,x] returns true; else it returns False. *)
382TrigHyperbolicFreeQ[u_,x_Symbol] :=
383  If[AtomQ[u],
384    True,
385  If[TrigQ[u] || HyperbolicQ[u] || CalculusQ[u],
386    FreeQ[u,x],
387  Catch[Scan[Function[If[TrigHyperbolicFreeQ[#,x],Null,Throw[False]]],u];True]]]
388
389
390(* If u is free of inverse or calculus functions involving x,
391	InverseFunctionFreeQ[u,x] returns true; else it returns False. *)
392InverseFunctionFreeQ[u_,x_Symbol] :=
393  If[AtomQ[u],
394    True,
395  If[InverseFunctionQ[u] || CalculusQ[u],
396(*  If[Head[u]===ArcTan && TanQ[u[[1]]] || Head[u]===ArcCot && CotQ[u[[1]]] ||
397       Head[u]===ArcTanh && TanhQ[u[[1]]] || Head[u]===ArcCoth && CothQ[u[[1]]],
398      InverseFunctionFreeQ[u[[1,1]],x], *)
399    FreeQ[u,x],
400  Catch[Scan[Function[If[InverseFunctionFreeQ[#,x],Null,Throw[False]]],u];True]]]
401
402
403(* ElementaryExpressionQ[u] returns True if u is a sum, product, or power and all the operands
404	are elementary expressions; or if u is a call on a trig, hyperbolic, or inverse function
405	and all the arguments are elementary expressions; else it returns False. *)
406(* ElementaryFunctionQ[u_] :=
407  If[AtomQ[u],
408    True,
409  If[SumQ[u] || ProductQ[u] || PowerQ[u] || TrigQ[u] || HyperbolicQ[u] || InverseFunctionQ[u],
410    Catch[Scan[Function[If[ElementaryFunctionQ[#],Null,Throw[False]]],u];True],
411  False]] *)
412
413
414(* If u is an expression of the form -v, NegativeCoefficientQ[u] returns True; else False. *)
415NegativeCoefficientQ[u_] :=
416  If[SumQ[u],
417(*  MapAnd[NegativeCoefficientQ,u], *)
418    NegativeCoefficientQ[First[u]],
419  MatchQ[u, m_*v_. /; RationalQ[m] && m<0]]
420
421
422(* Real[u] returns True if u is a real-valued quantity, else returns False. *)
423RealQ[u_] :=
424  MapAnd[RealQ,u] /;
425ListQ[u]
426
427RealQ[u_] :=
428  PossibleZeroQ[Im[N[u]]] /;
429NumericQ[u]
430
431RealQ[u_^v_] :=
432  RealQ[u] && RealQ[v] && (IntegerQ[v] || PositiveOrZeroQ[u])
433
434RealQ[u_*v_] :=
435  RealQ[u] && RealQ[v]
436
437RealQ[u_+v_] :=
438  RealQ[u] && RealQ[v]
439
440RealQ[f_[u_]] :=
441  If[MemberQ[{Sin,Cos,Tan,Cot,Sec,Csc,ArcTan,ArcCot,Erf},f],
442    RealQ[u],
443  If[MemberQ[{ArcSin,ArcCos},f],
444    LE[-1,u,1],
445  If[f===Log,
446    PositiveOrZeroQ[u],
447  False]]]
448
449RealQ[u_] :=
450  False
451
452
453(* If u is not 0 and has a positive form, PosQ[u] returns True, else it returns False. *)
454PosQ[u_] :=
455  If[RationalQ[u],
456    u>0,
457  If[NumberQ[u],
458    If[PossibleZeroQ[Re[u]],
459      Im[u]>0,
460    Re[u]>0],
461  If[NumericQ[u],
462    Module[{v=N[u]},
463    If[PossibleZeroQ[Re[v]],
464      Im[v]>0,
465    Re[v]>0]],
466  If[ProductQ[u],
467    If[PosQ[First[u]],
468      PosQ[Rest[u]],
469    Not[PosQ[Rest[u]]]],
470(*  Module[{v=Together[u]},
471    If[ProductQ[v],
472      If[PosQ[First[v]],
473        PosQ[Rest[v]],
474      Not[PosQ[Rest[v]]]],
475    PosQ[v]]], *)
476  If[SumQ[u],
477    Module[{v=Together[Simplify[Together[u]]]},
478    If[SumQ[v],
479      PosQ[First[v]],
480    PosQ[v]]],
481  True]]]]]
482
483
484NegQ[u_] :=
485  If[PossibleZeroQ[u],
486    False,
487  Not[PosQ[u]]]
488
489
490LeadTerm[u_] :=
491  If[SumQ[u],
492    First[u],
493  u]
494
495
496RemainingTerms[u_] :=
497  If[SumQ[u],
498    Rest[u],
499  0]
500
501
502(* LeadFactor[u] returns the leading factor of u. *)
503LeadFactor[u_] :=
504  If[ProductQ[u],
505    LeadFactor[First[u]],
506  If[ImaginaryQ[u],
507    If[Im[u]===1,
508      u,
509    LeadFactor[Im[u]]],
510  u]]
511
512
513(* RemainingFactors[u] returns the remaining factors of u. *)
514RemainingFactors[u_] :=
515  If[ProductQ[u],
516    RemainingFactors[First[u]]*Rest[u],
517  If[ImaginaryQ[u],
518    If[Im[u]===1,
519      1,
520    I*RemainingFactors[Im[u]]],
521  1]]
522
523
524(* LeadBase[u] returns the base of the leading factor of u. *)
525LeadBase[u_] :=
526  Module[{v=LeadFactor[u]},
527  If[PowerQ[v],
528    v[[1]],
529  v]]
530
531
532(* LeadDegree[u] returns the degree of the leading factor of u. *)
533LeadDegree[u_] :=
534  Module[{v=LeadFactor[u]},
535  If[PowerQ[v],
536    v[[2]],
537  1]]
538
539
540(* If v^n is a factor of u, FindFactor[u,v] returns the list {n,u/v^n}; else it returns False. *)
541(* FindFactor[u_,v_] :=
542  If[u===1,
543    False,
544  If[LeadBase[u]===v,
545    {LeadDegree[u], RemainingFactors[u]},
546  Module[{lst=FindFactor[RemainingFactors[u],v]},
547  If[FalseQ[lst],
548    False,
549  {lst[[1]], LeadFactor[u]*lst[[2]]}]]]] *)
550
551
552(* LT[u,v] returns True if u and v are real-valued numeric quantities and u<v, else returns False *)
553LT[u_,v_] :=
554  RealNumericQ[u] && RealNumericQ[v] && Re[N[u]]<Re[N[v]]
555
556LT[u_,v_,w_] :=
557  LT[u,v] && LT[v,w]
558
559
560(* LE[u,v] returns True if u and v are real-valued numeric quantities and u<=v, else returns False *)
561LE[u_,v_] :=
562  RealNumericQ[u] && RealNumericQ[v] && Re[N[u]]<=Re[N[v]]
563
564LE[u_,v_,w_] :=
565  LE[u,v] && LE[v,w]
566
567
568(* GT[u,v] returns True if u and v are real-valued numeric quantities and u>v, else returns False *)
569GT[u_,v_] :=
570  RealNumericQ[u] && RealNumericQ[v] && Re[N[u]]>Re[N[v]]
571
572GT[u_,v_,w_] :=
573  GT[u,v] && GT[v,w]
574
575
576(* GE[u,v] returns True if u and v are real-valued numeric quantities and u>=v, else returns False *)
577GE[u_,v_] :=
578  RealNumericQ[u] && RealNumericQ[v] && Re[N[u]]>=Re[N[v]]
579
580GE[u_,v_,w_] :=
581  GE[u,v] && GE[v,w]
582
583
584IndependentQ[u_,x_Symbol] :=
585  FreeQ[u,x]
586
587
588(* SplitFreeFactors[u,x] returns the list {v,w} where v is the product of the factors of u free of x
589	and w is the product of the other factors. *)
590(* Compare with the more active function ConstantFactor. *)
591SplitFreeFactors[u_,x_Symbol] :=
592  If[ProductQ[u],
593    Map[Function[If[FreeQ[#,x],{#,1},{1,#}]],u],
594  If[FreeQ[u,x],
595    {u,1},
596  {1,u}]]
597
598
599(* SplitFreeTerms[u,x] returns the list {v,w} where v is the sum of the terms of u free of x
600	and w is the sum of the other terms. *)
601SplitFreeTerms[u_,x_Symbol] :=
602  If[SumQ[u],
603    Map[Function[SplitFreeTerms[#,x]],u],
604  If[FreeQ[u,x],
605    {u,0},
606  {0,u}]]
607
608
609(* If u (x) is a sum of the form a+b*v+c*w+..., SplitFactorsOfTerms[u,x] returns the list
610	{{1,a},{b,v},{c,w},...}, where v, w, ... are regularized wrt x. *)
611SplitFactorsOfTerms[u_,x_Symbol] :=
612  Module[{lst=SplitFreeTerms[u,x],v,w},
613  v=lst[[1]];
614  w=lst[[2]];
615  ( If[ZeroQ[w],
616      lst={},
617    If[SumQ[w],
618      lst=Map[Function[SplitFreeFactors[#,x]],Apply[List,w]];
619      lst=Map[Function[Prepend[SplitFreeFactors[Regularize[#[[2]],x],x],#[[1]]]],lst];
620      lst=Map[Function[{#[[1]]*#[[2]],#[[3]]}],lst],
621    lst=SplitFreeFactors[w,x];
622    lst=Prepend[SplitFreeFactors[Regularize[lst[[2]],x],x],lst[[1]]];
623    lst={{lst[[1]]*lst[[2]],lst[[3]]}}]] );
624  If[ZeroQ[v],
625    lst,
626  Prepend[lst,{1,v}]]]
627
628
629LinearQ[u_,x_Symbol,flag_:False] :=
630  If[ListQ[u],
631    Catch[Scan[Function[If[LinearQ[#,x,flag],Null,Throw[False]]],u]; True],
632  If[flag,
633    MatchQ[u, a_.+b_.*x /; FreeQ[{a,b},x]],
634  PolynomialQ[u,x] && Exponent[u,x]==1]]
635
636
637QuadraticQ[u_,x_Symbol,flag_:False] :=
638  If[ListQ[u],
639    Catch[Scan[Function[If[QuadraticQ[#,x,flag],Null,Throw[False]]],u]; True],
640  If[flag,
641    MatchQ[u, a_.+b_.*x+c_.*x^2 /; FreeQ[{a,b,c},x]] || MatchQ[u, a_.+c_.*x^2 /; FreeQ[{a,c},x]],
642  PolynomialQ[u,x] && Exponent[u,x]==2]]
643
644
645BinomialQ[u_,x_Symbol,flag_:False] :=
646  If[ListQ[u],
647    Catch[Scan[Function[If[BinomialQ[#,x,flag],Null,Throw[False]]],u]; True],
648  If[flag===False,
649    NotFalseQ[BinomialTest[u,x]],
650  If[flag===True,
651    MatchQ[u, a_.+b_.*x^n_. /; FreeQ[{a,b,n},x]],
652  Function[NotFalseQ[#] && #[[3]]===flag][BinomialTest[u,x]]]]]
653
654
655GeneralizedBinomialQ[u_,x_Symbol,flag_:False] :=
656  If[ListQ[u],
657    Catch[Scan[Function[If[GeneralizedBinomialQ[#,x,flag],Null,Throw[False]]],u]; True],
658  If[flag,
659    MatchQ[u, a_.*x^q_.+b_.*x^n_. /; FreeQ[{a,b,n,q},x]],
660  NotFalseQ[GeneralizedBinomialTest[u,x]]]]
661
662
663TrinomialQ[u_,x_Symbol,flag_:False] :=
664  If[ListQ[u],
665    Catch[Scan[Function[If[TrinomialQ[#,x,flag],Null,Throw[False]]],u]; True],
666  If[flag,
667    MatchQ[u, a_.+b_.*x^n_.+c_.*x^j_. /; FreeQ[{a,b,c,n},x] && ZeroQ[j-2*n]],
668  NotFalseQ[TrinomialTest[u,x]] && Not[QuadraticQ[u,x]] && Not[MatchQ[u,w_^2 /; BinomialQ[w,x]]]]]
669
670
671GeneralizedTrinomialQ[u_,x_Symbol,flag_:False] :=
672  If[ListQ[u],
673    Catch[Scan[Function[If[GeneralizedTrinomialQ[#,x,flag],Null,Throw[False]]],u]; True],
674  If[flag,
675    MatchQ[u, a_.*x^q_.+b_.*x^n_.+c_.*x^r_. /; FreeQ[{a,b,c,n,q},x] && ZeroQ[r-(2*n-q)]],
676  NotFalseQ[GeneralizedTrinomialTest[u,x]]]]
677
678
679(* If u is of the form a*x^n where n!=0 and a!=0, MonomialQ[u,x] returns True; else False. *)
680MonomialQ[u_,x_Symbol] :=
681  If[ListQ[u],
682    Catch[Scan[Function[If[MonomialQ[#,x],Null,Throw[False]]],u]; True],
683  MatchQ[u, a_.*x^n_. /; FreeQ[{a,n},x]]]
684
685
686(* If u[x] is a sum and each term is free of x or an expression of the form a*x^n,
687	MonomialSumQ[u,x] returns True; else it returns False. *)
688MonomialSumQ[u_,x_Symbol] :=
689  SumQ[u] && Catch[
690	Scan[Function[If[FreeQ[#,x] || MonomialQ[#,x], Null, Throw[False]]],u];
691    True]
692
693
694(* u is sum whose terms are monomials.  MinimumExponent[u,x] returns the exponent of the term having the smallest exponent. *)
695MinimumMonomialExponent[u_,x_Symbol] :=
696  Module[{n=MonomialExponent[First[u],x]},
697  Scan[Function[If[PosQ[n-MonomialExponent[#,x]],n=MonomialExponent[#,x]]],u];
698  n]
699
700
701(* u is a monomial. MonomialExponent[u,x] returns the exponent of x in u. *)
702MonomialExponent[a_.*x_^n_.,x_Symbol] :=
703  n /;
704FreeQ[{a,n},x]
705
706
707(* If u (x) is an expression of the form a*x^n where n is zero or a positive integer,
708	PolynomialTermQ[u,x] returns True; else it returns False. *)
709PolynomialTermQ[u_,x_Symbol] :=
710  FreeQ[u,x] || MatchQ[u,a_.*x^n_. /; FreeQ[a,x] && IntegerQ[n] && n>0]
711
712
713(* u (x) is a sum.  PolynomialTerms[u,x] returns the sum of the polynomial terms of u (x). *)
714PolynomialTerms[u_,x_Symbol] :=
715  Map[Function[If[PolynomialTermQ[#,x],#,0]],u]
716
717
718(* u (x) is a sum.  NonpolynomialTerms[u,x] returns the sum of the nonpolynomial terms of u (x). *)
719NonpolynomialTerms[u_,x_Symbol] :=
720  Map[Function[If[PolynomialTermQ[#,x],0,#]],u]
721
722
723(* u is a binomial. BinomialDegree[u,x] returns the degree of x in u. *)
724BinomialDegree[u_,x_Symbol] :=
725  BinomialTest[u,x][[3]]
726
727
728(* If u[x] is equivalent to an expression of the form a+b*x^n where n!=0 and b!=0,
729	BinomialTest[u,x] returns the list {a,b,n}; else it returns False. *)
730BinomialTest[u_,x_Symbol] :=
731  If[PowerQ[u],
732    If[ZeroQ[u[[1]]-x] && FreeQ[u[[2]],x],
733      {0,1,u[[2]]},
734    False],
735  If[PolynomialQ[u,x],
736    Module[{lst=CoefficientList[u,x]},
737    If[Length[lst]<2,
738      False,
739    Catch[
740      Scan[Function[If[ZeroQ[#],Null,Throw[False]]],Drop[Drop[lst,1],-1]];
741      {First[lst],Last[lst],Length[lst]-1}]]],
742  Module[{lst1,lst2},
743  If[ProductQ[u],
744    If[FreeQ[First[u],x],
745      lst2=BinomialTest[Rest[u],x];
746      If[FalseQ[lst2],
747        False,
748      {First[u]*lst2[[1]],First[u]*lst2[[2]],lst2[[3]]}],
749    If[FreeQ[Rest[u],x],
750      lst1=BinomialTest[First[u],x];
751      If[FalseQ[lst1],
752        False,
753      {Rest[u]*lst1[[1]],Rest[u]*lst1[[2]],lst1[[3]]}],
754    lst1=BinomialTest[First[u],x];
755    lst2=BinomialTest[Rest[u],x];
756    If[FalseQ[lst1] || FalseQ[lst2],
757      False,
758    Module[{a,b,c,d,m,n},
759    {a,b,m}=lst1;
760    {c,d,n}=lst2;
761    If[ZeroQ[a],
762      If[ZeroQ[c],
763        {0,b*d,m+n},
764      If[ZeroQ[m+n],
765        {b*d,b*c,m},
766      False]],
767    If[ZeroQ[c],
768      If[ZeroQ[m+n],
769        {b*d,a*d,n},
770      False],
771    If[ZeroQ[m-n] && ZeroQ[a*d+b*c],
772      {a*c,b*d,2*m},
773    False]]]]]]],
774  If[SumQ[u],
775    If[FreeQ[First[u],x],
776      lst2=BinomialTest[Rest[u],x];
777      If[FalseQ[lst2],
778        False,
779      {First[u]+lst2[[1]],lst2[[2]],lst2[[3]]}],
780    If[FreeQ[Rest[u],x],
781      lst1=BinomialTest[First[u],x];
782      If[FalseQ[lst1],
783        False,
784      {Rest[u]+lst1[[1]],lst1[[2]],lst1[[3]]}],
785    lst1=BinomialTest[First[u],x];
786    lst2=BinomialTest[Rest[u],x];
787    If[FalseQ[lst1] || FalseQ[lst2],
788      False,
789    If[ZeroQ[lst1[[3]]-lst2[[3]]],
790      {lst1[[1]]+lst2[[1]],lst1[[2]]+lst2[[2]],lst1[[3]]},
791    False]]]],
792  False]]]]]
793
794
795(* If u is equivalent to a generalized binomial of the form a*x^q + b*x^n where a, b, n, and q not equal 0,
796	GeneralizedBinomialDegree[u,x] returns n-q. *)
797GeneralizedBinomialDegree[u_,x_Symbol] :=
798  Function[#[[3]]-#[[4]]][GeneralizedBinomialTest[u,x]]
799
800
801(* If u is equivalent to a generalized binomial of the form a*x^q + b*x^n where a, b, n, and q not equal 0,
802	GeneralizedBinomialTest[u,x] returns the list {a,b,n,q}; else it returns False. *)
803GeneralizedBinomialTest[a_.*x_^q_.+b_.*x_^n_.,x_Symbol] :=
804  {a,b,n,q} /;
805FreeQ[{a,b,n,q},x] && PosQ[n-q]
806
807GeneralizedBinomialTest[a_*u_,x_Symbol] :=
808  Module[{lst=GeneralizedBinomialTest[u,x]},
809  {a*lst[[1]], a*lst[[2]], lst[[3]], lst[[4]]} /;
810 NotFalseQ[lst]] /;
811FreeQ[a,x]
812
813GeneralizedBinomialTest[x_^m_.*u_,x_Symbol] :=
814  Module[{lst=GeneralizedBinomialTest[u,x]},
815  {lst[[1]], lst[[2]], m+lst[[3]], m+lst[[4]]} /;
816 NotFalseQ[lst] && NonzeroQ[m+lst[[3]]] && NonzeroQ[m+lst[[4]]]] /;
817FreeQ[m,x]
818
819GeneralizedBinomialTest[x_^m_.*u_,x_Symbol] :=
820  Module[{lst=BinomialTest[u,x]},
821  {lst[[1]], lst[[2]], m+lst[[3]], m} /;
822 NotFalseQ[lst] && NonzeroQ[m+lst[[3]]]] /;
823FreeQ[m,x]
824
825GeneralizedBinomialTest[u_,x_Symbol] :=
826  False
827
828
829(* If u is equivalent to a trinomial of the form a + b*x^n + c*x^(2*n) where n!=0, b!=0 and c!=0,
830	TrinomialDegree[u,x] returns n. *)
831TrinomialDegree[u_,x_Symbol] :=
832  TrinomialTest[u,x][[4]]
833
834
835(* If u is equivalent to a trinomial of the form a + b*x^n + c*x^(2*n) where n!=0, b!=0 and c!=0,
836	TrinomialTest[u,x] returns the list {a,b,c,n}; else it returns False. *)
837TrinomialTest[u_,x_Symbol] :=
838  If[PolynomialQ[u,x],
839    Module[{lst=CoefficientList[u,x]},
840    If[Length[lst]<3 || EvenQ[Length[lst]] || ZeroQ[lst[[(Length[lst]+1)/2]]],
841      False,
842    Catch[
843      Scan[Function[If[ZeroQ[#],Null,Throw[False]]],Drop[Drop[Drop[lst,{(Length[lst]+1)/2}],1],-1]];
844      {First[lst],lst[[(Length[lst]+1)/2]],Last[lst],(Length[lst]-1)/2}]]],
845  If[PowerQ[u],
846    If[ZeroQ[u[[2]]-2],
847      Module[{lst=BinomialTest[u[[1]],x]},
848      If[FalseQ[lst],
849        False,
850      {lst[[1]]^2,2*lst[[1]]*lst[[2]],lst[[2]]^2,lst[[3]]}]],
851    False],
852  Module[{lst1,lst2},
853  If[ProductQ[u],
854    If[FreeQ[First[u],x],
855      lst2=TrinomialTest[Rest[u],x];
856      If[FalseQ[lst2],
857        False,
858      {First[u]*lst2[[1]],First[u]*lst2[[2]],First[u]*lst2[[3]],lst2[[4]]}],
859    If[FreeQ[Rest[u],x],
860      lst1=TrinomialTest[First[u],x];
861      If[FalseQ[lst1],
862        False,
863      {Rest[u]*lst1[[1]],Rest[u]*lst1[[2]],Rest[u]*lst1[[3]],lst1[[4]]}],
864    lst1=BinomialTest[First[u],x];
865    lst2=BinomialTest[Rest[u],x];
866    If[FalseQ[lst1] || FalseQ[lst2],
867      False,
868    Module[{a,b,c,d,m,n},
869    {a,b,m}=lst1;
870    {c,d,n}=lst2;
871    If[ZeroQ[m-n] && NonzeroQ[a*d+b*c],
872      {a*c,a*d+b*c,b*d,m},
873    False]]]]],
874  If[SumQ[u],
875    If[FreeQ[First[u],x],
876      lst2=TrinomialTest[Rest[u],x];
877      If[FalseQ[lst2],
878        False,
879      {First[u]+lst2[[1]],lst2[[2]],lst2[[3]],lst2[[4]]}],
880    If[FreeQ[Rest[u],x],
881      lst1=TrinomialTest[First[u],x];
882      If[FalseQ[lst1],
883        False,
884      {Rest[u]+lst1[[1]],lst1[[2]],lst1[[3]],lst1[[4]]}],
885    lst1=TrinomialTest[First[u],x];
886    If[FalseQ[lst1],
887      lst1=BinomialTest[First[u],x];
888      If[FalseQ[lst1],
889        False,
890      lst2=TrinomialTest[Rest[u],x];
891      If[FalseQ[lst2],
892        lst2=BinomialTest[Rest[u],x];
893        If[FalseQ[lst2],
894          False,
895        If[ZeroQ[lst1[[3]]-2*lst2[[3]]],
896          {lst1[[1]]+lst2[[1]],lst2[[2]],lst1[[2]],lst2[[3]]},
897        If[ZeroQ[lst2[[3]]-2*lst1[[3]]],
898          {lst1[[1]]+lst2[[1]],lst1[[2]],lst2[[2]],lst1[[3]]},
899        False]]],
900      If[ZeroQ[lst1[[3]]-lst2[[4]]] && NonzeroQ[lst1[[2]]+lst2[[2]]],
901        {lst1[[1]]+lst2[[1]],lst1[[2]]+lst2[[2]],lst2[[3]],lst2[[4]]},
902      If[ZeroQ[lst1[[3]]-2*lst2[[4]]] && NonzeroQ[lst1[[2]]+lst2[[3]]],
903        {lst1[[1]]+lst2[[1]],lst2[[2]],lst1[[2]]+lst2[[3]],lst2[[4]]},
904      False]]]],
905    lst2=TrinomialTest[Rest[u],x];
906    If[FalseQ[lst2],
907      lst2=BinomialTest[Rest[u],x];
908      If[FalseQ[lst2],
909        False,
910      If[ZeroQ[lst2[[3]]-lst1[[4]]] && NonzeroQ[lst1[[2]]+lst2[[2]]],
911        {lst1[[1]]+lst2[[1]],lst1[[2]]+lst2[[2]],lst1[[3]],lst1[[4]]},
912      If[ZeroQ[lst2[[3]]-2*lst1[[4]]] && NonzeroQ[lst1[[3]]+lst2[[2]]],
913        {lst1[[1]]+lst2[[1]],lst1[[2]],lst1[[3]]+lst2[[2]],lst1[[4]]},
914      False]]],
915    If[ZeroQ[lst1[[4]]-lst2[[4]]] && NonzeroQ[lst1[[2]]+lst2[[2]]] && NonzeroQ[lst1[[3]]+lst2[[3]]],
916      {lst1[[1]]+lst2[[1]],lst1[[2]]+lst2[[2]],lst1[[3]]+lst2[[3]],lst1[[4]]},
917    False]]]]],
918  False]]]]]
919
920
921(* If u is equivalent to a generalized trinomial of the form a*x^q + b*x^n + c*x^(2*n-q) where n!=0, q!=0, b!=0 and c!=0,
922	GeneralizedTrinomialDegree[u,x] returns n-q. *)
923GeneralizedTrinomialDegree[u_,x_Symbol] :=
924  Function[#[[4]]-#[[5]]][GeneralizedTrinomialTest[u,x]]
925
926
927(* If u is equivalent to a generalized trinomial of the form a*x^q + b*x^n + c*x^(2*n-q) where n!=0, q!=0, b!=0 and c!=0,
928	GeneralizedTrinomialTest[u,x] returns the list {a,b,c,n,q}; else it returns False. *)
929GeneralizedTrinomialTest[a_.*x_^q_.+b_.*x_^n_.+c_.*x_^r_.,x_Symbol] :=
930  {a,b,c,n,q} /;
931FreeQ[{a,b,c,n,q},x] && ZeroQ[r-(2*n-q)]
932
933GeneralizedTrinomialTest[a_*u_,x_Symbol] :=
934  Module[{lst=GeneralizedTrinomialTest[u,x]},
935  {a*lst[[1]], a*lst[[2]], a*lst[[3]], lst[[4]], lst[[5]]} /;
936 NotFalseQ[lst]] /;
937FreeQ[a,x]
938
939GeneralizedTrinomialTest[x_^m_.*u_,x_Symbol] :=
940  Module[{lst=GeneralizedTrinomialTest[u,x]},
941  {lst[[1]], lst[[2]], lst[[3]], m+lst[[4]], m+lst[[5]]} /;
942 NotFalseQ[lst] && NonzeroQ[m+lst[[4]]] && NonzeroQ[m+lst[[5]]]] /;
943FreeQ[m,x]
944
945GeneralizedTrinomialTest[x_^m_.*u_,x_Symbol] :=
946  Module[{lst=TrinomialTest[u,x]},
947  {lst[[1]], lst[[2]], lst[[3]], m+lst[[4]], m} /;
948 NotFalseQ[lst] && NonzeroQ[m+lst[[4]]]] /;
949FreeQ[m,x]
950
951GeneralizedTrinomialTest[u_,x_Symbol] :=
952  False
953
954
955(* If u (x) is equivalent to a polynomial raised to an integer power greater than 1,
956	PerfectPowerTest[u,x] returns u (x) as an expanded polynomial raised to the power;
957	else it returns False. *)
958PerfectPowerTest[u_,x_Symbol] :=
959  If[PolynomialQ[u,x],
960    Module[{lst=FactorSquareFreeList[u],gcd=0,v=1},
961    If[lst[[1]]==={1,1},
962      lst=Rest[lst]];
963    Scan[Function[gcd=GCD[gcd,#[[2]]]],lst];
964    If[gcd>1,
965      Scan[Function[v=v*#[[1]]^(#[[2]]/gcd)],lst];
966      Expand[v]^gcd,
967    False]],
968  False]
969
970
971(* If u (x) can be square free factored, SquareFreeFactorTest[u,x] returns u (x) in
972	factored form; else it returns False. *)
973(* SquareFreeFactorTest[u_,x_Symbol] :=
974  If[PolynomialQ[u,x],
975    Module[{v=FactorSquareFree[u]},
976    If[PowerQ[v] || ProductQ[v],
977      v,
978    False]],
979  False] *)
980
981
982(* If u is a polynomial or rational function of x, RationalFunctionQ[u,x] returns True;
983	else it returns False. *)
984RationalFunctionQ[u_,x_Symbol] :=
985  If[AtomQ[u],
986    True,
987  If[IntegerPowerQ[u],
988    RationalFunctionQ[u[[1]],x],
989  If[ProductQ[u] || SumQ[u],
990    Catch[Scan[Function[If[RationalFunctionQ[#,x],Null,Throw[False]]],u];True],
991  If[FreeQ[u,x],
992    True,
993  False]]]]
994
995
996(* If u is a rational function of x, RationalFunctionExponents[u,x] returns a list of the
997	exponent of the numerator of u and the exponent of the denominator of u. *)
998RationalFunctionExponents[u_,x_Symbol] :=
999  If[PolynomialQ[u,x],
1000    {Exponent[u,x],0},
1001  If[IntegerPowerQ[u],
1002    If[u[[2]]>0,
1003      u[[2]]*RationalFunctionExponents[u[[1]],x],
1004    (-u[[2]])*Reverse[RationalFunctionExponents[u[[1]],x]]],
1005  If[ProductQ[u],
1006    RationalFunctionExponents[First[u],x]+RationalFunctionExponents[Rest[u],x],
1007  If[SumQ[u],
1008    Module[{v=Together[u]},
1009    If[SumQ[v],
1010      Module[{lst1,lst2},
1011      lst1=RationalFunctionExponents[First[u],x];
1012      lst2=RationalFunctionExponents[Rest[u],x];
1013      {Max[lst1[[1]]+lst2[[2]],lst2[[1]]+lst1[[2]]],lst1[[2]]+lst2[[2]]}],
1014    RationalFunctionExponents[v,x]]],
1015  {0,0}]]]]
1016
1017
1018(* If u (x) is an algebraic function of x, AlgebraicFunctionQ[u,x] returns True; else False. *)
1019AlgebraicFunctionQ[u_,x_Symbol] :=
1020  If[AtomQ[u] || FreeQ[u,x],
1021    True,
1022  If[RationalPowerQ[u],
1023    AlgebraicFunctionQ[u[[1]],x],
1024  If[ProductQ[u] || SumQ[u],
1025    Catch[Scan[Function[If[AlgebraicFunctionQ[#,x],Null,Throw[False]]],u];True],
1026  False]]]
1027
1028
1029QuotientOfLinearsQ[u_,x_Symbol,flag_:False] :=
1030  If[ListQ[u],
1031    Catch[Scan[Function[If[QuotientOfLinearsQ[#,x,flag],Null,Throw[False]]],u]; True],
1032  If[flag,
1033    MatchQ[u, (a_.+b_.*x)/(c_.+d_.*x) /; FreeQ[{a,b,c,d},x]],
1034  QuotientOfLinearsP[u,x] && Function[NonzeroQ[#[[2]]] && NonzeroQ[#[[4]]]][QuotientOfLinearsParts[u,x]]]]
1035
1036
1037QuotientOfLinearsP[a_*u_,x_] :=
1038  QuotientOfLinearsP[u,x] /;
1039FreeQ[a,x]
1040
1041QuotientOfLinearsP[a_+u_,x_] :=
1042  QuotientOfLinearsP[u,x] /;
1043FreeQ[a,x]
1044
1045QuotientOfLinearsP[1/u_,x_] :=
1046  QuotientOfLinearsP[u,x]
1047
1048QuotientOfLinearsP[u_,x_] :=
1049  True /;
1050LinearQ[u,x]
1051
1052QuotientOfLinearsP[u_/v_,x_] :=
1053  True /;
1054LinearQ[u,x] && LinearQ[v,x]
1055
1056QuotientOfLinearsP[u_,x_] :=
1057  u===x || FreeQ[u,x]
1058
1059
1060(* If u is equivalent to an expression of the form (a+b*x)/(c+d*x), QuotientOfLinearsParts[u,x]
1061	returns the list {a, b, c, d}. *)
1062QuotientOfLinearsParts[a_*u_,x_] :=
1063  Apply[Function[{a*#1, a*#2, #3, #4}], QuotientOfLinearsParts[u,x]] /;
1064FreeQ[a,x]
1065
1066QuotientOfLinearsParts[a_+u_,x_] :=
1067  Apply[Function[{#1+a*#3, #2+a*#4, #3, #4}], QuotientOfLinearsParts[u,x]] /;
1068FreeQ[a,x]
1069
1070QuotientOfLinearsParts[1/u_,x_] :=
1071  Apply[Function[{#3, #4, #1, #2}], QuotientOfLinearsParts[u,x]]
1072
1073QuotientOfLinearsParts[u_,x_] :=
1074  {Coefficient[u,x,0], Coefficient[u,x,1], 1, 0} /;
1075LinearQ[u,x]
1076
1077QuotientOfLinearsParts[u_/v_,x_] :=
1078  {Coefficient[u,x,0], Coefficient[u,x,1], Coefficient[v,x,0], Coefficient[v,x,1]} /;
1079LinearQ[u,x] && LinearQ[v,x]
1080
1081QuotientOfLinearsParts[u_,x_] :=
1082  If[u===x,
1083    {0, 1, 1, 0},
1084  If[FreeQ[u,x],
1085    {u, 0, 1, 0},
1086  Print["QuotientOfLinearParts error!"];
1087  {u, 0, 1, 0}]]
1088
1089
1090(* u (x) is an improper fraction if it is an expression of the form w (v (x))/t(v (x)) where w (x)
1091	and t (x) are polynomials in x and the degree of w (x) is greater than or equal the degree
1092	of t (x). *)
1093
1094
1095(* If u/v is an improper fraction, ImproperFractionQ[u,v,x] returns True; else it returns False. *)
1096(* ImproperFractionQ[u_,v_,x_Symbol] :=
1097  Module[{lst1=PolynomialFunctionOf[u,x],lst2=PolynomialFunctionOf[v,x]},
1098  lst1[[1]]===lst2[[1]] && Exponent[lst1[[2]],x]>=Exponent[lst2[[2]],x]] *)
1099
1100
1101(* If u/v is an improper rational function where v is of the form fraction a+b*x+c*x^2 or a+b*x^n,
1102	ImproperRationalFunctionQ[u,v,x] returns True; else it returns False. *)
1103ImproperRationalFunctionQ[u_,v_,x_Symbol] :=
1104  PolynomialQ[u,x] &&
1105  PolynomialQ[v,x] &&
1106  Not[MatchQ[u,(a_.+b_.*x)^n_. /; FreeQ[{a,b},x] && IntegerQ[n]] &&
1107	  MatchQ[v,(a_.+b_.*x)^n_. /; FreeQ[{a,b},x] && IntegerQ[n]]] &&
1108  (QuadraticQ[v,x] && Exponent[u,x]>=2 ||
1109	MatchQ[v,a_+b_.*x^n_. /; FreeQ[{a,b},x] && IntegerQ[n] && 0<n<=Exponent[u,x]])
1110
1111
1112(* If u is an improper fraction, ExpandImproperFraction[u,x] returns the list {q,a,r}
1113	where q is the integral part of u and a*r is the proper fractional part of u;
1114	else it returns False. *)
1115ExpandImproperFraction[u_,x_Symbol] :=
1116  Module[{tmp},
1117  If[NotFalseQ[tmp=ExpandImproperFraction[Numerator[u],Denominator[u],x]],
1118    tmp,
1119  If[NotFalseQ[tmp=ExpandImproperFraction[SmartNumerator[u],SmartDenominator[u],x]],
1120    tmp,
1121  If[FunctionOfQ[Sin[x],u,x],
1122    tmp=Regularize[SubstFor[Sin[x],u,x],x];
1123    If[NotFalseQ[tmp=ExpandImproperFraction[Numerator[tmp],Denominator[tmp],x]],
1124      Subst[tmp,x,Sin[x]],
1125    False],
1126  If[FunctionOfQ[Cos[x],u,x],
1127    tmp=Regularize[SubstFor[Cos[x],u,x],x];
1128    If[NotFalseQ[tmp=ExpandImproperFraction[Numerator[tmp],Denominator[tmp],x]],
1129      Subst[tmp,x,Cos[x]],
1130    False],
1131  If[FunctionOfQ[Sinh[x],u,x],
1132    tmp=Regularize[SubstFor[Sinh[x],u,x],x];
1133    If[NotFalseQ[tmp=ExpandImproperFraction[Numerator[tmp],Denominator[tmp],x]],
1134      Subst[tmp,x,Sinh[x]],
1135    False],
1136  If[FunctionOfQ[Cosh[x],u,x],
1137    tmp=Regularize[SubstFor[Cosh[x],u,x],x];
1138    If[NotFalseQ[tmp=ExpandImproperFraction[Numerator[tmp],Denominator[tmp],x]],
1139      Subst[tmp,x,Cosh[x]],
1140    False],
1141  False]]]]]]]
1142
1143ExpandImproperFraction[u_,v_,x_Symbol] :=
1144  Module[{lst1,lst2},
1145  lst1=PolynomialFunctionOf[u,x];
1146  lst2=PolynomialFunctionOf[v,x];
1147  If[lst1[[1]]===lst2[[1]] && Exponent[lst1[[2]],x]>=Exponent[lst2[[2]],x],
1148    ReplaceAll[PolynomialDivide[lst1[[2]],lst2[[2]],x],x->lst1[[1]]],
1149  False]]
1150
1151
1152(* PolynomialDivide[u,v,x] returns the list {q,a,r} where q is the integral part of u/v and
1153	a*r is the proper fractional part of u/v; else it returns False. *)
1154PolynomialDivide[u_,v_,x_Symbol] :=
1155  Prepend[SplitFreeFactors[Regularize[PolynomialRemainder[u,v,x]/v,x],x],
1156		PolynomialQuotient[u,v,x]]
1157
1158
1159SmartNumerator[u_] :=
1160  If[MemberQ[{Cot,Sec,Csc,Coth,Sech,Csch},Head[u]],
1161    1,
1162  If[PowerQ[u] && IntegerQ[u[[2]]] && MemberQ[{Cot,Sec,Csc,Coth,Sech,Csch},Head[u[[1]]]],
1163    1,
1164  If[PowerQ[u] && RationalQ[u[[2]]] && u[[2]]<0,
1165    1,
1166  If[ProductQ[u],
1167    Map[SmartNumerator,u],
1168  u]]]]
1169
1170
1171SmartDenominator[u_] :=
1172  If[MemberQ[{Cot,Sec,Csc,Coth,Sech,Csch},Head[u]],
1173    1/u,
1174  If[PowerQ[u] && IntegerQ[u[[2]]] && MemberQ[{Cot,Sec,Csc,Coth,Sech,Csch},Head[u[[1]]]],
1175    1/u,
1176  If[PowerQ[u] && RationalQ[u[[2]]] && u[[2]]<0,
1177    1/u,
1178  If[ProductQ[u],
1179    Map[SmartDenominator,u],
1180  1]]]]
1181
1182
1183(* PolynomialFunctionOf[u,x] returns the list {v (x),w (x)} where w (v (x)) equals u (x), w (x) is
1184	a polynomial in x, and v (x) is minimal *)
1185PolynomialFunctionOf[u_,x_Symbol] :=
1186  If[AtomQ[u],
1187    If[u===x,
1188      {x,x},
1189    {1,u}],
1190  If[PositiveIntegerPowerQ[u],
1191    Module[{lst=PolynomialFunctionOf[u[[1]],x]},
1192    {lst[[1]],lst[[2]]^u[[2]]}],
1193  If[ProductQ[u],
1194    Module[{lst1=PolynomialFunctionOf[First[u],x],lst2=PolynomialFunctionOf[Rest[u],x]},
1195    If[lst1[[1]]===1,
1196      {lst2[[1]],lst1[[2]]*lst2[[2]]},
1197    If[lst2[[1]]===1,
1198      {lst1[[1]],lst1[[2]]*lst2[[2]]},
1199    If[lst1[[1]]===lst2[[1]],
1200      {lst1[[1]],lst1[[2]]*lst2[[2]]},
1201    {u,x}]]]],
1202  If[SumQ[u],
1203    Module[{lst1=PolynomialFunctionOf[First[u],x],lst2=PolynomialFunctionOf[Rest[u],x]},
1204    If[lst1[[1]]===1,
1205      {lst2[[1]],lst1[[2]]+lst2[[2]]},
1206    If[lst2[[1]]===1,
1207      {lst1[[1]],lst1[[2]]+lst2[[2]]},
1208    If[lst1[[1]]===lst2[[1]],
1209      {lst1[[1]],lst1[[2]]+lst2[[2]]},
1210    {u,x}]]]],
1211  If[FreeQ[u,x],
1212    {1,u},
1213  {u,x}]]]]]
1214
1215
1216Gcd[m_,n_] :=
1217  Module[{denr=LCM[Denominator[m],Denominator[n]]},
1218  Sign[n]*GCD[m*denr,n*denr]/denr] /;
1219RationalQ[m,n]
1220
1221
1222(* If lst is a list of n terms, CommonNumericFactors[lst] returns a n+1-element list whose first
1223	element is the product of the numeric factors common to all terms of lst, and whose remaining
1224	elements are quotients of each term divided by the numeric common factor. *)
1225CommonNumericFactors [lst_] :=
1226  Module[{num=Apply[GCD,Map[NumericFactor,lst]]},
1227  Prepend[Map[Function[#/num],lst],num]]
1228
1229
1230(* NumericFactor[u] returns the product of the factors of u that are rational numbers. *)
1231NumericFactor[u_] :=
1232  If[NumberQ[u],
1233    If[ZeroQ[Im[u]],
1234      u,
1235    If[ZeroQ[Re[u]],
1236      Im[u],
1237    1]],
1238  If[PowerQ[u],
1239    If[RationalQ[u[[1]]] && FractionQ[u[[2]]],
1240      If[u[[2]]>0,
1241        1/Denominator[u[[1]]],
1242      1/Denominator[1/u[[1]]]],
1243    1],
1244  If[ProductQ[u],
1245    Map[NumericFactor,u],
1246  If[SumQ[u],
1247    Function[If[SumQ[#], 1, NumericFactor[#]]][ContentFactor[u]],
1248  1]]]]
1249
1250
1251(* NonnumericFactors[u] returns the product of the factors of u that are not rational numbers. *)
1252NonnumericFactors[u_] :=
1253  If[NumberQ[u],
1254    If[ZeroQ[Im[u]],
1255      1,
1256    If[ZeroQ[Re[u]],
1257      I,
1258    u]],
1259  If[PowerQ[u],
1260    If[RationalQ[u[[1]]] && FractionQ[u[[2]]],
1261      u/NumericFactor[u],
1262    u],
1263  If[ProductQ[u],
1264    Map[NonnumericFactors,u],
1265  If[SumQ[u],
1266    Function[If[SumQ[#], u, NonnumericFactors[#]]][ContentFactor[u]],
1267  u]]]]
1268
1269
1270(* AbsurdNumberQ[u] returns True if u is an absurd number, else it returns False. *)
1271AbsurdNumberQ[u_] :=
1272  RationalQ[u]
1273
1274AbsurdNumberQ[u_^v_] :=
1275  RationalQ[u] && u>0 && FractionQ[v]
1276
1277AbsurdNumberQ[u_*v_] :=
1278  AbsurdNumberQ[u] && AbsurdNumberQ[v]
1279
1280
1281(* AbsurdNumberFactors[u] returns the product of the factors of u that are absurd numbers. *)
1282AbsurdNumberFactors[u_] :=
1283  If[AbsurdNumberQ[u],
1284    u,
1285  If[ProductQ[u],
1286    Map[AbsurdNumberFactors,u],
1287  NumericFactor[u]]]
1288
1289
1290(* NonabsurdNumberFactors[u] returns the product of the factors of u that are not absurd numbers. *)
1291NonabsurdNumberFactors[u_] :=
1292  If[AbsurdNumberQ[u],
1293    1,
1294  If[ProductQ[u],
1295    Map[NonabsurdNumberFactors,u],
1296  NonnumericFactors[u]]]
1297
1298
1299(* m must be an absurd number.  FactorAbsurdNumber[m] returns the prime factorization of m *)
1300(* as list of base-degree pairs where the bases are prime numbers and the degrees are rational. *)
1301FactorAbsurdNumber[m_] :=
1302  If[RationalQ[m],
1303    FactorInteger[m],
1304  If[PowerQ[m],
1305    Map[Function[{#[[1]], #[[2]]*m[[2]]}],FactorInteger[m[[1]]]],
1306  CombineExponents[Sort[Flatten[Map[FactorAbsurdNumber,Apply[List,m]],1], Function[#1[[1]]<#2[[1]]]]]]]
1307
1308
1309CombineExponents[lst_] :=
1310  If[Length[lst]<2,
1311    lst,
1312  If[lst[[1,1]]==lst[[2,1]],
1313    CombineExponents[Prepend[Drop[lst,2],{lst[[1,1]],lst[[1,2]]+lst[[2,2]]}]],
1314  Prepend[CombineExponents[Rest[lst]],First[lst]]]]
1315
1316
1317(* m, n, ... must be absurd numbers.  AbsurdNumberGCD[m,n,...] returns the gcd of m, n, ... *)
1318AbsurdNumberGCD[seq__] :=
1319  Module[{lst={seq}},
1320  If[Length[lst]==1,
1321    First[lst],
1322  AbsurdNumberGCDList[FactorAbsurdNumber[First[lst]],FactorAbsurdNumber[Apply[AbsurdNumberGCD,Rest[lst]]]]]]
1323
1324
1325(* lst1 and lst2 must be absurd number prime factorization lists. *)
1326(* AbsurdNumberGCDList[lst1,lst2] returns the gcd of the absurd numbers represented by lst1 and lst2. *)
1327AbsurdNumberGCDList[lst1_,lst2_] :=
1328  If[lst1==={},
1329    Apply[Times,Map[Function[#[[1]]^Min[#[[2]],0]],lst2]],
1330  If[lst2==={},
1331    Apply[Times,Map[Function[#[[1]]^Min[#[[2]],0]],lst1]],
1332  If[lst1[[1,1]]==lst2[[1,1]],
1333    If[lst1[[1,2]]<=lst2[[1,2]],
1334      lst1[[1,1]]^lst1[[1,2]]*AbsurdNumberGCDList[Rest[lst1],Rest[lst2]],
1335    lst1[[1,1]]^lst2[[1,2]]*AbsurdNumberGCDList[Rest[lst1],Rest[lst2]]],
1336  If[lst1[[1,1]]<lst2[[1,1]],
1337    If[lst1[[1,2]]<0,
1338      lst1[[1,1]]^lst1[[1,2]]*AbsurdNumberGCDList[Rest[lst1],lst2],
1339    AbsurdNumberGCDList[Rest[lst1],lst2]],
1340  If[lst2[[1,2]]<0,
1341    lst2[[1,1]]^lst2[[1,2]]*AbsurdNumberGCDList[lst1,Rest[lst2]],
1342  AbsurdNumberGCDList[lst1,Rest[lst2]]]]]]]
1343
1344
1345DisguisedKnownIntegrandQ[Integrand_,x_Symbol] :=
1346  KnownIntegrandQ[Integrand,x] && Not[KnownIntegrandQ[Integrand,x,True]]
1347
1348
1349KnownIntegrandQ[x_^m_.*u_,x_Symbol,flag_:False] :=
1350  KnownIntegrandQ[u,x,flag] /;
1351FreeQ[m,x]
1352
1353
1354KnownIntegrandQ[u_+v_,x_Symbol,flag_:False] :=
1355  KnownIntegrandQ[u,x,flag] && KnownIntegrandQ[v,x,flag]
1356
1357
1358KnownIntegrandQ[z_,x_Symbol,flag_:False] :=
1359  MatchQ[z, u_^p_. /; FreeQ[p,x] && KnownMultinomialQ[u,x,flag]] ||
1360  MatchQ[z, f_[u_]^p_. /; FreeQ[{f,p},x] && KnownMultinomialQ[u,x,flag]] ||
1361  MatchQ[z, (f_^u_)^p_. /; FreeQ[{f,p},x] && KnownMultinomialQ[u,x,flag]] ||
1362
1363  MatchQ[z, u_^p_.*v_^q_. /; FreeQ[{p,q},x] && QuadraticQ[v,x,flag] && (LinearQ[u,x,flag] || QuadraticQ[u,x,flag])] ||
1364  MatchQ[z, u_^p_.*f_[v_]^q_. /; FreeQ[{f,p,q},x] && QuadraticQ[v,x,flag] && (LinearQ[u,x,flag] || QuadraticQ[u,x,flag])] ||
1365  MatchQ[z, u_^p_.*(f_^v_)^q_. /; FreeQ[{f,p,q},x] && QuadraticQ[v,x,flag] && (LinearQ[u,x,flag] || QuadraticQ[u,x,flag])] ||
1366
1367  MatchQ[z, u_^p_.*v_^q_. /; FreeQ[{p,q},x] && BinomialQ[{u,v},x,flag] && ZeroQ[BinomialDegree[u,x]-BinomialDegree[v,x]]] ||
1368  MatchQ[z, u_^p_.*f_[v_]^q_. /; FreeQ[{f,p,q},x] && BinomialQ[{u,v},x,flag] && ZeroQ[BinomialDegree[u,x]-BinomialDegree[v,x]]] ||
1369  MatchQ[z, u_^p_.*(f_^v_)^q_. /; FreeQ[{f,p,q},x] && BinomialQ[{u,v},x,flag] && ZeroQ[BinomialDegree[u,x]-BinomialDegree[v,x]]] ||
1370
1371  MatchQ[z, u_*v_^p_. /; FreeQ[p,x] && BinomialQ[u,x,flag] && TrinomialQ[v,x,flag] && ZeroQ[BinomialDegree[u,x]-TrinomialDegree[v,x]]] ||
1372  MatchQ[z, u_*v_^p_. /; FreeQ[p,x] && BinomialQ[u,x,flag] && GeneralizedTrinomialQ[v,x,flag] && ZeroQ[BinomialDegree[u,x]-GeneralizedTrinomialDegree[v,x]]] ||
1373
1374  MatchQ[z, u_^p_.*v_^q_.*w_^r_. /; FreeQ[{p,q,r},x] && BinomialQ[{u,v,w},x,flag] && ZeroQ[BinomialDegree[u,x]-BinomialDegree[v,x]] && ZeroQ[BinomialDegree[u,x]-BinomialDegree[w,x]]] ||
1375  MatchQ[z, u_^p_.*v_^q_.*w_^r_. /; FreeQ[{p,q,r},x] && QuadraticQ[u,x,flag] && LinearQ[{v,w},x,flag] && (q===1 || r===1)] ||
1376  MatchQ[z, u_^p_.*v_^q_.*w_^r_. /; FreeQ[{p,q,r},x] && p===1 && LinearQ[u,x,flag] && QuadraticQ[{v,w},x,flag]] ||
1377
1378  MatchQ[z, u_^p_.*v_^q_.*w_^r_.*y_^s_. /; FreeQ[{p,q,r,s},x] && LinearQ[{u,v,w,y},x,flag]] ||
1379
1380  MatchQ[z, Log[u_]/v_ /; QuotientOfLinearsQ[u,x,flag] && (LinearQ[v,x,flag] || QuadraticQ[v,x,flag])] ||
1381  MatchQ[z, Log[c_.*u_^n_.]/v_ /; FreeQ[{c,n},x] && LinearQ[u,x,flag] && (LinearQ[v,x,flag] || QuadraticQ[v,x,flag])] ||
1382
1383  FreeQ[z,x]
1384
1385
1386KnownMultinomialQ[u_,x_Symbol,flag_:False] :=
1387  BinomialQ[u,x,flag] || QuadraticQ[u,x,flag] || TrinomialQ[u,x,flag] ||
1388  GeneralizedBinomialQ[u,x,flag] || GeneralizedTrinomialQ[u,x,flag]
1389
1390
1391StandardizeIntegrand[x_^m_.*u_,x_Symbol] :=
1392  x^m*StandardizeIntegrand[u,x] /;
1393FreeQ[m,x]
1394
1395
1396StandardizeIntegrand[u_+v_,x_Symbol] :=
1397  StandardizeIntegrand[u,x] + StandardizeIntegrand[v,x]
1398
1399
1400StandardizeIntegrand[u_^p_.,x_Symbol] :=
1401  Function[(#[[1]]+#[[2]]*x^#[[3]])^p][BinomialTest[u,x]] /;
1402FreeQ[p,x] && BinomialQ[u,x]
1403
1404StandardizeIntegrand[f_[u_^m_.]^p_.,x_Symbol] :=
1405  Function[f[(#[[1]]+#[[2]]*x^#[[3]])^m]^p][BinomialTest[u,x]] /;
1406FreeQ[{f,m,p},x] && BinomialQ[u,x]
1407
1408StandardizeIntegrand[(f_^(u_^m_.))^p_.,x_Symbol] :=
1409  Function[(f^((#[[1]]+#[[2]]*x^#[[3]])^m))^p][BinomialTest[u,x]] /;
1410FreeQ[{f,m,p},x] && BinomialQ[u,x]
1411
1412
1413StandardizeIntegrand[u_^p_.,x_Symbol] :=
1414  (Coefficient[u,x,0]+Coefficient[u,x,1]*x+Coefficient[u,x,2]*x^2)^p /;
1415FreeQ[p,x] && QuadraticQ[u,x]
1416
1417StandardizeIntegrand[f_[u_]^p_.,x_Symbol] :=
1418  f[Coefficient[u,x,0]+Coefficient[u,x,1]*x+Coefficient[u,x,2]*x^2]^p /;
1419FreeQ[{f,p},x] && QuadraticQ[u,x]
1420
1421StandardizeIntegrand[(f_^u_)^p_.,x_Symbol] :=
1422  (f^(Coefficient[u,x,0]+Coefficient[u,x,1]*x+Coefficient[u,x,2]*x^2))^p /;
1423FreeQ[{f,p},x] && QuadraticQ[u,x]
1424
1425
1426StandardizeIntegrand[u_^p_.,x_Symbol] :=
1427  Function[(#[[1]] + #[[2]]*x^#[[4]] + #[[3]]*x^(2*#[[4]]))^p][TrinomialTest[u,x]] /;
1428FreeQ[p,x] && TrinomialQ[u,x]
1429
1430StandardizeIntegrand[f_[u_]^p_.,x_Symbol] :=
1431  Function[f[#[[1]] + #[[2]]*x^#[[4]] + #[[3]]*x^(2*#[[4]])]^p][TrinomialTest[u,x]] /;
1432FreeQ[{f,p},x] && TrinomialQ[u,x]
1433
1434StandardizeIntegrand[(f_^u_)^p_.,x_Symbol] :=
1435  Function[(f^(#[[1]] + #[[2]]*x^#[[4]] + #[[3]]*x^(2*#[[4]])))^p][TrinomialTest[u,x]] /;
1436FreeQ[{f,p},x] && TrinomialQ[u,x]
1437
1438
1439StandardizeIntegrand[u_^p_.,x_Symbol] :=
1440  Function[(#[[1]]*x^#[[4]]+#[[2]]*x^#[[3]])^p][GeneralizedBinomialTest[u,x]] /;
1441FreeQ[p,x] && GeneralizedBinomialQ[u,x]
1442
1443StandardizeIntegrand[f_[u_]^p_.,x_Symbol] :=
1444  Function[f[#[[1]]*x^#[[4]]+#[[2]]*x^#[[3]]]^p][GeneralizedBinomialTest[u,x]] /;
1445FreeQ[{f,p},x] && GeneralizedBinomialQ[u,x]
1446
1447StandardizeIntegrand[(f_^u_)^p_.,x_Symbol] :=
1448  Function[(f^(#[[1]]*x^#[[4]]+#[[2]]*x^#[[3]]))^p][GeneralizedBinomialTest[u,x]] /;
1449FreeQ[{f,p},x] && GeneralizedBinomialQ[u,x]
1450
1451
1452StandardizeIntegrand[u_^p_.,x_Symbol] :=
1453  Function[(#[[1]]*x^#[[5]] + #[[2]]*x^#[[4]] + #[[3]]*x^(2*#[[4]]-#[[5]]))^p][GeneralizedTrinomialTest[u,x]] /;
1454FreeQ[p,x] && GeneralizedTrinomialQ[u,x]
1455
1456StandardizeIntegrand[f_[u_]^p_.,x_Symbol] :=
1457  Function[f[#[[1]]*x^#[[5]] + #[[2]]*x^#[[4]] + #[[3]]*x^(2*#[[4]]-#[[5]])]^p][GeneralizedTrinomialTest[u,x]] /;
1458FreeQ[{f,p},x] && GeneralizedTrinomialQ[u,x]
1459
1460StandardizeIntegrand[(f_^u_)^p_.,x_Symbol] :=
1461  Function[(f^(#[[1]]*x^#[[5]] + #[[2]]*x^#[[4]] + #[[3]]*x^(2*#[[4]]-#[[5]])))^p][GeneralizedTrinomialTest[u,x]] /;
1462FreeQ[{f,p},x] && GeneralizedTrinomialQ[u,x]
1463
1464
1465StandardizeIntegrand[u_^p_.*v_^q_.,x_Symbol] :=
1466  Function[(#1[[1]]+#1[[2]]*x^#1[[3]])^p*(#2[[1]]+#2[[2]]*x^#1[[3]])^q][BinomialTest[u,x],BinomialTest[v,x]] /;
1467FreeQ[{p,q},x] && BinomialQ[{u,v},x] && ZeroQ[BinomialDegree[u,x]-BinomialDegree[v,x]]
1468
1469StandardizeIntegrand[u_^p_.*f_[v_^m_.]^q_.,x_Symbol] :=
1470  Function[(#1[[1]]+#1[[2]]*x^#1[[3]])^p*f[(#2[[1]]+#2[[2]]*x^#1[[3]])^m]^q][BinomialTest[u,x],BinomialTest[v,x]] /;
1471FreeQ[{f,m,p,q},x] && BinomialQ[{u,v},x] && ZeroQ[BinomialDegree[u,x]-BinomialDegree[v,x]]
1472
1473StandardizeIntegrand[u_^p_.*(f_^(v_^m_.))^q_.,x_Symbol] :=
1474  Function[(#1[[1]]+#1[[2]]*x^#1[[3]])^p*(f^((#2[[1]]+#2[[2]]*x^#1[[3]])^m))^q][BinomialTest[u,x],BinomialTest[v,x]] /;
1475FreeQ[{f,m,p,q},x] && BinomialQ[{u,v},x] && ZeroQ[BinomialDegree[u,x]-BinomialDegree[v,x]]
1476
1477
1478StandardizeIntegrand[v_^m_.*w_^p_.,x_Symbol] :=
1479  (Coefficient[v,x,0]+Coefficient[v,x,1]*x+Coefficient[v,x,2]*x^2)^m*
1480  (Coefficient[w,x,0]+Coefficient[w,x,1]*x+Coefficient[w,x,2]*x^2)^p /;
1481FreeQ[{m,p},x] && QuadraticQ[{v,w},x]
1482
1483StandardizeIntegrand[v_^m_.*f_[w_]^p_.,x_Symbol] :=
1484  (Coefficient[v,x,0]+Coefficient[v,x,1]*x+Coefficient[v,x,2]*x^2)^m*
1485  f[Coefficient[w,x,0]+Coefficient[w,x,1]*x+Coefficient[w,x,2]*x^2]^p /;
1486FreeQ[{f,m,p},x] && QuadraticQ[{v,w},x]
1487
1488StandardizeIntegrand[v_^m_.*(f_^w_)^p_.,x_Symbol] :=
1489  (Coefficient[v,x,0]+Coefficient[v,x,1]*x+Coefficient[v,x,2]*x^2)^m*
1490  (f^(Coefficient[w,x,0]+Coefficient[w,x,1]*x+Coefficient[w,x,2]*x^2))^p /;
1491FreeQ[{f,m,p},x] && QuadraticQ[{v,w},x]
1492
1493
1494StandardizeIntegrand[v_^m_.*u_^p_.,x_Symbol] :=
1495  (Coefficient[v,x,0]+Coefficient[v,x,1]*x)^m*
1496  (Coefficient[u,x,0]+Coefficient[u,x,1]*x+Coefficient[u,x,2]*x^2)^p /;
1497FreeQ[{m,p},x] && LinearQ[v,x] && QuadraticQ[u,x]
1498
1499StandardizeIntegrand[v_^m_.*f_[u_]^p_.,x_Symbol] :=
1500  (Coefficient[v,x,0]+Coefficient[v,x,1]*x)^m*
1501  f[Coefficient[u,x,0]+Coefficient[u,x,1]*x+Coefficient[u,x,2]*x^2]^p /;
1502FreeQ[{f,m,p},x] && LinearQ[v,x] && QuadraticQ[u,x]
1503
1504StandardizeIntegrand[v_^m_.*(f_^u_)^p_.,x_Symbol] :=
1505  (Coefficient[v,x,0]+Coefficient[v,x,1]*x)^m*
1506  (f^(Coefficient[u,x,0]+Coefficient[u,x,1]*x+Coefficient[u,x,2]*x^2))^p /;
1507FreeQ[{f,m,p},x] && LinearQ[v,x] && QuadraticQ[u,x]
1508
1509
1510StandardizeIntegrand[u_*v_^p_.,x_Symbol] :=
1511  Function[(#1[[1]]+#1[[2]]*x^#1[[3]])*(#2[[1]] + #2[[2]]*x^#2[[4]] + #2[[3]]*x^(2*#2[[4]]))^p][BinomialTest[u,x],TrinomialTest[v,x]] /;
1512FreeQ[p,x] && BinomialQ[u,x] && TrinomialQ[v,x] && ZeroQ[BinomialDegree[u,x]-TrinomialDegree[v,x]]
1513
1514
1515StandardizeIntegrand[u_*v_^p_.,x_Symbol] :=
1516  Function[(#1[[1]]+#1[[2]]*x^#1[[3]])*(#2[[1]]^#2[[5]] + #2[[2]]*x^#2[[4]] + #2[[3]]*x^(2*#2[[4]]-#2[[5]]))^p][BinomialTest[u,x],GeneralizedTrinomialTest[v,x]] /;
1517FreeQ[p,x] && BinomialQ[u,x] && GeneralizedTrinomialQ[v,x] && ZeroQ[BinomialDegree[u,x]-GeneralizedTrinomialDegree[v,x]]
1518
1519
1520StandardizeIntegrand[u_^m_.*v_^p_.*w_^q_.,x_Symbol] :=
1521  Function[(#1[[1]]+#1[[2]]*x^#1[[3]])^m*(#2[[1]]+#2[[2]]*x^#1[[3]])^p*(#3[[1]]+#3[[2]]*x^#1[[3]])^q][BinomialTest[u,x],BinomialTest[v,x],BinomialTest[w,x]] /;
1522FreeQ[{m,p,q},x] && BinomialQ[{u,v,w},x] && ZeroQ[BinomialDegree[u,x]-BinomialDegree[v,x]] && ZeroQ[BinomialDegree[u,x]-BinomialDegree[w,x]]
1523
1524
1525StandardizeIntegrand[v_^m_.*w_*u_^p_.,x_Symbol] :=
1526  (Coefficient[v,x,0]+Coefficient[v,x,1]*x)^m*
1527  (Coefficient[w,x,0]+Coefficient[w,x,1]*x)*
1528  (Coefficient[u,x,0]+Coefficient[u,x,1]*x+Coefficient[u,x,2]*x^2)^p /;
1529FreeQ[{m,p},x] && LinearQ[{v,w},x] && QuadraticQ[u,x] (* && Not[MatchQ[u,r_^2] && ZeroQ[p-1]] *)
1530
1531StandardizeIntegrand[u_*v_^m_.*w_^p_.,x_Symbol] :=
1532  (Coefficient[u,x,0]+Coefficient[u,x,1]*x)*
1533  (Coefficient[v,x,0]+Coefficient[v,x,1]*x+Coefficient[v,x,2]*x^2)^m*
1534  (Coefficient[w,x,0]+Coefficient[w,x,1]*x+Coefficient[w,x,2]*x^2)^p /;
1535FreeQ[{m,p},x] && LinearQ[u,x] && QuadraticQ[{v,w},x]
1536
1537
1538StandardizeIntegrand[u_^m_.*v_^p_.*w_^q_.*z_^r_.,x_Symbol] :=
1539  (Coefficient[u,x,0]+Coefficient[u,x,1]*x)^m*
1540  (Coefficient[v,x,0]+Coefficient[v,x,1]*x)^p*
1541  (Coefficient[w,x,0]+Coefficient[w,x,1]*x)^q*
1542  (Coefficient[z,x,0]+Coefficient[z,x,1]*x)^r /;
1543FreeQ[{m,p,q,r},x] && LinearQ[{u,v,w,z},x]
1544
1545
1546StandardizeIntegrand[Log[c_.*u_^n_.]/v_,x_Symbol] :=
1547  Log[c*(Coefficient[u,x,0]+Coefficient[u,x,1]*x)^n]/(Coefficient[v,x,0]+Coefficient[v,x,1]*x) /;
1548FreeQ[{c,n},x] && LinearQ[u,x] && LinearQ[v,x]
1549
1550StandardizeIntegrand[Log[c_.*u_^n_.]/v_,x_Symbol] :=
1551  Log[c*(Coefficient[u,x,0]+Coefficient[u,x,1]*x)^n]/(Coefficient[v,x,0]+Coefficient[v,x,1]*x+Coefficient[v,x,2]*x^2) /;
1552FreeQ[{c,n},x] && LinearQ[u,x] && QuadraticQ[v,x]
1553
1554
1555StandardizeIntegrand[Log[u_]/v_,x_Symbol] :=
1556  Log[Function[(#[[1]]+#[[2]]*x)/(#[[3]]+#[[4]]*x)][QuotientOfLinearsParts[u,x]]]/
1557	(Coefficient[v,x,0]+Coefficient[v,x,1]*x) /;
1558QuotientOfLinearsQ[u,x] && LinearQ[v,x]
1559
1560StandardizeIntegrand[Log[u_]/v_,x_Symbol] :=
1561  Log[Function[(#[[1]]+#[[2]]*x)/(#[[3]]+#[[4]]*x)][QuotientOfLinearsParts[u,x]]]/
1562	(Coefficient[v,x,0]+Coefficient[v,x,1]*x+Coefficient[v,x,2]*x^2) /;
1563QuotientOfLinearsQ[u,x] && QuadraticQ[v,x]
1564
1565
1566StandardizeIntegrand[u_,x_Symbol] :=
1567  u /;
1568FreeQ[u,x]
1569
1570
1571(* SimplifyIntegrand[u,x] simplifies u and returns the result in a standard form recognizable by integration rules. *)
1572SimplifyIntegrand[u_,x_Symbol] :=
1573  If[KnownIntegrandQ[u,x],
1574    StandardizeIntegrand[u,x],
1575  Module[{v},
1576  v=NormalizeLeadTermSigns[NormalizeIntegrandAux[Simplify[u],x]];
1577  If[v===NormalizeLeadTermSigns[u],
1578    u,
1579  v]]]
1580
1581(* SimplifyIntegrand[u_,x_Symbol] :=
1582  Module[{v=Together[u],lst},
1583  lst=SplitFreeFactors[v,x];
1584  If[KnownIntegrandQ[lst[[2]],x],
1585    Simplify[lst[[1]]]*StandardizeIntegrand[lst[[2]],x],
1586  If[KnownIntegrandQ[u,x],
1587    StandardizeIntegrand[u,x],
1588  v=NormalizeLeadTermSigns[NormalizeIntegrandAux[Simplify[v],x]];
1589  If[v===NormalizeLeadTermSigns[u],
1590    u,
1591  v]]]] *)
1592
1593
1594(* NormalForm[u_,x_Symbol] :=
1595  u *)
1596
1597
1598(* NormalizeIntegrand[u,x] returns u in a standard form recognizable by integration rules. *)
1599NormalizeIntegrand[u_,x_Symbol] :=
1600  Module[{v=NormalizeLeadTermSigns[NormalizeIntegrandAux[u,x]]},
1601  If[v===NormalizeLeadTermSigns[u],
1602    u,
1603  v]]
1604
1605
1606NormalizeIntegrandAux[u_,x_Symbol] :=
1607  If[SumQ[u],
1608    Map[Function[NormalizeIntegrandAux[#,x]],u],
1609  If[ProductQ[u],
1610    Map[Function[NormalizeIntegrandFactor[#,x]],u],
1611  NormalizeIntegrandFactor[u,x]]]
1612
1613
1614NormalizeIntegrandFactor[u_,x_Symbol] :=
1615  Module[{bas,deg,min},
1616  If[PowerQ[u] && FreeQ[u[[2]],x],
1617    bas=NormalizeIntegrandFactorBase[u[[1]],x];
1618    deg=u[[2]];
1619    If[IntegerQ[deg] && SumQ[bas],
1620      If[MapAnd[Function[MonomialQ[#,x]],bas],
1621        min=MinimumMonomialExponent[bas,x];
1622        x^(min*deg)*Map[Function[Simplify[#/x^min]],bas]^deg,
1623      bas^deg],
1624    bas^deg],
1625  bas=NormalizeIntegrandFactorBase[u,x];
1626  If[SumQ[bas],
1627    If[MapAnd[Function[MonomialQ[#,x]],bas],
1628      min=MinimumMonomialExponent[bas,x];
1629      x^min*Map[Function[#/x^min],bas],
1630    bas],
1631  bas]]]
1632
1633
1634NormalizeIntegrandFactorBase[x_^m_.*u_,x_Symbol] :=
1635  NormalizeIntegrandFactorBase[Map[Function[x^m*#],u],x] /;
1636FreeQ[m,x] && SumQ[u]
1637
1638
1639NormalizeIntegrandFactorBase[u_,x_Symbol] :=
1640  If[BinomialQ[u,x],
1641    If[BinomialQ[u,x,True],
1642      u,
1643    Function[#[[1]]+#[[2]]*x^#[[3]]][BinomialTest[u,x]]],
1644  If[TrinomialQ[u,x],
1645    If[TrinomialQ[u,x,True],
1646      u,
1647    Function[#[[1]]+#[[2]]*x^#[[4]]+#[[3]]*x^(2*#[[4]])][TrinomialTest[u,x]]],
1648  If[ProductQ[u],
1649    Map[Function[NormalizeIntegrandFactor[#,x]],u],
1650  If[PolynomialQ[u,x] && Exponent[u,x]<=4,
1651    Module[{lst=CoefficientList[u,x]},
1652    Sum[lst[[i]]*x^(i-1),{i,1,Length[lst]}]],
1653  If[SumQ[u],
1654    Module[{v=Together[Simplify[Together[u]]]},
1655    If[SumQ[v] || MatchQ[v, x^m_.*w_ /; FreeQ[m,x] && SumQ[w]] || LeafCount[v]>LeafCount[u]+2,
1656      u,
1657    NormalizeIntegrandFactorBase[v,x]]],
1658  Map[Function[NormalizeIntegrandFactor[#,x]],u]]]]]]
1659
1660
1661(* NormalizeLeadTermSigns[u] returns an expression equal u but with not more than one sum
1662	factor raised to a integer degree having a lead term with a negative coefficient. *)
1663NormalizeLeadTermSigns[u_] :=
1664  Module[{lst=If[ProductQ[u], Map[SignOfFactor,u], SignOfFactor[u]]},
1665  If[lst[[1]]==1,
1666    lst[[2]],
1667  AbsorbMinusSign[lst[[2]]]]]
1668
1669
1670(* AbsorbMinusSign[u] returns an expression equal to -u.  If there is a factor of u of the
1671	form v^m where v is a sum and m is an odd power, the minus sign is distributed over v;
1672	otherwise -u is returned. *)
1673AbsorbMinusSign[u_.*v_Plus] :=
1674  u*(-v)
1675
1676AbsorbMinusSign[u_.*v_Plus^m_] :=
1677  u*(-v)^m /;
1678OddQ[m]
1679
1680AbsorbMinusSign[u_] :=
1681  -u
1682
1683
1684(* NormalizeSumFactors[u] returns an expression equal u but with the numeric coefficient of
1685	the lead term of sum factors made positive where possible. *)
1686NormalizeSumFactors[u_] :=
1687  If[AtomQ[u] || Head[u]===If || Head[u]===Int || HeldFormQ[u],
1688    u,
1689  If[ProductQ[u],
1690    Function[#[[1]]*#[[2]]][SignOfFactor[Map[NormalizeSumFactors,u]]],
1691  Map[NormalizeSumFactors,u]]]
1692
1693
1694(* SignOfFactor[u] returns the list {n,v} where n*v equals u, n^2 equals 1, and the lead
1695	term of the sum factors of v raised to integer degrees all have positive coefficients. *)
1696SignOfFactor[u_] :=
1697  If[RationalQ[u] && u<0 || SumQ[u] && NumericFactor[First[u]]<0,
1698    {-1, -u},
1699  If[IntegerPowerQ[u] && SumQ[u[[1]]] && NumericFactor[First[u[[1]]]]<0,
1700    {(-1)^u[[2]], (-u[[1]])^u[[2]]},
1701  If[ProductQ[u],
1702    Map[SignOfFactor,u],
1703  {1, u}]]]
1704
1705
1706Simp[u_,x_] :=
1707  TimeConstrained[NormalizeSumFactors[SimpHelp[u,x]],TimeLimit,u]
1708
1709SimpHelp[E^(u_.*(v_.*Log[a_]+w_)),x_] :=
1710  a^(u*v)*SimpHelp[E^(u*w),x]
1711
1712SimpHelp[u_,x_] :=
1713  If[AtomQ[u],
1714    u,
1715  If[Head[u]===If || Head[u]===Int || HeldFormQ[u],
1716    u,
1717  If[FreeQ[u,x],
1718    Module[{v=SmartSimplify[u]},
1719    If[LeafCount[v]<=LeafCount[u],
1720      v,
1721    u]],
1722  If[ProductQ[u],
1723    Module[{v=1,w=1},
1724    Scan[Function[If[FreeQ[#,x],v=#*v,w=#*w]],u];
1725    v=NumericFactor[v]*SmartSimplify[NonnumericFactors[v]*x^2]/x^2;
1726    w=If[ProductQ[w], Map[Function[SimpHelp[#,x]],w], SimpHelp[w,x]];
1727    w=FactorNumericGcd[w];
1728    v=MergeFactors[v,w];
1729    If[ProductQ[v],
1730      Map[Function[SimpFixFactor[#,x]],v],
1731    v]],
1732  If[SumQ[u],
1733    If[PolynomialQ[u,x] && Exponent[u,x]<=0,
1734      SimpHelp[Coefficient[u,x,0],x],
1735    If[PolynomialQ[u,x] && Exponent[u,x]==1 && Coefficient[u,x,0]===0,
1736      SimpHelp[Coefficient[u,x,1],x]*x,
1737    Module[{v=0,w=0},
1738    Scan[Function[If[FreeQ[#,x],v=#+v,w=#+w]],u];
1739    v=SmartSimplify[v];
1740    w=If[SumQ[w], Map[Function[SimpHelp[#,x]],w], SimpHelp[w,x]];
1741    v+w]]],
1742  Map[Function[SimpHelp[#,x]],u]]]]]]
1743
1744
1745factorTime=0;
1746
1747SmartSimplify[u_] :=
1748  TimeConstrained[
1749    Module[{v,w},
1750    v=Simplify[u];
1751    w=Factor[v];
1752    v=If[LeafCount[w]<LeafCount[v],w,v];
1753    v=If[NotFalseQ[w=FractionalPowerOfSquareQ[v]] && FractionalPowerSubexpressionQ[u,w,Expand[w]],SubstForExpn[v,w,Expand[w]],v];
1754    FixSimplify[FactorNumericGcd[v]]],
1755  TimeLimit,u]
1756
1757
1758(* If a subexpression of u is of the form ((v+w)^2)^n where n is a fraction, *)
1759(* FractionalPowerOfSquareQ[u] returns (v+w)^2; else it returns False. *)
1760FractionalPowerOfSquareQ[u_] :=
1761  If[AtomQ[u],
1762    False,
1763  If[FractionalPowerQ[u] && MatchQ[u[[1]], a_.*(b_+c_)^2 /; NonsumQ[a]],
1764    u[[1]],
1765  Module[{tmp},
1766  Catch[
1767    Scan[Function[If[NotFalseQ[tmp=FractionalPowerOfSquareQ[#]],Throw[tmp]]],u];
1768    False]]]]
1769
1770
1771(* If a subexpression of u is of the form w^n where n is a fraction but not equal to v, *)
1772(* FractionalPowerSubexpressionQ[u,v,w] returns True; else it returns False. *)
1773FractionalPowerSubexpressionQ[u_,v_,w_] :=
1774  If[AtomQ[u],
1775    False,
1776  If[FractionalPowerQ[u] && PositiveQ[u[[1]]/w],
1777    Not[u[[1]]===v] && LeafCount[w]<3*LeafCount[v],
1778  Catch[Scan[Function[If[FractionalPowerSubexpressionQ[#,v,w],Throw[True]]],u]; False]]]
1779
1780
1781FixSimplify[w_.*(a_^m_*u_.+b_^n_.*v_.)] :=
1782  FixSimplify[a^m*w*(u+(-1)^n*a^(n-m)*v)] /;
1783a+b===0 && FractionQ[m] && IntegerQ[n] && 0<m<n
1784
1785
1786FixSimplify[w_.*(a_^m_.*u_.+a_^n_.*v_.)^t_.] :=
1787  FixSimplify[a^(m*t)*w*(u+a^(n-m)*v)^t] /;
1788Not[RationalQ[a]] && IntegerQ[t] && RationalQ[m,n] && 0<m<=n
1789
1790FixSimplify[w_.*(a_^m_.*u_.+a_^n_.*v_.+a_^p_.*z_.)^t_.] :=
1791  FixSimplify[a^(m*t)*w*(u+a^(n-m)*v+a^(p-m)*z)^t] /;
1792Not[RationalQ[a]] && IntegerQ[t] && RationalQ[m,n,p] && 0<m<=n<=p
1793
1794FixSimplify[w_.*(a_^m_.*u_.+a_^n_.*v_.+a_^p_.*z_.+a_^q_.*y_.)^t_.] :=
1795  FixSimplify[a^(m*t)*w*(u+a^(n-m)*v+a^(p-m)*z+a^(q-m)*y)^t] /;
1796Not[RationalQ[a]] && IntegerQ[t] && RationalQ[m,n,p] && 0<m<=n<=p<=q
1797
1798
1799FixSimplify[w_.*(u_.+a_.*Sqrt[v_Plus]+b_.*Sqrt[v_]+c_.*Sqrt[v_]+d_.*Sqrt[v_])] :=
1800  FixSimplify[w*(u+FixSimplify[a+b+c+d]*Sqrt[v])]
1801
1802FixSimplify[w_.*(u_.+a_.*Sqrt[v_Plus]+b_.*Sqrt[v_]+c_.*Sqrt[v_])] :=
1803  FixSimplify[w*(u+FixSimplify[a+b+c]*Sqrt[v])]
1804
1805FixSimplify[w_.*(u_.+a_.*Sqrt[v_Plus]+b_.*Sqrt[v_])] :=
1806  FixSimplify[w*(u+FixSimplify[a+b]*Sqrt[v])]
1807
1808
1809FixSimplify[u_.*a_^m_*Sqrt[b_.*(c_+d_.*Sqrt[a_])]] :=
1810  Sqrt[Together[b*(c*a^(2*m)+d*a^(2*m+1/2))]]*FixSimplify[u] /;
1811RationalQ[a,b,c,d,m] && a>0 && Denominator[m]==4
1812
1813FixSimplify[u_.*a_^m_/Sqrt[b_.*(c_+d_.*Sqrt[a_])]] :=
1814  FixSimplify[u]/Sqrt[Together[b*(c/a^(2*m)+d/a^(2*m-1/2))]] /;
1815RationalQ[a,b,c,d,m] && a>0 && Denominator[m]==4
1816
1817
1818FixSimplify[u_.*v_^m_*w_^n_] :=
1819  -FixSimplify[u*v^(m-1)] /;
1820RationalQ[m] && Not[RationalQ[w]] && FractionQ[n] && n<0 && ZeroQ[v+w^(-n)]
1821
1822
1823FixSimplify[u_.*v_^m_*w_^n_.] :=
1824  (-1)^(n)*FixSimplify[u*v^(m+n)] /;
1825RationalQ[m] && Not[RationalQ[w]] && IntegerQ[n] && ZeroQ[v+w]
1826
1827
1828FixSimplify[u_.*(-v_^p_.)^m_*w_^n_.] :=
1829  (-1)^(n/p)*FixSimplify[u*(-v^p)^(m+n/p)] /;
1830RationalQ[m] && Not[RationalQ[w]] && IntegerQ[n/p] && ZeroQ[v-w]
1831
1832
1833FixSimplify[u_.*(-v_^p_.)^m_*w_^n_.] :=
1834  (-1)^(n+n/p)*FixSimplify[u*(-v^p)^(m+n/p)] /;
1835RationalQ[m] && Not[RationalQ[w]] && IntegersQ[n,n/p] && ZeroQ[v+w]
1836
1837
1838FixSimplify[u_.*(a-b)^m_.*(a+b)^m_.] :=
1839  u*(a^2-b^2)^m /;
1840IntegerQ[m]
1841
1842FixSimplify[u_.*(c*d^2-e*(b*d-a*e))^m_.] :=
1843  u*(c*d^2-b*d*e+a*e^2)^m /;
1844RationalQ[m]
1845
1846FixSimplify[u_.*(c*d^2+e*(-b*d+a*e))^m_.] :=
1847  u*(c*d^2-b*d*e+a*e^2)^m /;
1848RationalQ[m]
1849
1850FixSimplify[u_] := u
1851
1852
1853SimpFixFactor[(a_.*c_^r_ + b_.*x_^n_.)^p_.,x_] :=
1854  c^(r*p)*SimpFixFactor[(a+b/c^r*x^n)^p,x] /;
1855FreeQ[{a,b,c},x] && IntegersQ[n,p] && AtomQ[c] && RationalQ[r] && r<0
1856
1857SimpFixFactor[(a_. + b_.*c_^r_*x_^n_.)^p_.,x_] :=
1858  c^(r*p)*SimpFixFactor[(a/c^r+b*x^n)^p,x] /;
1859FreeQ[{a,b,c},x] && IntegersQ[n,p] && AtomQ[c] && RationalQ[r] && r<0
1860
1861SimpFixFactor[(a_.*c_^s_. + b_.*c_^r_.*x_^n_.)^p_.,x_] :=
1862  c^(s*p)*SimpFixFactor[(a+b*c^(r-s)*x^n)^p,x] /;
1863FreeQ[{a,b,c},x] && IntegersQ[n,p] && RationalQ[s,r] && 0<s<=r && c^(s*p)=!=-1
1864
1865SimpFixFactor[(a_.*c_^s_. + b_.*c_^r_.*x_^n_.)^p_.,x_] :=
1866  c^(r*p)*SimpFixFactor[(a*c^(s-r)+b*x^n)^p,x] /;
1867FreeQ[{a,b,c},x] && IntegersQ[n,p] && RationalQ[s,r] && 0<r<s && c^(r*p)=!=-1
1868
1869SimpFixFactor[u_,x_] := u
1870
1871
1872(* FactorNumericGcd[u] returns u with the gcd of the numeric coefficients of terms of sums factored out. *)
1873FactorNumericGcd[u_] :=
1874  If[PowerQ[u] && RationalQ[u[[2]]],
1875    FactorNumericGcd[u[[1]]]^u[[2]],
1876  If[ProductQ[u],
1877    Map[FactorNumericGcd,u],
1878  If[SumQ[u],
1879    Module[{g=Apply[GCD,Map[NumericFactor,Apply[List,u]]]},
1880    g*Map[Function[#/g],u]],
1881  u]]]
1882
1883
1884(* MergeFactors[u,v] returns the product of u and v, but with the mergeable factors of u merged into v. *)
1885MergeFactors[u_,v_] :=
1886  If[ProductQ[u],
1887    MergeFactors[Rest[u],MergeFactors[First[u],v]],
1888  If[PowerQ[u],
1889    If[MergeableFactorQ[u[[1]],u[[2]],v],
1890      MergeFactor[u[[1]],u[[2]],v],
1891    If[RationalQ[u[[2]]] && u[[2]]<-1 && MergeableFactorQ[u[[1]],-1,v],
1892      MergeFactors[u[[1]]^(u[[2]]+1),MergeFactor[u[[1]],-1,v]],
1893    u*v]],
1894  If[MergeableFactorQ[u,1,v],
1895    MergeFactor[u,1,v],
1896  u*v]]]
1897
1898
1899(* If MergeableFactorQ[bas,deg,v], MergeFactor[bas,deg,v] return the product of bas^deg and v,
1900	but with bas^deg merged into the factor of v whose base equals bas. *)
1901MergeFactor[bas_,deg_,v_] :=
1902  If[bas===v,
1903    bas^(deg+1),
1904  If[PowerQ[v],
1905    If[bas===v[[1]],
1906      bas^(deg+v[[2]]),
1907    MergeFactor[bas,deg/v[[2]],v[[1]]]^v[[2]]],
1908  If[ProductQ[v],
1909    If[MergeableFactorQ[bas,deg,First[v]],
1910      MergeFactor[bas,deg,First[v]]*Rest[v],
1911    First[v]*MergeFactor[bas,deg,Rest[v]]],
1912  MergeFactor[bas,deg,First[v]] + MergeFactor[bas,deg,Rest[v]]]]]
1913
1914
1915(* MergeableFactorQ[bas,deg,v] returns True iff bas equals the base of a factor of v or bas is a factor of every term of v. *)
1916MergeableFactorQ[bas_,deg_,v_] :=
1917  If[bas===v,
1918    RationalQ[deg+1] && (deg+1>=0 || RationalQ[deg] && deg>0),
1919  If[PowerQ[v],
1920    If[bas===v[[1]],
1921      RationalQ[deg+v[[2]]] && (deg+v[[2]]>=0 || RationalQ[deg] && deg>0),
1922    SumQ[v[[1]]] && IntegerQ[v[[2]]] && (Not[IntegerQ[deg]] || IntegerQ[deg/v[[2]]]) && MergeableFactorQ[bas,deg/v[[2]],v[[1]]]],
1923  If[ProductQ[v],
1924    MergeableFactorQ[bas,deg,First[v]] || MergeableFactorQ[bas,deg,Rest[v]],
1925  SumQ[v] && MergeableFactorQ[bas,deg,First[v]] && MergeableFactorQ[bas,deg,Rest[v]]]]]
1926
1927
1928(* RemoveContent[expn,x] returns expn with the factored content free of x removed. *)
1929RemoveContent[expn_,x_Symbol] :=
1930  Module[{u=SplitFreeFactors[ContentFactor[expn],x][[2]]},
1931  If[SumQ[u] && NegQ[u[[1]]],
1932    -u,
1933  u]]
1934
1935
1936(* ContentFactor[expn] returns expn with the content of sum factors factored out. *)
1937(* Basis: a*b+a*c == a*(b+c) *)
1938ContentFactor[expn_] :=
1939  TimeConstrained[ContentFactorAux[expn],TimeLimit,expn];
1940
1941ContentFactorAux[expn_] :=
1942  If[AtomQ[expn],
1943    expn,
1944  If[IntegerPowerQ[expn],
1945    If[SumQ[expn[[1]]] && NumericFactor[expn[[1,1]]]<0,
1946      (-1)^expn[[2]] * ContentFactorAux[-expn[[1]]]^expn[[2]],
1947    ContentFactorAux[expn[[1]]]^expn[[2]]],
1948  If[ProductQ[expn],
1949    Module[{num=1,tmp},
1950    tmp=Map[Function[If[SumQ[#] && NumericFactor[#[[1]]]<0, num=-num; ContentFactorAux[-#], ContentFactorAux[#]]], expn];
1951    num*UnifyNegativeBaseFactors[tmp]],
1952  If[SumQ[expn],
1953    Module[{lst=CommonFactors[Apply[List,expn]]},
1954    If[lst[[1]]===1 || lst[[1]]===-1,
1955      expn,
1956    lst[[1]]*Apply[Plus,Rest[lst]]]],
1957  expn]]]]
1958
1959
1960(* UnifyNegativeBaseFactors[u] returns u with factors of the form (-v)^m and v^n where n is an integer replaced with (-1)^n*(-v)^(m+n). *)
1961(* This should be done automatically by the host CAS! *)
1962UnifyNegativeBaseFactors[u_.*(-v_)^m_*v_^n_.] :=
1963  UnifyNegativeBaseFactors[(-1)^n*u*(-v)^(m+n)] /;
1964IntegerQ[n]
1965
1966UnifyNegativeBaseFactors[u_] :=
1967  u
1968
1969
1970(* If lst is a list of n terms, CommonFactors[lst] returns a n+1-element list whose first
1971	element is the product of the factors common to all terms of lst, and whose remaining
1972	elements are quotients of each term divided by the common factor. *)
1973CommonFactors [lst_] :=
1974  Module[{lst1,lst2,lst3,lst4,common,base,num},
1975  lst1=Map[NonabsurdNumberFactors,lst];
1976  lst2=Map[AbsurdNumberFactors,lst];
1977  num=Apply[AbsurdNumberGCD,lst2];
1978  common=num;
1979  lst2=Map[Function[#/num],lst2];
1980  While[True,
1981    lst3=Map[LeadFactor,lst1];
1982    ( If[Apply[SameQ,lst3],
1983        common=common*lst3[[1]];
1984        lst1=Map[RemainingFactors,lst1],
1985      If[MapAnd[Function[LogQ[#] && IntegerQ[First[#]] && First[#]>0],lst3] &&
1986           MapAnd[RationalQ,lst4=Map[Function[FullSimplify[#/First[lst3]]],lst3]],
1987        num=Apply[GCD,lst4];
1988        common=common*Log[(First[lst3][[1]])^num];
1989        lst2=Map2[Function[#1*#2/num],lst2,lst4];
1990        lst1=Map[RemainingFactors,lst1],
1991      lst4=Map[LeadDegree,lst1];
1992      If[Apply[SameQ,Map[LeadBase,lst1]] && MapAnd[RationalQ,lst4],
1993        num=Smallest[lst4];
1994        base=LeadBase[lst1[[1]]];
1995        ( If[num!=0,
1996            common=common*base^num] );
1997        lst2=Map2[Function[#1*base^(#2-num)],lst2,lst4];
1998        lst1=Map[RemainingFactors,lst1],
1999      If[Length[lst1]==2 && ZeroQ[LeadBase[lst1[[1]]]+LeadBase[lst1[[2]]]] &&
2000         NonzeroQ[lst1[[1]]-1] && IntegerQ[lst4[[1]]] && FractionQ[lst4[[2]]],
2001        num=Min[lst4];
2002        base=LeadBase[lst1[[2]]];
2003        ( If[num!=0,
2004            common=common*base^num] );
2005        lst2={lst2[[1]]*(-1)^lst4[[1]],lst2[[2]]};
2006        lst2=Map2[Function[#1*base^(#2-num)],lst2,lst4];
2007        lst1=Map[RemainingFactors,lst1],
2008      If[Length[lst1]==2 && ZeroQ[LeadBase[lst1[[1]]]+LeadBase[lst1[[2]]]] &&
2009         NonzeroQ[lst1[[2]]-1] && IntegerQ[lst4[[2]]] && FractionQ[lst4[[1]]],
2010        num=Min[lst4];
2011        base=LeadBase[lst1[[1]]];
2012        ( If[num!=0,
2013            common=common*base^num] );
2014        lst2={lst2[[1]],lst2[[2]]*(-1)^lst4[[2]]};
2015        lst2=Map2[Function[#1*base^(#2-num)],lst2,lst4];
2016        lst1=Map[RemainingFactors,lst1],
2017      num=MostMainFactorPosition[lst3];
2018      lst2=ReplacePart[lst2,lst3[[num]]*lst2[[num]],num];
2019      lst1=ReplacePart[lst1,RemainingFactors[lst1[[num]]],num]]]]]] );
2020    If[MapAnd[Function[#===1],lst1],
2021      Return[Prepend[lst2,common]]]]]
2022
2023
2024MostMainFactorPosition[lst_List] :=
2025  Module[{factor=1,num=1},
2026  Do[If[FactorOrder[lst[[i]],factor]>0,factor=lst[[i]];num=i],{i,Length[lst]}];
2027  num]
2028
2029
2030FactorOrder[u_,v_] :=
2031  If[u===1,
2032    If[v===1,
2033      0,
2034    -1],
2035  If[v===1,
2036    1,
2037  Order[u,v]]]
2038
2039
2040Smallest[num1_,num2_] :=
2041  If[num1>0,
2042    If[num2>0,
2043      Min[num1,num2],
2044    0],
2045  If[num2>0,
2046    0,
2047  Max[num1,num2]]]
2048
2049Smallest[lst_List] :=
2050  Module[{num=lst[[1]]},
2051  Scan[Function[num=Smallest[num,#]],Rest[lst]];
2052  num]
2053
2054
2055(* MonomialFactor[u,x] returns the list {n,v} where x^n*v==u and n is free of x. *)
2056MonomialFactor[u_,x_Symbol] :=
2057  If[AtomQ[u],
2058    If[u===x,
2059      {1,1},
2060    {0,u}],
2061  If[PowerQ[u],
2062    If[IntegerQ[u[[2]]],
2063      Module[{lst=MonomialFactor[u[[1]],x]},
2064      {lst[[1]]*u[[2]],lst[[2]]^u[[2]]}],
2065    If[u[[1]]===x && FreeQ[u[[2]],x],
2066      {u[[2]],1},
2067    {0,u}]],
2068  If[ProductQ[u],
2069    Module[{lst1=MonomialFactor[First[u],x],lst2=MonomialFactor[Rest[u],x]},
2070    {lst1[[1]]+lst2[[1]],lst1[[2]]*lst2[[2]]}],
2071  If[SumQ[u],
2072    Module[{lst,deg},
2073    lst=Map[Function[MonomialFactor[#,x]],Apply[List,u]];
2074    deg=lst[[1,1]];
2075    Scan[Function[deg=MinimumDegree[deg,#[[1]]]],Rest[lst]];
2076    If[ZeroQ[deg] || RationalQ[deg] && deg<0,
2077      {0,u},
2078    {deg,Apply[Plus,Map[Function[x^(#[[1]]-deg)*#[[2]]],lst]]}]],
2079  {0,u}]]]]
2080
2081
2082MinimumDegree[deg1_,deg2_] :=
2083  If[RationalQ[deg1],
2084    If[RationalQ[deg2],
2085      Min[deg1,deg2],
2086    deg1],
2087  If[RationalQ[deg2],
2088    deg2,
2089  Module[{deg=Simplify[deg1-deg2]},
2090  If[RationalQ[deg],
2091    If[deg>0,
2092      deg2,
2093    deg1],
2094  If[OrderedQ[{deg1,deg2}],
2095    deg1,
2096  deg2]]]]]
2097
2098
2099(* ConstantFactor[u,x] returns a 2-element list of the factors of u[x] free of x and the
2100	factors not free of u[x].  Common constant factors of the terms of sums are also collected. *)
2101(* Compare with the more passive function SplitFreeFactors. *)
2102ConstantFactor[u_,x_Symbol] :=
2103  If[FreeQ[u,x],
2104    {u,1},
2105  If[AtomQ[u],
2106    {1,u},
2107  If[PowerQ[u] && FreeQ[u[[2]],x],
2108    Module[{lst=ConstantFactor[u[[1]],x],tmp},
2109    If[IntegerQ[u[[2]]],
2110      {lst[[1]]^u[[2]],lst[[2]]^u[[2]]},
2111    tmp=PositiveFactors[lst[[1]]];
2112    If[tmp===1,
2113      {1,u},
2114    {tmp^u[[2]],(NonpositiveFactors[lst[[1]]]*lst[[2]])^u[[2]]}]]],
2115  If[ProductQ[u],
2116    Module[{lst=Map[Function[ConstantFactor[#,x]],Apply[List,u]]},
2117    {Apply[Times,Map[First,lst]],Apply[Times,Map[Function[#[[2]]],lst]]}],
2118  If[SumQ[u],
2119    Module[{lst1=Map[Function[ConstantFactor[#,x]],Apply[List,u]]},
2120    If[Apply[SameQ,Map[Function[#[[2]]],lst1]],
2121      {Apply[Plus,Map[First,lst1]],lst1[[1,2]]},
2122    Module[{lst2=CommonFactors[Map[First,lst1]]},
2123    {First[lst2],Apply[Plus,Map2[Times,Rest[lst2],Map[Function[#[[2]]],lst1]]]}]]],
2124  {1,u}]]]]]
2125
2126
2127(* PositiveFactors[u] returns the positive factors of u *)
2128PositiveFactors[u_] :=
2129  If[ZeroQ[u],
2130    1,
2131  If[RationalQ[u],
2132    Abs[u],
2133  If[PositiveQ[u],
2134    u,
2135  If[ProductQ[u],
2136    Map[PositiveFactors,u],
2137  1]]]]
2138
2139
2140(* NonpositiveFactors[u] returns the nonpositive factors of u *)
2141NonpositiveFactors[u_] :=
2142  If[ZeroQ[u],
2143    u,
2144  If[RationalQ[u],
2145    Sign[u],
2146  If[PositiveQ[u],
2147    1,
2148  If[ProductQ[u],
2149    Map[NonpositiveFactors,u],
2150  u]]]]
2151
2152
2153Clear[ExpandIntegrand];
2154
2155
2156ExpandIntegrand[(a_.+b_.*x_)^m_.*f_^(e_.*(c_.+d_.*x_)^n_.)/(g_.+h_.*x_),x_Symbol] :=
2157  Module[{tmp=a*h-b*g},
2158  SimplifyTerm[tmp^m/h^m,x]*f^(e*(c+d*x)^n)/(g+h*x) +
2159	Sum[SimplifyTerm[b*tmp^(k-1)/h^k,x]*f^(e*(c+d*x)^n)*(a+b*x)^(m-k),{k,1,m}]] /;
2160FreeQ[{a,b,c,d,e,f,g,h},x] && PositiveIntegerQ[m] && ZeroQ[b*c-a*d]
2161
2162
2163ExpandIntegrand[x_^m_.*(e_+f_.*x_)^p_.*F_^(b_.*(c_.+d_.*x_)^n_.),x_Symbol] :=
2164  If[PositiveIntegerQ[m,p] && m<=p && (OneQ[n] || ZeroQ[d*e-c*f]),
2165    Distribute[F^(b*(c+d*x)^n)*ExpandLinearProduct[x^m,e+f*x,p,x],Plus,Times],
2166  If[PositiveIntegerQ[p],
2167    Distribute[x^m*F^(b*(c+d*x)^n)*Expand[(e+f*x)^p,x],Plus,Times],
2168  Distribute[F^(b*(c+d*x)^n)*ExpandIntegrand[x^m*(e+f*x)^p,x],Plus,Times]]] /;
2169FreeQ[{F,b,c,d,e,f,m,n,p},x]
2170
2171
2172ExpandIntegrand[x_^m_.*(e_+f_.*x_)^p_.*F_^(a_.+b_.*(c_.+d_.*x_)^n_.),x_Symbol] :=
2173  If[PositiveIntegerQ[m,p] && m<=p && (OneQ[n] || ZeroQ[d*e-c*f]),
2174    Distribute[F^(a+b*(c+d*x)^n)*ExpandLinearProduct[x^m,e+f*x,p,x],Plus,Times],
2175  If[PositiveIntegerQ[p],
2176    Distribute[x^m*F^(a+b*(c+d*x)^n)*Expand[(e+f*x)^p,x],Plus,Times],
2177  Distribute[F^(a+b*(c+d*x)^n)*ExpandIntegrand[x^m*(e+f*x)^p,x],Plus,Times]]] /;
2178FreeQ[{F,a,b,c,d,e,f,m,n,p},x]
2179
2180
2181ExpandIntegrand[u_*(a_.+b_.*x_)^m_.*f_^(e_.*(c_.+d_.*x_)^n_.),x_Symbol] :=
2182  Module[{v=ExpandIntegrand[u*(a+b*x)^m,x]},
2183  Distribute[f^(e*(c+d*x)^n)*v,Plus,Times] /;
2184 SumQ[v]] /;
2185FreeQ[{a,b,c,d,e,f,m,n},x] && PolynomialQ[u,x]
2186
2187
2188ExpandIntegrand[u_*(a_.+b_.*x_)^m_.*Log[c_.*(d_.+e_.*x_^n_.)^p_.],x_Symbol] :=
2189  Distribute[Log[c*(d+e*x^n)^p]*ExpandIntegrand[u*(a+b*x)^m,x],Plus,Times] /;
2190FreeQ[{a,b,c,d,e,m,n,p},x] && PolynomialQ[u,x]
2191
2192
2193ExpandIntegrand[u_*f_^(e_.*(c_.+d_.*x_)^n_.),x_Symbol] :=
2194  Distribute[f^(e*(c+d*x)^n)*ExpandLinearProduct[u,c+d*x,0,x],Plus,Times] /;
2195FreeQ[{c,d,e,f,n},x] && PolynomialQ[u,x]
2196
2197
2198ExpandIntegrand[u_.*v_^m_,x_Symbol] :=
2199  Distribute[NormalizeIntegrand[v^m,x]*ExpandIntegrand[u,x],Plus,Times] /;
2200Not[IntegerQ[m]] && Not[LinearQ[v,x]]
2201
2202
2203ExpandIntegrand[u_./(a_.*x_^n_+b_.*Sqrt[c_+d_.*x_^j_]),x_Symbol] :=
2204  ExpandIntegrand[u*(a*x^n-b*Sqrt[c+d*x^(2*n)])/(-b^2*c+(a^2-b^2*d)*x^(2*n)),x] /;
2205FreeQ[{a,b,c,d,n},x] && ZeroQ[j-2*n]
2206
2207
2208ExpandIntegrand[(a_+b_.*x_)^m_/(c_+d_.*x_),x_Symbol] :=
2209  If[RationalQ[a,b,c,d],
2210    ExpandIntegrandAux[(a+b*x)^m/(c+d*x),x],
2211  Module[{tmp=a*d-b*c},
2212  SimplifyTerm[tmp^m/d^m,x]/(c+d*x) + Sum[SimplifyTerm[b*tmp^(k-1)/d^k,x]*(a+b*x)^(m-k),{k,1,m}]]] /;
2213FreeQ[{a,b,c,d},x] && PositiveIntegerQ[m]
2214
2215
2216ExpandIntegrand[(a_+b_.*x_)^m_.*(A_+B_.*x_)/(c_+d_.*x_),x_Symbol] :=
2217  If[RationalQ[a,b,c,d,A,B],
2218    ExpandIntegrandAux[(a+b*x)^m*(A+B*x)/(c+d*x),x],
2219  Module[{tmp1,tmp2},
2220  tmp1=(A*d-B*c)/d;
2221  tmp2=ExpandIntegrand[(a+b*x)^m/(c+d*x),x];
2222  tmp2=If[SumQ[tmp2], Map[Function[SimplifyTerm[tmp1*#,x]],tmp2], SimplifyTerm[tmp1*tmp2,x]];
2223  SimplifyTerm[B/d,x]*(a+b*x)^m + tmp2]] /;
2224FreeQ[{a,b,c,d,A,B},x] && PositiveIntegerQ[m]
2225
2226
2227(* If u is a polynomial in x, ExpandIntegrand[u*(a+b*x)^m,x] expand u*(a+b*x)^m into a sum of terms of the form A*(a+b*x)^n. *)
2228ExpandIntegrand[u_*(a_.+b_.*x_)^m_,x_Symbol] :=
2229  Module[{tmp1,tmp2},
2230  tmp1=ExpandLinearProduct[u,a+b*x,m,x];
2231  If[Not[IntegerQ[m]],
2232    tmp1,
2233  tmp2=ExpandIntegrandAux[u*(a+b*x)^m,x];
2234  If[SumQ[tmp2] && LeafCount[tmp2]<=LeafCount[tmp1]+2,
2235    tmp2,
2236  tmp1]]] /;
2237FreeQ[{a,b,m},x] && PolynomialQ[u,x] &&
2238  Not[PositiveIntegerQ[m] && MatchQ[u,v_.*(c_+d_.*x)^n_ /; FreeQ[{c,d},x] && IntegerQ[n] && n>m]]
2239
2240
2241(* If u is a polynomial in x, MergeLinearProduct[u,a+b*x,m,x] expand u*(a+b*x)^m into a sum of terms of the form A*(a+b*x)^n. *)
2242ExpandLinearProduct[u_,a_.+b_.*x_,m_,x_Symbol] :=
2243  Module[{lst},
2244  lst=CoefficientList[ReplaceAll[u,x->(x-a)/b],x];
2245  lst=Map[Function[SimplifyTerm[#,x]],lst];
2246  Sum[lst[[k]]*(a+b*x)^(m+k-1),{k,1,Length[lst]}]] /;
2247FreeQ[{a,b,m},x] && PolynomialQ[u,x]
2248
2249
2250ExpandIntegrand[u_/v_,x_Symbol] :=
2251  Module[{lst=CoefficientList[u,x]},
2252  lst[[-1]]*x^Exponent[u,x]/v + Sum[lst[[i]]*x^(i-1),{i,1,Exponent[u,x]}]/v] /;
2253PolynomialQ[u,x] && PolynomialQ[v,x] && BinomialQ[v,x] && Exponent[u,x]==Exponent[v,x]-1>=2
2254
2255
2256ExpandIntegrand[u_/v_,x_Symbol] :=
2257  Simp[PolynomialQuotient[u,v,x],x] + SimplifyIntegrand[Together[PolynomialRemainder[u,v,x]]/v,x] /;
2258PolynomialQ[u,x] && PolynomialQ[v,x] && Exponent[u,x]>=Exponent[v,x]
2259
2260
2261ExpandIntegrand[u_,x_Symbol] :=
2262  ExpandIntegrandAux[u,x]
2263
2264
2265(* Note: These rule is necessary because if a or b contains fractional powers, Apart rationalizes
2266	denominator resulting in hard to integrate terms in partial fraction expansion. *)
2267ExpandIntegrandAux[u_.*(a_.+d_.*c_^m_+b_.*v_)^p_,x_Symbol] :=
2268  Module[{tmp},
2269  ReplaceAll[ExpandIntegrandAux[u*(a+d*tmp+b*v)^p,x],{tmp->c^m}]] /;
2270FreeQ[{a,b,c,d},x] && IntegerQ[p] && p<0 && FractionQ[m] && Not[FreeQ[v,x]]
2271
2272ExpandIntegrandAux[u_.*(a_.+b_.*c_^m_*v_)^p_,x_Symbol] :=
2273  Module[{tmp},
2274  ReplaceAll[ExpandIntegrandAux[u*(a+b*tmp*v)^p,x],{tmp->c^m}]] /;
2275FreeQ[{a,b,c},x] && IntegerQ[p] && p<0 && FractionQ[m] && Not[FreeQ[v,x]]
2276
2277
2278ExpandIntegrandAux[u_,x_Symbol] :=
2279  Module[{v},
2280  v=If[AlgebraicFunctionQ[u,x] && Not[RationalFunctionQ[u,x]], ExpandAlgebraic[u,x], 0];
2281  ( If[Not[SumQ[v]],
2282      v=Apart[u,x];
2283    If[Not[SumQ[v]],
2284      v=Apart[u];
2285    If[Not[SumQ[v]],
2286      v=Expand[u,x];
2287    If[Not[SumQ[v]],
2288      v=Expand[u]]]]] );
2289  If[SumQ[v],
2290    v=Map[Function[SimplifyTerm[#,x]],v];
2291    Apply[Plus,Map[Function[#[[1]]*#[[2]]],UnifyTerms[Map[Function[SplitFreeFactors[#,x]],Apply[List,v]]]]],
2292  SimplifyTerm[u,x]]]
2293
2294
2295SimplifyTerm[u_,x_Symbol] :=
2296  NormalizeIntegrand[Together[Simplify[u]],x]
2297
2298
2299ExpandAlgebraic[u_Plus*v_,x_Symbol] :=
2300  Map[Function[#*v],u] /;
2301Not[FreeQ[u,x]]
2302
2303ExpandAlgebraic[u_Plus^n_*v_.,x_Symbol] :=
2304  Module[{w=Expand[u^n,x]},
2305  Map[Function[#*v],w] /;
2306 SumQ[w]] /;
2307PositiveIntegerQ[n] && Not[FreeQ[u,x]]
2308
2309
2310(* lst is a list of pairs of the form {u,v}. UnifyTerms[lst,x] returns lst with pairs having indentical v's collected into a single element. *)
2311UnifyTerms[lst_] :=
2312  If[lst==={},
2313    lst,
2314  UnifyTerm[First[lst][[1]],First[lst][[2]],UnifyTerms[Rest[lst]]]]
2315
2316
2317UnifyTerm[u_,v_,lst_] :=
2318  If[lst==={},
2319    {{u,v}},
2320  If[v===First[lst][[2]],
2321    Prepend[Rest[lst],{u+First[lst][[1]],v}],
2322  Prepend[UnifyTerm[u,v,Rest[lst]],First[lst]]]]
2323
2324
2325Distrib[u_] :=
2326  Distribute[u,Plus,Times]
2327
2328
2329(* Dist[u,v] returns the sum of u times each term of v, provided v is free of Int. *)
2330DownValues[Dist]={};
2331UpValues[Dist]={};
2332
2333Dist[0,v_,x_] :=
2334  (Print["*** Warning ***:  Dist[0,",v," ",x,"]"]; 0);
2335
2336Dist[1,v_,x_] := v
2337
2338Dist[u_,v_,x_] :=
2339  -Dist[-u,v,x] /;
2340NumericFactor[u]<0
2341
2342Dist /: Dist[u_,v_,x_]+Dist[w_,v_,x_] :=
2343  If[ZeroQ[u+w],
2344    0,
2345  Dist[u+w,v,x]]
2346
2347Dist /: Dist[u_,v_,x_]-Dist[w_,v_,x_] :=
2348  If[ZeroQ[u-w],
2349    0,
2350  Dist[u-w,v,x]]
2351
2352Dist /: w_*Dist[u_,v_,x_] :=
2353  Dist[w*u,v,x] /;
2354w=!=-1
2355
2356Dist[u_,Dist[v_,w_,x_],x_] :=
2357  Dist[u*v,w,x]
2358
2359Dist[u_,v_,x_] :=
2360  Map[Function[Dist[u,#,x]],v] /;
2361SumQ[v]
2362
2363Dist[u_,v_,x_] :=
2364  Simp[u*v,x] /;
2365FreeQ[v,Int] || ShowSteps=!=True
2366
2367Dist[u_,v_,x_] :=
2368  Module[{w=Simp[u,x]},
2369  Dist[w,v,x] /;
2370w=!=u]
2371
2372Dist[u_,v_*w_,x_] :=
2373  Dist[u*v,w,x] /;
2374FreeQ[v,Int] && Not[FreeQ[w,Int]]
2375
2376
2377(* DistSimp[u_.*v_^m_*w_^n_] :=
2378  DistSimp[u*v^(m+n)] /;
2379ZeroQ[v-w]
2380
2381(* Basis: If n is an integer, (a+b*z)^m*(b+a/z)^n == (a+b*z)^(m+n)/z^n *)
2382DistSimp[u_*(a_+b_.*f_[v_])^m_*(b_+a_.*g_[v_])^n_.] :=
2383  u*(a+b*f[v])^(m+n)/f[v]^n /;
2384TrigQ[f] && TrigQ[g] && f[v]===1/g[v] && RationalQ[m] && IntegerQ[n]
2385
2386DistSimp[u_] := u *)
2387
2388
2389(* If u (x) is equivalent to an expression of the form f (a+b*x) and not the case that a==0 and
2390	b==1, FunctionOfLinear[u,x] returns the list {f (x),a,b}; else it returns False. *)
2391FunctionOfLinear[u_,x_Symbol] :=
2392  Module[{lst=FunctionOfLinear[u,False,False,x,False]},
2393  If[FalseQ[lst] || FalseQ[lst[[1]]] || lst[[1]]===0 && lst[[2]]===1,
2394    False,
2395  {FunctionOfLinearSubst[u,lst[[1]],lst[[2]],x],lst[[1]],lst[[2]]}]]
2396
2397
2398FunctionOfLinear[u_,a_,b_,x_,flag_] :=
2399  If[FreeQ[u,x],
2400    {a,b},
2401  If[CalculusQ[u],
2402    False,
2403  If[LinearQ[u,x],
2404    If[FalseQ[a],
2405      {Coefficient[u,x,0],Coefficient[u,x,1]},
2406    Module[{lst=CommonFactors[{b,Coefficient[u,x,1]}]},
2407    If[ZeroQ[Coefficient[u,x,0]] && Not[flag],
2408      {0,lst[[1]]},
2409    If[ZeroQ[b*Coefficient[u,x,0]-a*Coefficient[u,x,1]],
2410      {a/lst[[2]],lst[[1]]},
2411    {0,1}]]]],
2412  If[PowerQ[u] && FreeQ[u[[1]],x],
2413    FunctionOfLinear[Log[u[[1]]]*u[[2]],a,b,x,False],
2414  Module[{lst},
2415  If[ProductQ[u] && NonzeroQ[(lst=MonomialFactor[u,x])[[1]]],
2416    If[False && IntegerQ[lst[[1]]] && lst[[1]]!=-1 && FreeQ[lst[[2]],x],
2417      If[RationalQ[LeadFactor[lst[[2]]]] && LeadFactor[lst[[2]]]<0,
2418        FunctionOfLinear[DivideDegreesOfFactors[-lst[[2]],lst[[1]]]*x,a,b,x,False],
2419      FunctionOfLinear[DivideDegreesOfFactors[lst[[2]],lst[[1]]]*x,a,b,x,False]],
2420    False],
2421  lst={a,b};
2422  Catch[
2423  Scan[Function[lst=FunctionOfLinear[#,lst[[1]],lst[[2]],x,SumQ[u]];
2424			If[FalseQ[lst],Throw[False]]],u];
2425  lst]]]]]]]
2426
2427
2428FunctionOfLinearSubst[u_,a_,b_,x_] :=
2429  If[FreeQ[u,x],
2430    u,
2431  If[LinearQ[u,x],
2432    Module[{tmp=Coefficient[u,x,1]},
2433    tmp=If[tmp===b, 1, tmp/b];
2434    Coefficient[u,x,0]-a*tmp+tmp*x],
2435  If[PowerQ[u] && FreeQ[u[[1]],x],
2436    E^FullSimplify[FunctionOfLinearSubst[Log[u[[1]]]*u[[2]],a,b,x]],
2437  Module[{lst},
2438  If[ProductQ[u] && NonzeroQ[(lst=MonomialFactor[u,x])[[1]]],
2439    If[RationalQ[LeadFactor[lst[[2]]]] && LeadFactor[lst[[2]]]<0,
2440      -FunctionOfLinearSubst[DivideDegreesOfFactors[-lst[[2]],lst[[1]]]*x,a,b,x]^lst[[1]],
2441    FunctionOfLinearSubst[DivideDegreesOfFactors[lst[[2]],lst[[1]]]*x,a,b,x]^lst[[1]]],
2442  Map[Function[FunctionOfLinearSubst[#,a,b,x]],u]]]]]]
2443
2444
2445(* DivideDegreesOfFactors[u,n] returns the product of the base of the factors of u raised to
2446	the degree of the factors divided by n. *)
2447DivideDegreesOfFactors[u_,n_] :=
2448  If[ProductQ[u],
2449    Map[Function[LeadBase[#]^(LeadDegree[#]/n)],u],
2450  LeadBase[u]^(LeadDegree[u]/n)]
2451
2452
2453(* If u is a function of an inverse linear binomial of the form 1/(a+b*x),
2454	FunctionOfInverseLinear[u,x] returns the list {a,b}; else it returns False. *)
2455FunctionOfInverseLinear[u_,x_Symbol] :=
2456  FunctionOfInverseLinear[u,Null,x]
2457
2458FunctionOfInverseLinear[u_,lst_,x_] :=
2459  If[FreeQ[u,x],
2460    lst,
2461  If[u===x,
2462    False,
2463  If[QuotientOfLinearsQ[u,x],
2464    Module[{tmp=Drop[QuotientOfLinearsParts[u,x],2]},
2465    If[tmp[[2]]===0,
2466      False,
2467    If[lst===Null,
2468      tmp,
2469    If[ZeroQ[lst[[1]]*tmp[[2]]-lst[[2]]*tmp[[1]]],
2470      lst,
2471    False]]]],
2472  If[CalculusQ[u],
2473    False,
2474  Module[{tmp=lst},Catch[
2475  Scan[Function[If[FalseQ[tmp=FunctionOfInverseLinear[#,tmp,x]],Throw[False]]],u];
2476  tmp]]]]]]
2477
2478
2479(* If u is a function of f^(a+b*x), FunctionOfExponentialOfLinear[u,x] returns the list {v,a,b,f}
2480	where v of f^(a+b*x) equals u; else it returns False. *)
2481FunctionOfExponentialOfLinear[u_,x_Symbol] :=
2482  Module[{lst=FunctionOfExponentialOfLinear[u,x,False,False,False],a,b,f},
2483  If[FalseQ[lst] || FalseQ[lst[[1]]],
2484    False,
2485  a=lst[[1]];
2486  b=lst[[2]];
2487  f=lst[[3]];
2488  ( If[MatchQ[u,v_*g_^(c_.+d_*x) /; FreeQ[{c,d,g},x] && NumericFactor[d]<0] && NumericFactor[b]>0,
2489      a=-a;
2490      b=-b] );
2491  {FunctionOfExponentialOfLinearSubst[u,a,b,f,x],a,b,f}]]
2492
2493
2494(* If u is a function of f^(a+b*x), FunctionOfExponentialOfLinear[u,x,False,False,False]
2495	returns the list {a, b, f}; else it returns False. *)
2496FunctionOfExponentialOfLinear[u_,x_,a_,b_,f_] :=
2497  If[FreeQ[u,x],
2498    {a,b,f},
2499  If[u===x || CalculusQ[u],
2500    False,
2501  If[PowerQ[u] && FreeQ[u[[1]],x] && LinearQ[u[[2]],x],
2502    FunctionOfExponentialOfLinearAux[a,b,f,Coefficient[u[[2]],x,0],Coefficient[u[[2]],x,1],u[[1]]],
2503  If[HyperbolicQ[u] && LinearQ[u[[1]],x],
2504    FunctionOfExponentialOfLinearAux[a,b,f,Coefficient[u[[1]],x,0],Coefficient[u[[1]],x,1],E],
2505  Module[{lst},
2506  If[PowerQ[u] && FreeQ[u[[1]],x] && SumQ[u[[2]]],
2507    lst=FunctionOfExponentialOfLinear[u[[1]]^First[u[[2]]],x,a,b,f];
2508    If[FalseQ[lst],
2509      False,
2510    FunctionOfExponentialOfLinear[u[[1]]^Rest[u[[2]]],x,lst[[1]],lst[[2]],lst[[3]]]],
2511  lst={a,b,f};
2512  Catch[Scan[Function[
2513    lst=FunctionOfExponentialOfLinear[#,x,lst[[1]],lst[[2]],lst[[3]]];
2514    If[FalseQ[lst],Throw[False]]],u];
2515  lst]]]]]]]
2516
2517
2518FunctionOfExponentialOfLinearAux[a_,b_,f_,c_,d_,g_] :=
2519  If[FalseQ[a],
2520    {c,d,g},
2521  If[ZeroQ[Log[f]*NonnumericFactors[b]-Log[g]*NonnumericFactors[d]],
2522    Module[{gcd=GCD[NumericFactor[b],NumericFactor[d]]},
2523    ( If[NumericFactor[b]<0 && NumericFactor[d]<0,
2524        gcd=-gcd] );
2525    If[gcd==NumericFactor[b],
2526      {a,b,f},
2527    If[gcd==NumericFactor[d],
2528      {c,d,g},
2529    {0,gcd*NonnumericFactors[b],f}]]],
2530  False]]
2531
2532
2533(* u is a function of f^(a+b*x).  FunctionOfExponentialOfLinearSubst[u,a,b,f,x] returns u
2534	with f^(a+b*x) replaced by x. *)
2535FunctionOfExponentialOfLinearSubst[u_,a_,b_,f_,x_] :=
2536  If[FreeQ[u,x],
2537    u,
2538  If[PowerQ[u] && FreeQ[u[[1]],x] && LinearQ[u[[2]],x],
2539    Module[{c,d,g},
2540    c=Coefficient[u[[2]],x,0];
2541    d=Coefficient[u[[2]],x,1];
2542    g=u[[1]];
2543    g^(c-a*d/b)*x^(d*Log[g]/(b*Log[f]))],
2544  If[HyperbolicQ[u] && LinearQ[u[[1]],x],
2545    Module[{c,d,tmp},
2546    c=Coefficient[u[[1]],x,0];
2547    d=Coefficient[u[[1]],x,1];
2548    tmp=E^(c-a*d/b)*x^(d/(b*Log[f]));
2549    If[SinhQ[u],
2550      tmp/2-1/(2*tmp),
2551    If[CoshQ[u],
2552      tmp/2+1/(2*tmp),
2553    If[TanhQ[u],
2554      (tmp-1/tmp)/(tmp+1/tmp),
2555    If[CothQ[u],
2556      (tmp+1/tmp)/(tmp-1/tmp),
2557    If[SechQ[u],
2558      2/(tmp+1/tmp),
2559    2/(tmp-1/tmp)]]]]]],
2560  If[PowerQ[u] && FreeQ[u[[1]],x] && SumQ[u[[2]]],
2561    FunctionOfExponentialOfLinearSubst[u[[1]]^First[u[[2]]],a,b,f,x]*
2562    FunctionOfExponentialOfLinearSubst[u[[1]]^Rest[u[[2]]],a,b,f,x],
2563  Map[Function[FunctionOfExponentialOfLinearSubst[#,a,b,f,x]],u]]]]]
2564
2565
2566(* If u is a function of trig functions of a linear function of x,
2567    FunctionOfTrigOfLinearQ[u,x] returns True; else it returns False. *)
2568FunctionOfTrigOfLinearQ[u_,x_Symbol] :=
2569  (* Not[MatchQ[u, (c_.*f_[a_.+b_.*x])^p_. /; FreeQ[{a,b,c,p},x] && MemberQ[{Sin,Cos,Sec,Csc},f]]] && *)
2570  Not[MemberQ[{Null, False}, FunctionOfTrig[u,Null,x]]] &&
2571    RecognizedFunctionOfTrigQ[SubstInertTrigFunction[u,x],x]
2572
2573(* If u is a function of trig functions of v where v is a linear function of x,
2574	FunctionOfTrig[u,x] returns v; else it returns False. *)
2575FunctionOfTrig[u_,x_Symbol] :=
2576  Module[{v=FunctionOfTrig[u,Null,x]},
2577  If[v===Null, False, v]]
2578
2579FunctionOfTrig[u_,v_,x_] :=
2580  If[AtomQ[u],
2581    If[u===x,
2582      False,
2583    v],
2584  If[TrigQ[u] && LinearQ[u[[1]],x],
2585    If[v===Null,
2586      u[[1]],
2587    Module[{a=Coefficient[v,x,0],b=Coefficient[v,x,1],
2588			c=Coefficient[u[[1]],x,0],d=Coefficient[u[[1]],x,1]},
2589    If[ZeroQ[a*d-b*c] && RationalQ[b/d],
2590      a/Numerator[b/d]+b*x/Numerator[b/d],
2591    False]]],
2592  If[CalculusQ[u],
2593    False,
2594  Module[{w=v},Catch[
2595  Scan[Function[If[FalseQ[w=FunctionOfTrig[#,w,x]],Throw[False]]],u];
2596  w]]]]]
2597
2598
2599(* u is a function of the inert trig functions (sin, csc and tan) of x.
2600If u can be put in the form f[c+d*x]^m*(A+B*g[c+d*x]+C*g[c+d*x]^2)*(a+b*g[c+d*x])^n
2601RecognizedFunctionOfTrigQ[u,x] returns True; else it returns False. *)
2602RecognizedFunctionOfTrigQ[u_,x_Symbol] :=
2603  MatchQ[u, (a_.+b_.*f_[c_.+d_.*x])^n_. /;
2604    FreeQ[{a,b,c,d,n},x] && InertTrigQ[f]] ||
2605  MatchQ[u, (A_.+B_.*f_[c_.+d_.*x])*(a_.+b_.*g_[c_.+d_.*x])^n_. /;
2606    FreeQ[{a,b,c,d,A,B,n},x] && InertTrigQ[f,g]] ||
2607  MatchQ[u, (A_.+C_.*f_[c_.+d_.*x]^2)*(a_.+b_.*g_[c_.+d_.*x])^n_. /;
2608    FreeQ[{a,b,c,d,A,C,n},x] && InertTrigQ[f,g]] ||
2609  MatchQ[u, (A_.+B_.*f_[c_.+d_.*x]+C_.*f_[c_.+d_.*x]^2)*(a_.+b_.*g_[c_.+d_.*x])^n_. /;
2610    FreeQ[{a,b,c,d,A,B,C,n},x] && InertTrigQ[f,g]] ||
2611  MatchQ[u, (A_.+B_.*sin[c_.+d_.*x]+C_.*csc[c_.+d_.*x])*(a_.+b_.*g_[c_.+d_.*x])^n_. /;
2612    FreeQ[{a,b,c,d,A,B,C,n},x] && InertTrigQ[g]] ||
2613
2614  MatchQ[u, f_[c_.+d_.*x]^m_.*(A_.+B_.*g_[c_.+d_.*x]) /;
2615    FreeQ[{c,d,A,B,m},x] && InertTrigQ[f,g]] ||
2616  MatchQ[u, f_[c_.+d_.*x]^m_.*(A_.+C_.*g_[c_.+d_.*x]^2) /;
2617    FreeQ[{c,d,A,C,m},x] && InertTrigQ[f,g]] ||
2618  MatchQ[u, f_[c_.+d_.*x]^m_.*(A_.+B_.*g_[c_.+d_.*x]+C_.*g_[c_.+d_.*x]^2) /;
2619    FreeQ[{c,d,A,B,C,m},x] && InertTrigQ[f,g]] ||
2620  MatchQ[u, f_[c_.+d_.*x]^m_.*(A_.+B_.*sin[c_.+d_.*x]+C_.*csc[c_.+d_.*x]) /;
2621    FreeQ[{c,d,A,B,C,m},x] && InertTrigQ[f]] ||
2622
2623  MatchQ[u, f_[c_.+d_.*x]^m_.*(a_.+b_.*g_[c_.+d_.*x])^n_. /;
2624    FreeQ[{a,b,c,d,m,n},x] && InertTrigQ[f,g]] ||
2625  MatchQ[u, f_[c_.+d_.*x]^m_.*(A_.+B_.*g_[c_.+d_.*x])*(a_.+b_.*h_[c_.+d_.*x])^n_. /;
2626    FreeQ[{a,b,c,d,A,B,m,n},x] && InertTrigQ[f,g,h]] ||
2627  MatchQ[u, f_[c_.+d_.*x]^m_.*(A_.+C_.*g_[c_.+d_.*x]^2)*(a_.+b_.*h_[c_.+d_.*x])^n_. /;
2628    FreeQ[{a,b,c,d,A,C,m,n},x] && InertTrigQ[f,g,h]] ||
2629  MatchQ[u, f_[c_.+d_.*x]^m_.*(A_.+B_.*g_[c_.+d_.*x]+C_.*g_[c_.+d_.*x]^2)*(a_.+b_.*h_[c_.+d_.*x])^n_. /;
2630    FreeQ[{a,b,c,d,A,B,C,m,n},x] && InertTrigQ[f,g,h]] ||
2631  MatchQ[u, f_[c_.+d_.*x]^m_.*(A_.+B_.*sin[c_.+d_.*x]+C_.*csc[c_.+d_.*x])*(a_.+b_.*g_[c_.+d_.*x])^n_. /;
2632    FreeQ[{a,b,c,d,A,B,C,m,n},x] && InertTrigQ[f,g]] ||
2633
2634  MatchQ[u, Sqrt[a_+b_.*csc[c_.+d_.*x]]/(A_+B_.*sin[c_.+d_.*x]) /;
2635    FreeQ[{a,b,c,d,A,B},x] && ZeroQ[B-A] && NonzeroQ[a^2-b^2]] ||
2636  MatchQ[u, Sqrt[a_+b_.*sin[c_.+d_.*x]]/(Sqrt[sin[c_.+d_.*x]]*(A_+B_.*sin[c_.+d_.*x])) /;
2637    FreeQ[{a,b,c,d,A,B},x] && ZeroQ[B-A] && NonzeroQ[a^2-b^2]]
2638
2639
2640InertTrigQ[f_] := f===sin || f===csc || f===tan
2641
2642InertTrigQ[f_,g_] :=
2643  If[f===g,
2644    InertTrigQ[f],
2645  f===sin && g===csc || f===csc && g===sin]
2646
2647InertTrigQ[f_,g_,h_] := InertTrigQ[f,g] && InertTrigQ[g,h]
2648
2649
2650(* If u is a function of hyperbolic trig functions of v where v is linear in x,
2651	FunctionOfHyperbolic[u,x] returns v; else it returns False. *)
2652FunctionOfHyperbolic[u_,x_Symbol] :=
2653  Module[{v=FunctionOfHyperbolic[u,Null,x]},
2654  If[v===Null, False, v]]
2655
2656FunctionOfHyperbolic[u_,v_,x_] :=
2657  If[AtomQ[u],
2658    If[u===x,
2659      False,
2660    v],
2661  If[HyperbolicQ[u] && LinearQ[u[[1]],x],
2662    If[v===Null,
2663      u[[1]],
2664    Module[{a=Coefficient[v,x,0],b=Coefficient[v,x,1],
2665			c=Coefficient[u[[1]],x,0],d=Coefficient[u[[1]],x,1]},
2666    If[ZeroQ[a*d-b*c] && RationalQ[b/d],
2667      a/Numerator[b/d]+b*x/Numerator[b/d],
2668    False]]],
2669  If[CalculusQ[u],
2670    False,
2671  Module[{w=v},Catch[
2672  Scan[Function[If[FalseQ[w=FunctionOfHyperbolic[#,w,x]],Throw[False]]],u];
2673  w]]]]]
2674
2675
2676(* v is a function of x.
2677	If u is a function of v, FunctionOfQ[v,u,x] returns True; else it returns False. *)
2678FunctionOfQ[v_,u_,x_Symbol,PureFlag_:False] :=
2679  If[FreeQ[u,x],
2680    False,
2681  If[AtomQ[v],
2682    True,
2683  If[PowerQ[v] && FreeQ[v[[2]],x] (* && NonzeroQ[v[[2]]+1] *),
2684    FunctionOfPowerQ[u,v[[1]],v[[2]],x],
2685  If[PureFlag,
2686    If[SinQ[v] || CscQ[v],
2687      PureFunctionOfSinQ[u,v[[1]],x],
2688    If[CosQ[v] || SecQ[v],
2689      PureFunctionOfCosQ[u,v[[1]],x],
2690    If[TanQ[v],
2691      PureFunctionOfTanQ[u,v[[1]],x],
2692    If[CotQ[v],
2693      PureFunctionOfCotQ[u,v[[1]],x],
2694    If[SinhQ[v] || CschQ[v],
2695      PureFunctionOfSinhQ[u,v[[1]],x],
2696    If[CoshQ[v] || SechQ[v],
2697      PureFunctionOfCoshQ[u,v[[1]],x],
2698    If[TanhQ[v],
2699      PureFunctionOfTanhQ[u,v[[1]],x],
2700    If[CothQ[v],
2701      PureFunctionOfCothQ[u,v[[1]],x],
2702    FunctionOfExpnQ[u,v,x]]]]]]]]],
2703  If[SinQ[v] || CscQ[v],
2704    FunctionOfSinQ[u,v[[1]],x],
2705  If[CosQ[v] || SecQ[v],
2706    FunctionOfCosQ[u,v[[1]],x],
2707  If[TanQ[v] || CotQ[v],
2708    FunctionOfTanQ[u,v[[1]],x],
2709  If[SinhQ[v] || CschQ[v],
2710    FunctionOfSinhQ[u,v[[1]],x],
2711  If[CoshQ[v] || SechQ[v],
2712    FunctionOfCoshQ[u,v[[1]],x],
2713  If[TanhQ[v] || CothQ[v],
2714    FunctionOfTanhQ[u,v[[1]],x],
2715  FunctionOfExpnQ[u,v,x]]]]]]]]]]]
2716
2717
2718FunctionOfExpnQ[u_,v_,x_] :=
2719  If[u===v,
2720    True,
2721  If[AtomQ[u],
2722    u=!=x,
2723  If[CalculusQ[u],
2724    False,
2725  Catch[Scan[Function[If[FunctionOfExpnQ[#,v,x],Null,Throw[False]]],u];True]]]]
2726
2727
2728FunctionOfPowerQ[u_,bas_,deg_,x_] :=
2729  If[AtomQ[u],
2730    u=!=x,
2731  If[CalculusQ[u],
2732    False,
2733  If[PowerQ[u] && ZeroQ[u[[1]]-bas] && FreeQ[u[[2]],x],
2734    If[RationalQ[deg],
2735      If[RationalQ[u[[2]]],
2736        IntegerQ[u[[2]]/deg] && (deg>0 || u[[2]]<0),
2737      False],
2738    IntegerQ[Simplify[u[[2]]/deg]]],
2739  Catch[Scan[Function[If[FunctionOfPowerQ[#,bas,deg,x],Null,Throw[False]]],u];True]]]]
2740
2741
2742(* If func[w]^m is a factor of u where m is odd and w is an integer multiple of v,
2743	FindTrigFactor[func1,func2,u,v,True] returns the list {w,u/func[w]^n}; else it returns False. *)
2744(* If func[w]^m is a factor of u where m is odd and w is an integer multiple of v not equal to v,
2745	FindTrigFactor[func1,func2,u,v,False] returns the list {w,u/func[w]^n}; else it returns False. *)
2746FindTrigFactor[func1_,func2_,u_,v_,flag_] :=
2747  If[u===1,
2748    False,
2749  If[(Head[LeadBase[u]]===func1 || Head[LeadBase[u]]===func2) &&
2750		OddQ[LeadDegree[u]] &&
2751		IntegerQuotientQ[LeadBase[u][[1]],v] &&
2752		(flag || NonzeroQ[LeadBase[u][[1]]-v]),
2753    {LeadBase[u][[1]], RemainingFactors[u]},
2754  Module[{lst=FindTrigFactor[func1,func2,RemainingFactors[u],v,flag]},
2755  If[FalseQ[lst],
2756    False,
2757  {lst[[1]], LeadFactor[u]*lst[[2]]}]]]]
2758
2759
2760(* If u is a pure function of Sin[v] and/or Csc[v], PureFunctionOfSinQ[u,v,x] returns True;
2761	else it returns False. *)
2762PureFunctionOfSinQ[u_,v_,x_] :=
2763  If[AtomQ[u],
2764    u=!=x,
2765  If[CalculusQ[u],
2766    False,
2767  If[TrigQ[u] && ZeroQ[u[[1]]-v],
2768    SinQ[u] || CscQ[u],
2769  Catch[Scan[Function[If[Not[PureFunctionOfSinQ[#,v,x]],Throw[False]]],u];True]]]]
2770
2771
2772(* If u is a pure function of Cos[v] and/or Sec[v], PureFunctionOfCosQ[u,v,x] returns True;
2773	else it returns False. *)
2774PureFunctionOfCosQ[u_,v_,x_] :=
2775  If[AtomQ[u],
2776    u=!=x,
2777  If[CalculusQ[u],
2778    False,
2779  If[TrigQ[u] && ZeroQ[u[[1]]-v],
2780    CosQ[u] || SecQ[u],
2781  Catch[Scan[Function[If[Not[PureFunctionOfCosQ[#,v,x]],Throw[False]]],u];True]]]]
2782
2783
2784(* If u is a pure function of Tan[v] and/or Cot[v], PureFunctionOfTanQ[u,v,x] returns True;
2785	else it returns False. *)
2786PureFunctionOfTanQ[u_,v_,x_] :=
2787  If[AtomQ[u],
2788    u=!=x,
2789  If[CalculusQ[u],
2790    False,
2791  If[TrigQ[u] && ZeroQ[u[[1]]-v],
2792    TanQ[u] || CotQ[u],
2793  Catch[Scan[Function[If[Not[PureFunctionOfTanQ[#,v,x]],Throw[False]]],u];True]]]]
2794
2795
2796(* If u is a pure function of Cot[v], PureFunctionOfCotQ[u,v,x] returns True;
2797	else it returns False. *)
2798PureFunctionOfCotQ[u_,v_,x_] :=
2799  If[AtomQ[u],
2800    u=!=x,
2801  If[CalculusQ[u],
2802    False,
2803  If[TrigQ[u] && ZeroQ[u[[1]]-v],
2804    CotQ[u],
2805  Catch[Scan[Function[If[Not[PureFunctionOfCotQ[#,v,x]],Throw[False]]],u];True]]]]
2806
2807
2808(* If u is a function of Sin[v], FunctionOfSinQ[u,v,x] returns True; else it returns False. *)
2809FunctionOfSinQ[u_,v_,x_] :=
2810  If[AtomQ[u],
2811    u=!=x,
2812  If[CalculusQ[u],
2813    False,
2814  If[TrigQ[u] && IntegerQuotientQ[u[[1]],v],
2815    If[OddQuotientQ[u[[1]],v],
2816(* Basis: If m odd, Sin[m*v]^n is a function of Sin[v]. *)
2817      SinQ[u] || CscQ[u],
2818(* Basis: If m even, Cos[m*v]^n is a function of Sin[v]. *)
2819    CosQ[u] || SecQ[u]],
2820  If[IntegerPowerQ[u] && TrigQ[u[[1]]] && IntegerQuotientQ[u[[1,1]],v],
2821    If[EvenQ[u[[2]]],
2822(* Basis: If m integer and n even, Trig[m*v]^n is a function of Sin[v]. *)
2823      True,
2824    FunctionOfSinQ[u[[1]],v,x]],
2825  If[ProductQ[u],
2826    If[CosQ[u[[1]]] && SinQ[u[[2]]] && ZeroQ[u[[1,1]]-v/2] && ZeroQ[u[[2,1]]-v/2],
2827      FunctionOfSinQ[Drop[u,2],v,x],
2828    Module[{lst},
2829    lst=FindTrigFactor[Sin,Csc,u,v,False];
2830    If[NotFalseQ[lst] && EvenQuotientQ[lst[[1]],v],
2831(* Basis: If m even and n odd, Sin[m*v]^n == Cos[v]*u where u is a function of Sin[v]. *)
2832      FunctionOfSinQ[Cos[v]*lst[[2]],v,x],
2833    lst=FindTrigFactor[Cos,Sec,u,v,False];
2834    If[NotFalseQ[lst] && OddQuotientQ[lst[[1]],v],
2835(* Basis: If m odd and n odd, Cos[m*v]^n == Cos[v]*u where u is a function of Sin[v]. *)
2836      FunctionOfSinQ[Cos[v]*lst[[2]],v,x],
2837    lst=FindTrigFactor[Tan,Cot,u,v,True];
2838    If[NotFalseQ[lst],
2839(* Basis: If m integer and n odd, Tan[m*v]^n == Cos[v]*u where u is a function of Sin[v]. *)
2840      FunctionOfSinQ[Cos[v]*lst[[2]],v,x],
2841    Catch[Scan[Function[If[Not[FunctionOfSinQ[#,v,x]],Throw[False]]],u];True]]]]]],
2842  Catch[Scan[Function[If[Not[FunctionOfSinQ[#,v,x]],Throw[False]]],u];True]]]]]]
2843
2844
2845(* If u is a function of Cos[v], FunctionOfCosQ[u,v,x] returns True; else it returns False. *)
2846FunctionOfCosQ[u_,v_,x_] :=
2847  If[AtomQ[u],
2848    u=!=x,
2849  If[CalculusQ[u],
2850    False,
2851  If[TrigQ[u] && IntegerQuotientQ[u[[1]],v],
2852(* Basis: If m integer, Cos[m*v]^n is a function of Cos[v]. *)
2853    CosQ[u] || SecQ[u],
2854  If[IntegerPowerQ[u] && TrigQ[u[[1]]] && IntegerQuotientQ[u[[1,1]],v],
2855    If[EvenQ[u[[2]]],
2856(* Basis: If m integer and n even, Trig[m*v]^n is a function of Cos[v]. *)
2857      True,
2858    FunctionOfCosQ[u[[1]],v,x]],
2859  If[ProductQ[u],
2860    Module[{lst},
2861    lst=FindTrigFactor[Sin,Csc,u,v,False];
2862    If[NotFalseQ[lst],
2863(* Basis: If m integer and n odd, Sin[m*v]^n == Sin[v]*u where u is a function of Cos[v]. *)
2864      FunctionOfCosQ[Sin[v]*lst[[2]],v,x],
2865    lst=FindTrigFactor[Tan,Cot,u,v,True];
2866    If[NotFalseQ[lst],
2867(* Basis: If m integer and n odd, Tan[m*v]^n == Sin[v]*u where u is a function of Cos[v]. *)
2868      FunctionOfCosQ[Sin[v]*lst[[2]],v,x],
2869    Catch[Scan[Function[If[Not[FunctionOfCosQ[#,v,x]],Throw[False]]],u];True]]]],
2870  Catch[Scan[Function[If[Not[FunctionOfCosQ[#,v,x]],Throw[False]]],u];True]]]]]]
2871
2872
2873(* If u is a function of the form f[Tan[v],Cot[v]] where f is independent of x,
2874	FunctionOfTanQ[u,v,x] returns True; else it returns False. *)
2875FunctionOfTanQ[u_,v_,x_] :=
2876  If[AtomQ[u],
2877    u=!=x,
2878  If[CalculusQ[u],
2879    False,
2880  If[TrigQ[u] && IntegerQuotientQ[u[[1]],v],
2881    TanQ[u] || CotQ[u] || EvenQuotientQ[u[[1]],v],
2882  If[PowerQ[u] && EvenQ[u[[2]]] && TrigQ[u[[1]]] && IntegerQuotientQ[u[[1,1]],v],
2883    True,
2884  If[ProductQ[u],
2885    Module[{lst=ReapList[Scan[Function[If[Not[FunctionOfTanQ[#,v,x]],Sow[#]]],u]]},
2886    If[lst==={},
2887      True,
2888    Length[lst]==2 && OddTrigPowerQ[lst[[1]],v,x] && OddTrigPowerQ[lst[[2]],v,x]]],
2889  Catch[Scan[Function[If[Not[FunctionOfTanQ[#,v,x]],Throw[False]]],u];True]]]]]]
2890
2891OddTrigPowerQ[u_,v_,x_] :=
2892  If[SinQ[u] || CosQ[u] || SecQ[u] || CscQ[u],
2893    OddQuotientQ[u[[1]],v],
2894  If[PowerQ[u],
2895    OddQ[u[[2]]] && OddTrigPowerQ[u[[1]],v,x],
2896  If[ProductQ[u],
2897    Module[{lst=ReapList[Scan[Function[If[Not[FunctionOfTanQ[#,v,x]],Sow[#]]],u]]},
2898    If[lst==={},
2899      True,
2900    Length[lst]==1 && OddTrigPowerQ[lst[[1]],v,x]]],
2901(*If[SumQ[u],
2902    Catch[Scan[Function[If[Not[OddTrigPowerQ[#,v,x]],Throw[False]]],u];True], *)
2903  False]]]
2904
2905
2906(* u is a function of the form f[Tan[v],Cot[v]] where f is independent of x.
2907FunctionOfTanWeight[u,v,x] returns a nonnegative number if u is best considered a function
2908of Tan[v]; else it returns a negative number. *)
2909FunctionOfTanWeight[u_,v_,x_] :=
2910  If[AtomQ[u],
2911    0,
2912  If[CalculusQ[u],
2913    0,
2914  If[TrigQ[u] && IntegerQuotientQ[u[[1]],v],
2915    If[TanQ[u] && ZeroQ[u[[1]]-v],
2916      1,
2917    If[CotQ[u] && ZeroQ[u[[1]]-v],
2918      -1,
2919    0]],
2920  If[PowerQ[u] && EvenQ[u[[2]]] && TrigQ[u[[1]]] && IntegerQuotientQ[u[[1,1]],v],
2921    If[TanQ[u[[1]]] || CosQ[u[[1]]] || SecQ[u[[1]]],
2922      1,
2923    -1],
2924  If[ProductQ[u],
2925    If[Catch[Scan[Function[If[Not[FunctionOfTanQ[#,v,x]],Throw[False]]],u];True],
2926      Apply[Plus,Map[Function[FunctionOfTanWeight[#,v,x]],Apply[List,u]]],
2927    0],
2928  Apply[Plus,Map[Function[FunctionOfTanWeight[#,v,x]],Apply[List,u]]]]]]]]
2929
2930
2931(* If u (x) is equivalent to an expression of the form f (Sin[v],Cos[v],Tan[v],Cot[v],Sec[v],Csc[v])
2932	where f is independent of x, FunctionOfTrigQ[u,v,x] returns True; else it returns False. *)
2933FunctionOfTrigQ[u_,v_,x_Symbol] :=
2934  If[AtomQ[u],
2935    u=!=x,
2936  If[CalculusQ[u],
2937    False,
2938  If[TrigQ[u] && IntegerQuotientQ[u[[1]],v],
2939    True,
2940  Catch[
2941    Scan[Function[If[Not[FunctionOfTrigQ[#,v,x]],Throw[False]]],u];
2942    True]]]]
2943
2944
2945(* If u is a pure function of Sinh[v] and/or Csch[v], PureFunctionOfSinhQ[u,v,x] returns True;
2946	else it returns False. *)
2947PureFunctionOfSinhQ[u_,v_,x_] :=
2948  If[AtomQ[u],
2949    u=!=x,
2950  If[CalculusQ[u],
2951    False,
2952  If[HyperbolicQ[u] && ZeroQ[u[[1]]-v],
2953    SinhQ[u] || CschQ[u],
2954  Catch[Scan[Function[If[Not[PureFunctionOfSinhQ[#,v,x]],Throw[False]]],u];True]]]]
2955
2956
2957(* If u is a pure function of Cosh[v] and/or Sech[v], PureFunctionOfCoshQ[u,v,x] returns True;
2958	else it returns False. *)
2959PureFunctionOfCoshQ[u_,v_,x_] :=
2960  If[AtomQ[u],
2961    u=!=x,
2962  If[CalculusQ[u],
2963    False,
2964  If[HyperbolicQ[u] && ZeroQ[u[[1]]-v],
2965    CoshQ[u] || SechQ[u],
2966  Catch[Scan[Function[If[Not[PureFunctionOfCoshQ[#,v,x]],Throw[False]]],u];True]]]]
2967
2968
2969(* If u is a pure function of Tanh[v] and/or Coth[v], PureFunctionOfTanhQ[u,v,x] returns True;
2970	else it returns False. *)
2971PureFunctionOfTanhQ[u_,v_,x_] :=
2972  If[AtomQ[u],
2973    u=!=x,
2974  If[CalculusQ[u],
2975    False,
2976  If[HyperbolicQ[u] && ZeroQ[u[[1]]-v],
2977    TanhQ[u] || CothQ[u],
2978  Catch[Scan[Function[If[Not[PureFunctionOfTanhQ[#,v,x]],Throw[False]]],u];True]]]]
2979
2980
2981(* If u is a pure function of Coth[v], PureFunctionOfCothQ[u,v,x] returns True;
2982	else it returns False. *)
2983PureFunctionOfCothQ[u_,v_,x_] :=
2984  If[AtomQ[u],
2985    u=!=x,
2986  If[CalculusQ[u],
2987    False,
2988  If[HyperbolicQ[u] && ZeroQ[u[[1]]-v],
2989    CothQ[u],
2990  Catch[Scan[Function[If[Not[PureFunctionOfCothQ[#,v,x]],Throw[False]]],u];True]]]]
2991
2992
2993(* If u is a function of Sinh[v], FunctionOfSinhQ[u,v,x] returns True; else it returns False. *)
2994FunctionOfSinhQ[u_,v_,x_] :=
2995  If[AtomQ[u],
2996    u=!=x,
2997  If[CalculusQ[u],
2998    False,
2999  If[HyperbolicQ[u] && IntegerQuotientQ[u[[1]],v],
3000    If[OddQuotientQ[u[[1]],v],
3001(* Basis: If m odd, Sinh[m*v]^n is a function of Sinh[v]. *)
3002      SinhQ[u] || CschQ[u],
3003(* Basis: If m even, Cos[m*v]^n is a function of Sinh[v]. *)
3004    CoshQ[u] || SechQ[u]],
3005  If[IntegerPowerQ[u] && HyperbolicQ[u[[1]]] && IntegerQuotientQ[u[[1,1]],v],
3006    If[EvenQ[u[[2]]],
3007(* Basis: If m integer and n even, Hyper[m*v]^n is a function of Sinh[v]. *)
3008      True,
3009    FunctionOfSinhQ[u[[1]],v,x]],
3010  If[ProductQ[u],
3011    If[CoshQ[u[[1]]] && SinhQ[u[[2]]] && ZeroQ[u[[1,1]]-v/2] && ZeroQ[u[[2,1]]-v/2],
3012      FunctionOfSinhQ[Drop[u,2],v,x],
3013    Module[{lst},
3014    lst=FindTrigFactor[Sinh,Csch,u,v,False];
3015    If[NotFalseQ[lst] && EvenQuotientQ[lst[[1]],v],
3016(* Basis: If m even and n odd, Sinh[m*v]^n == Cosh[v]*u where u is a function of Sinh[v]. *)
3017      FunctionOfSinhQ[Cosh[v]*lst[[2]],v,x],
3018    lst=FindTrigFactor[Cosh,Sech,u,v,False];
3019    If[NotFalseQ[lst] && OddQuotientQ[lst[[1]],v],
3020(* Basis: If m odd and n odd, Cosh[m*v]^n == Cosh[v]*u where u is a function of Sinh[v]. *)
3021      FunctionOfSinhQ[Cosh[v]*lst[[2]],v,x],
3022    lst=FindTrigFactor[Tanh,Coth,u,v,True];
3023    If[NotFalseQ[lst],
3024(* Basis: If m integer and n odd, Tanh[m*v]^n == Cosh[v]*u where u is a function of Sinh[v]. *)
3025      FunctionOfSinhQ[Cosh[v]*lst[[2]],v,x],
3026    Catch[Scan[Function[If[Not[FunctionOfSinhQ[#,v,x]],Throw[False]]],u];True]]]]]],
3027  Catch[Scan[Function[If[Not[FunctionOfSinhQ[#,v,x]],Throw[False]]],u];True]]]]]]
3028
3029
3030(* If u is a function of Cosh[v], FunctionOfCoshQ[u,v,x] returns True; else it returns False. *)
3031FunctionOfCoshQ[u_,v_,x_] :=
3032  If[AtomQ[u],
3033    u=!=x,
3034  If[CalculusQ[u],
3035    False,
3036  If[HyperbolicQ[u] && IntegerQuotientQ[u[[1]],v],
3037(* Basis: If m integer, Cosh[m*v]^n is a function of Cosh[v]. *)
3038    CoshQ[u] || SechQ[u],
3039  If[IntegerPowerQ[u] && HyperbolicQ[u[[1]]] && IntegerQuotientQ[u[[1,1]],v],
3040    If[EvenQ[u[[2]]],
3041(* Basis: If m integer and n even, Hyper[m*v]^n is a function of Cosh[v]. *)
3042      True,
3043    FunctionOfCoshQ[u[[1]],v,x]],
3044  If[ProductQ[u],
3045    Module[{lst},
3046    lst=FindTrigFactor[Sinh,Csch,u,v,False];
3047    If[NotFalseQ[lst],
3048(* Basis: If m integer and n odd, Sinh[m*v]^n == Sinh[v]*u where u is a function of Cosh[v]. *)
3049      FunctionOfCoshQ[Sinh[v]*lst[[2]],v,x],
3050    lst=FindTrigFactor[Tanh,Coth,u,v,True];
3051    If[NotFalseQ[lst],
3052(* Basis: If m integer and n odd, Tanh[m*v]^n == Sinh[v]*u where u is a function of Cosh[v]. *)
3053      FunctionOfCoshQ[Sinh[v]*lst[[2]],v,x],
3054    Catch[Scan[Function[If[Not[FunctionOfCoshQ[#,v,x]],Throw[False]]],u];True]]]],
3055  Catch[Scan[Function[If[Not[FunctionOfCoshQ[#,v,x]],Throw[False]]],u];True]]]]]]
3056
3057
3058(* If u is a function of the form f[Tanh[v],Coth[v]] where f is independent of x,
3059	FunctionOfTanhQ[u,v,x] returns True; else it returns False. *)
3060FunctionOfTanhQ[u_,v_,x_] :=
3061  If[AtomQ[u],
3062    u=!=x,
3063  If[CalculusQ[u],
3064    False,
3065  If[HyperbolicQ[u] && IntegerQuotientQ[u[[1]],v],
3066    TanhQ[u] || CothQ[u] || EvenQuotientQ[u[[1]],v],
3067  If[PowerQ[u] && EvenQ[u[[2]]] && HyperbolicQ[u[[1]]] && IntegerQuotientQ[u[[1,1]],v],
3068    True,
3069  If[ProductQ[u],
3070    Module[{lst=ReapList[Scan[Function[If[Not[FunctionOfTanhQ[#,v,x]],Sow[#]]],u]]},
3071    If[lst==={},
3072      True,
3073    Length[lst]==2 && OddHyperbolicPowerQ[lst[[1]],v,x] && OddHyperbolicPowerQ[lst[[2]],v,x]]],
3074  Catch[Scan[Function[If[Not[FunctionOfTanhQ[#,v,x]],Throw[False]]],u];True]]]]]]
3075
3076OddHyperbolicPowerQ[u_,v_,x_] :=
3077  If[SinhQ[u] || CoshQ[u] || SechQ[u] || CschQ[u],
3078    OddQuotientQ[u[[1]],v],
3079  If[PowerQ[u],
3080    OddQ[u[[2]]] && OddHyperbolicPowerQ[u[[1]],v,x],
3081  If[ProductQ[u],
3082    Module[{lst=ReapList[Scan[Function[If[Not[FunctionOfTanhQ[#,v,x]],Sow[#]]],u]]},
3083    If[lst==={},
3084      True,
3085    Length[lst]==1 && OddHyperbolicPowerQ[lst[[1]],v,x]]],
3086(*If[SumQ[u],
3087    Catch[Scan[Function[If[Not[OddHyperbolicPowerQ[#,v,x]],Throw[False]]],u];True], *)
3088  False]]]
3089
3090
3091(* u is a function of the form f[Tanh[v],Coth[v]] where f is independent of x.
3092FunctionOfTanhWeight[u,v,x] returns a nonnegative number if u is best considered a function
3093of Tanh[v]; else it returns a negative number. *)
3094FunctionOfTanhWeight[u_,v_,x_] :=
3095  If[AtomQ[u],
3096    0,
3097  If[CalculusQ[u],
3098    0,
3099  If[HyperbolicQ[u] && IntegerQuotientQ[u[[1]],v],
3100    If[TanhQ[u] && ZeroQ[u[[1]]-v],
3101      1,
3102    If[CothQ[u] && ZeroQ[u[[1]]-v],
3103      -1,
3104    0]],
3105  If[PowerQ[u] && EvenQ[u[[2]]] && HyperbolicQ[u[[1]]] && IntegerQuotientQ[u[[1,1]],v],
3106    If[TanhQ[u[[1]]] || CoshQ[u[[1]]] || SechQ[u[[1]]],
3107      1,
3108    -1],
3109  If[ProductQ[u],
3110    If[Catch[Scan[Function[If[Not[FunctionOfTanhQ[#,v,x]],Throw[False]]],u];True],
3111      Apply[Plus,Map[Function[FunctionOfTanhWeight[#,v,x]],Apply[List,u]]],
3112    0],
3113  Apply[Plus,Map[Function[FunctionOfTanhWeight[#,v,x]],Apply[List,u]]]]]]]]
3114
3115
3116(* If u (x) is equivalent to a function of the form f (Sinh[v],Cosh[v],Tanh[v],Coth[v],Sech[v],Csch[v])
3117	where f is independent of x, FunctionOfHyperbolicQ[u,v,x] returns True; else it returns False. *)
3118FunctionOfHyperbolicQ[u_,v_,x_Symbol] :=
3119  If[AtomQ[u],
3120    u=!=x,
3121  If[CalculusQ[u],
3122    False,
3123  If[HyperbolicQ[u] && IntegerQuotientQ[u[[1]],v],
3124    True,
3125  Catch[Scan[Function[If[FunctionOfHyperbolicQ[#,v,x],Null,Throw[False]]],u];True]]]]
3126
3127
3128(* If u/v is an integer, IntegerQuotientQ[u,v] returns True; else it returns False. *)
3129IntegerQuotientQ[u_,v_] :=
3130  u===v || ZeroQ[u-v] || IntegerQ[u/v]
3131
3132(* If u/v is odd, OddQuotientQ[u,v] returns True; else it returns False. *)
3133OddQuotientQ[u_,v_] :=
3134  u===v || ZeroQ[u-v] || OddQ[u/v]
3135
3136(* If u/v is even, EvenQuotientQ[u,v] returns True; else it returns False. *)
3137EvenQuotientQ[u_,v_] :=
3138  EvenQ[u/v]
3139
3140
3141(* If all occurrences of x in u (x) are in dense polynomials, FunctionOfDensePolynomialsQ[u,x]
3142	returns True; else it returns False. *)
3143FunctionOfDensePolynomialsQ[u_,x_Symbol] :=
3144  If[FreeQ[u,x],
3145    True,
3146  If[PolynomialQ[u,x],
3147    Length[Exponent[u,x,List]]>1,
3148  Catch[
3149  Scan[Function[If[FunctionOfDensePolynomialsQ[#,x],Null,Throw[False]]],u];
3150  True]]]
3151
3152
3153(* If u (x) is equivalent to an expression of the form f (Log[a*x^n]), FunctionOfLog[u,x] returns
3154	the list {f (x),a*x^n,n}; else it returns False. *)
3155FunctionOfLog[u_,x_Symbol] :=
3156  Module[{lst=FunctionOfLog[u,False,False,x]},
3157  If[FalseQ[lst] || FalseQ[lst[[2]]],
3158    False,
3159  lst]]
3160
3161
3162FunctionOfLog[u_,v_,n_,x_] :=
3163  If[AtomQ[u],
3164    If[u===x,
3165      False,
3166    {u,v,n}],
3167  If[CalculusQ[u],
3168    False,
3169  Module[{lst},
3170  If[LogQ[u] && NotFalseQ[lst=BinomialTest[u[[1]],x]] && ZeroQ[lst[[1]]],
3171    If[FalseQ[v] || u[[1]]===v,
3172      {x,u[[1]],lst[[3]]},
3173    False],
3174  lst={0,v,n};
3175  Catch[
3176    {Map[Function[lst=FunctionOfLog[#,lst[[2]],lst[[3]],x];
3177				  If[FalseQ[lst],Throw[False],lst[[1]]]],
3178			u],lst[[2]],lst[[3]]}]]]]]
3179
3180
3181(* If m is an integer, u is an expression of the form f[(c*x)^n] and g=GCD[m,n]>1,
3182   PowerVariableExpn[u,m,x] returns the list {x^(m/g)*f[(c*x)^(n/g)],g,c}; else it returns False. *)
3183PowerVariableExpn[u_,m_,x_Symbol] :=
3184  If[IntegerQ[m],
3185    Module[{lst=PowerVariableDegree[u,m,1,x]},
3186    If[FalseQ[lst],
3187      False,
3188    {x^(m/lst[[1]])*PowerVariableSubst[u,lst[[1]],x], lst[[1]], lst[[2]]}]],
3189  False]
3190
3191
3192PowerVariableDegree[u_,m_,c_,x_Symbol] :=
3193  If[FreeQ[u,x],
3194    {m, c},
3195  If[AtomQ[u] || CalculusQ[u],
3196    False,
3197  If[PowerQ[u] && FreeQ[u[[1]]/x,x],
3198    If[ZeroQ[m] || m===u[[2]] && c===u[[1]]/x,
3199      {u[[2]], u[[1]]/x},
3200    If[IntegerQ[u[[2]]] && IntegerQ[m] && GCD[m,u[[2]]]>1 && c===u[[1]]/x,
3201      {GCD[m,u[[2]]], c},
3202    False]],
3203  Catch[Module[{lst={m, c}},
3204  Scan[Function[lst=PowerVariableDegree[#,lst[[1]],lst[[2]],x];If[FalseQ[lst],Throw[False]]],u];
3205  lst]]]]]
3206
3207
3208PowerVariableSubst[u_,m_,x_Symbol] :=
3209  If[FreeQ[u,x] || AtomQ[u] ||CalculusQ[u],
3210    u,
3211  If[PowerQ[u] && FreeQ[u[[1]]/x,x],
3212    x^(u[[2]]/m),
3213  Map[Function[PowerVariableSubst[#,m,x]],u]]]
3214
3215
3216(*
3217Euler substitution #2:
3218  If u is an expression of the form f (Sqrt[a+b*x+c*x^2],x), f (x,x) is a rational function, and
3219	PosQ[c], FunctionOfSquareRootOfQuadratic[u,x] returns the 3-element list {
3220		f ((a*Sqrt[c]+b*x+Sqrt[c]*x^2)/(b+2*Sqrt[c]*x),(-a+x^2)/(b+2*Sqrt[c]*x))*
3221		  (a*Sqrt[c]+b*x+Sqrt[c]*x^2)/(b+2*Sqrt[c]*x)^2,
3222		Sqrt[c]*x+Sqrt[a+b*x+c*x^2], 2 };
3223
3224Euler substitution #1:
3225  If u is an expression of the form f (Sqrt[a+b*x+c*x^2],x), f (x,x) is a rational function, and
3226	PosQ[a], FunctionOfSquareRootOfQuadratic[u,x] returns the two element list {
3227		f ((c*Sqrt[a]-b*x+Sqrt[a]*x^2)/(c-x^2),(-b+2*Sqrt[a]*x)/(c-x^2))*
3228		  (c*Sqrt[a]-b*x+Sqrt[a]*x^2)/(c-x^2)^2,
3229		(-Sqrt[a]+Sqrt[a+b*x+c*x^2])/x, 1 };
3230
3231Euler substitution #3:
3232  If u is an expression of the form f (Sqrt[a+b*x+c*x^2],x), f (x,x) is a rational function, and
3233	NegQ[a] and NegQ[c], FunctionOfSquareRootOfQuadratic[u,x] returns the two element list {
3234		-Sqrt[b^2-4*a*c]*
3235		f (-Sqrt[b^2-4*a*c]*x/(c-x^2),-(b*c+c*Sqrt[b^2-4*a*c]+(-b+Sqrt[b^2-4*a*c])*x^2)/(2*c*(c-x^2)))*
3236		  x/(c-x^2)^2,
3237		2*c*Sqrt[a+b*x+c*x^2]/(b-Sqrt[b^2-4*a*c]+2*c*x), 3 };
3238
3239  else it returns False. *)
3240
3241FunctionOfSquareRootOfQuadratic[u_,x_Symbol] :=
3242  If[MatchQ[u,x^m_.*(a_+b_.*x^n_.)^p_ /; FreeQ[{a,b,m,n,p},x]],
3243    False,
3244  Module[{tmp=FunctionOfSquareRootOfQuadratic[u,False,x]},
3245  If[FalseQ[tmp] || FalseQ[tmp[[1]]],
3246    False,
3247  tmp=tmp[[1]];
3248  Module[{a=Coefficient[tmp,x,0],b=Coefficient[tmp,x,1],c=Coefficient[tmp,x,2],sqrt,q,r},
3249  If[ZeroQ[a] && ZeroQ[b] || ZeroQ[b^2-4*a*c],
3250    False,
3251  If[PosQ[c],
3252    sqrt=Rt[c,2];
3253    q=a*sqrt+b*x+sqrt*x^2;
3254    r=b+2*sqrt*x;
3255    {Simplify[SquareRootOfQuadraticSubst[u,q/r,(-a+x^2)/r,x]*q/r^2],
3256     Simplify[sqrt*x+Sqrt[tmp]],
3257     2},
3258  If[PosQ[a],
3259    sqrt=Rt[a,2];
3260    q=c*sqrt-b*x+sqrt*x^2;
3261    r=c-x^2;
3262    {Simplify[SquareRootOfQuadraticSubst[u,q/r,(-b+2*sqrt*x)/r,x]*q/r^2],
3263     Simplify[(-sqrt+Sqrt[tmp])/x],
3264     1},
3265  sqrt=Rt[b^2-4*a*c,2];
3266  r=c-x^2;
3267  {Simplify[-sqrt*SquareRootOfQuadraticSubst[u,-sqrt*x/r,-(b*c+c*sqrt+(-b+sqrt)*x^2)/(2*c*r),x]*x/r^2],
3268   FullSimplify[2*c*Sqrt[tmp]/(b-sqrt+2*c*x)],
3269   3}]]]]]]]
3270
3271
3272FunctionOfSquareRootOfQuadratic[u_,v_,x_Symbol] :=
3273  If[AtomQ[u] || FreeQ[u,x],
3274    {v},
3275  If[PowerQ[u] && FreeQ[u[[2]],x],
3276    If[FractionQ[u[[2]]] && Denominator[u[[2]]]==2 && PolynomialQ[u[[1]],x] && Exponent[u[[1]],x]==2,
3277      If[(FalseQ[v] || u[[1]]===v),
3278        {u[[1]]},
3279      False],
3280    FunctionOfSquareRootOfQuadratic[u[[1]],v,x]],
3281  If[ProductQ[u] || SumQ[u],
3282    Catch[Module[{lst={v}},
3283    Scan[Function[lst=FunctionOfSquareRootOfQuadratic[#,lst[[1]],x];If[FalseQ[lst],Throw[False]]],u];
3284    lst]],
3285  False]]]
3286
3287
3288(* SquareRootOfQuadraticSubst[u,vv,xx,x] returns u with fractional powers replaced by vv raised
3289	to the power and x replaced by xx. *)
3290SquareRootOfQuadraticSubst[u_,vv_,xx_,x_Symbol] :=
3291  If[AtomQ[u] || FreeQ[u,x],
3292    If[u===x,
3293      xx,
3294    u],
3295  If[PowerQ[u] && FreeQ[u[[2]],x],
3296    If[FractionQ[u[[2]]] && Denominator[u[[2]]]==2 && PolynomialQ[u[[1]],x] && Exponent[u[[1]],x]==2,
3297      vv^Numerator[u[[2]]],
3298    SquareRootOfQuadraticSubst[u[[1]],vv,xx,x]^u[[2]]],
3299  Map[Function[SquareRootOfQuadraticSubst[#,vv,xx,x]],u]]]
3300
3301
3302NormalizeSubst[u_,x_Symbol,w_] :=
3303  NormalizeIntegrand[Subst[u,x,w],x]
3304
3305
3306Subst[u_,x_,w_] :=
3307  SubstAux[u,x,w]
3308(*Module[{v=SubstAux[u,x,w]},
3309  If[SumQ[v],
3310    Map[Function[If[FreeQ[#,Int],SimplifyIntegrand[#,x],#]],v],
3311  If[FreeQ[v,Int],SimplifyIntegrand[v,x],v]]] *)
3312
3313
3314(* Subst[u,v,w] returns u with all nondummy occurences of v replaced by w *)
3315SubstAux[u_,v_,w_] :=
3316  If[u===v,
3317    w,
3318  If[AtomQ[u],
3319    u,
3320  If[PowerQ[u],
3321    If[PowerQ[v] && u[[1]]===v[[1]] && SumQ[u[[2]]],
3322      SubstAux[u[[1]]^First[u[[2]]],v,w]*SubstAux[u[[1]]^Rest[u[[2]]],v,w],
3323    SubstAux[u[[1]],v,w]^SubstAux[u[[2]],v,w]],
3324  If[Head[u]===Defer[Subst],
3325    If[u[[2]]===v || FreeQ[u[[1]],v],
3326      SubstAux[u[[1]],u[[2]],SubstAux[u[[3]],v,w]],
3327    Defer[Subst][u,v,w]],
3328  If[CalculusQ[u] && Not[FreeQ[v,u[[2]]]] || HeldFormQ[u],
3329    Defer[Subst][u,v,w],
3330  If[Head[u]===Dist,
3331    Dist[SubstAux[u[[1]],v,w],SubstAux[u[[2]],v,w],u[[3]]],
3332  Map[Function[SubstAux[#,v,w]],u]]]]]]]
3333
3334
3335(* u is a function v.  SubstFor[v,u,x] returns f (x). *)
3336SubstFor[v_,u_,x_] :=
3337  If[AtomQ[v],
3338    Subst[u,v,x],
3339  If[PowerQ[v] && FreeQ[v[[2]],x] (* && NonzeroQ[v[[2]]+1] *),
3340    SubstForPower[u,v[[1]],v[[2]],x],
3341
3342  If[SinQ[v],
3343    SubstForTrig[u,x,Sqrt[1-x^2],v[[1]],x],
3344  If[CosQ[v],
3345    SubstForTrig[u,Sqrt[1-x^2],x,v[[1]],x],
3346  If[TanQ[v],
3347    SubstForTrig[u,x/Sqrt[1+x^2],1/Sqrt[1+x^2],v[[1]],x],
3348  If[CotQ[v],
3349    SubstForTrig[u,1/Sqrt[1+x^2],x/Sqrt[1+x^2],v[[1]],x],
3350  If[SecQ[v],
3351    SubstForTrig[u,1/Sqrt[1-x^2],1/x,v[[1]],x],
3352  If[CscQ[v],
3353    SubstForTrig[u,1/x,1/Sqrt[1-x^2],v[[1]],x],
3354
3355  If[SinhQ[v],
3356    SubstForHyperbolic[u,x,Sqrt[1+x^2],v[[1]],x],
3357  If[CoshQ[v],
3358    SubstForHyperbolic[u,Sqrt[-1+x^2],x,v[[1]],x],
3359  If[TanhQ[v],
3360    SubstForHyperbolic[u,x/Sqrt[1-x^2],1/Sqrt[1-x^2],v[[1]],x],
3361  If[CothQ[v],
3362    SubstForHyperbolic[u,1/Sqrt[-1+x^2],x/Sqrt[-1+x^2],v[[1]],x],
3363  If[SechQ[v],
3364    SubstForHyperbolic[u,1/Sqrt[-1+x^2],1/x,v[[1]],x],
3365  If[CschQ[v],
3366    SubstForHyperbolic[u,1/x,1/Sqrt[1+x^2],v[[1]],x],
3367
3368  SubstForExpn[u,v,x]]]]]]]]]]]]]]]
3369
3370
3371SubstForExpn[u_,v_,w_] :=
3372  If[u===v,
3373    w,
3374  If[AtomQ[u],
3375    u,
3376  Map[Function[SubstForExpn[#,v,w]],u]]]
3377
3378
3379SubstForPower[u_,bas_,deg_,x_] :=
3380  If[AtomQ[u],
3381    u,
3382  If[PowerQ[u] && ZeroQ[u[[1]]-bas] && FreeQ[u[[2]],x] && IntegerQ[Simplify[u[[2]]/deg]]
3383		(* && (u[[2]]/deg>0 || FractionQ[deg]) *),
3384    x^(u[[2]]/deg),
3385  Map[Function[SubstForPower[#,bas,deg,x]],u]]]
3386
3387
3388(* u (v) is an expression of the form f (Sin[v],Cos[v],Tan[v],Cot[v],Sec[v],Csc[v]). *)
3389(* SubstForTrig[u,sin,cos,v,x] returns the expression f (sin,cos,sin/cos,cos/sin,1/cos,1/sin). *)
3390SubstForTrig[u_,sin_,cos_,v_,x_] :=
3391  If[AtomQ[u],
3392    u,
3393  If[TrigQ[u] && IntegerQuotientQ[u[[1]],v],
3394    If[u[[1]]===v || ZeroQ[u[[1]]-v],
3395      If[SinQ[u],
3396        sin,
3397      If[CosQ[u],
3398        cos,
3399      If[TanQ[u],
3400        sin/cos,
3401      If[CotQ[u],
3402        cos/sin,
3403      If[SecQ[u],
3404        1/cos,
3405      1/sin]]]]],
3406    Map[Function[SubstForTrig[#,sin,cos,v,x]],
3407			ReplaceAll[TrigExpand[Head[u][u[[1]]/v*x]],x->v]]],
3408  If[ProductQ[u] && CosQ[u[[1]]] && SinQ[u[[2]]] && ZeroQ[u[[1,1]]-v/2] && ZeroQ[u[[2,1]]-v/2],
3409    sin/2*SubstForTrig[Drop[u,2],sin,cos,v,x],
3410  Map[Function[SubstForTrig[#,sin,cos,v,x]],u]]]]
3411
3412
3413(* u (v) is an expression of the form f (Sinh[v],Cosh[v],Tanh[v],Coth[v],Sech[v],Csch[v]). *)
3414(* SubstForHyperbolic[u,sinh,cosh,v,x] returns the expression
3415		f (sinh,cosh,sinh/cosh,cosh/sinh,1/cosh,1/sinh). *)
3416SubstForHyperbolic[u_,sinh_,cosh_,v_,x_] :=
3417  If[AtomQ[u],
3418    u,
3419  If[HyperbolicQ[u] && IntegerQuotientQ[u[[1]],v],
3420    If[u[[1]]===v || ZeroQ[u[[1]]-v],
3421      If[SinhQ[u],
3422        sinh,
3423      If[CoshQ[u],
3424        cosh,
3425      If[TanhQ[u],
3426        sinh/cosh,
3427      If[CothQ[u],
3428        cosh/sinh,
3429      If[SechQ[u],
3430        1/cosh,
3431      1/sinh]]]]],
3432    Map[Function[SubstForHyperbolic[#,sinh,cosh,v,x]],
3433			ReplaceAll[TrigExpand[Head[u][u[[1]]/v*x]],x->v]]],
3434  If[ProductQ[u] && CoshQ[u[[1]]] && SinhQ[u[[2]]] && ZeroQ[u[[1,1]]-v/2] && ZeroQ[u[[2,1]]-v/2],
3435    sinh/2*SubstForHyperbolic[Drop[u,2],sinh,cosh,v,x],
3436  Map[Function[SubstForHyperbolic[#,sinh,cosh,v,x]],u]]]]
3437
3438
3439(* If u has a subexpression of the form (a+b*x)^(m/n) where m and n>1 are integers,
3440	SubstForFractionalPowerOfLinear[u,x] returns the list {v,n,a+b*x,1/b} where v is u
3441	with subexpressions of the form (a+b*x)^(m/n) replaced by x^m and x replaced
3442	by -a/b+x^n/b, and all times x^(n-1); else it returns False. *)
3443SubstForFractionalPowerOfLinear[u_,x_Symbol] :=
3444  Module[{lst=FractionalPowerOfLinear[u,1,False,x],n,a,b,tmp},
3445  If[FalseQ[lst] || FalseQ[lst[[2]]],
3446    False,
3447  n=lst[[1]];
3448  a=Coefficient[lst[[2]],x,0];
3449  b=Coefficient[lst[[2]],x,1];
3450  tmp=x^(n-1)*SubstForFractionalPower[u,lst[[2]],n,-a/b+x^n/b,x];
3451  tmp=SplitFreeFactors[Simplify[tmp],x];
3452  {tmp[[2]],n,lst[[2]],tmp[[1]]/b}]]
3453
3454
3455(* If u has a subexpression of the form (a+b*x)^(m/n),
3456	FractionalPowerOfLinear[u,1,False,x] returns {n,a+b*x}; else it returns False. *)
3457FractionalPowerOfLinear[u_,n_,v_,x_] :=
3458  If[AtomQ[u] || FreeQ[u,x],
3459    {n,v},
3460  If[CalculusQ[u],
3461    False,
3462  If[FractionalPowerQ[u] && LinearQ[u[[1]],x] && (FalseQ[v] || ZeroQ[u[[1]]-v]),
3463    {LCM[Denominator[u[[2]]],n],u[[1]]},
3464  Catch[Module[{lst={n,v}},
3465    Scan[Function[If[FalseQ[lst=FractionalPowerOfLinear[#,lst[[1]],lst[[2]],x]],Throw[False]]],u];
3466    lst]]]]]
3467
3468
3469(* If u has a subexpression of the form ((a+b*x)/(c+d*x))^(m/n) where m and n>1 are integers,
3470	SubstForFractionalPowerOfQuotientOfLinears[u,x] returns the list {v,n,(a+b*x)/(c+d*x),b*c-a*d} where v is u
3471	with subexpressions of the form ((a+b*x)/(c+d*x))^(m/n) replaced by x^m and x replaced
3472	by (-a+c*x^n)/(b-d*x^n), and all times x^(n-1)/(b-d*x^n)^2; else it returns False. *)
3473SubstForFractionalPowerOfQuotientOfLinears[u_,x_Symbol] :=
3474  Module[{lst=FractionalPowerOfQuotientOfLinears[u,1,False,x],n,a,b,c,d,tmp},
3475  If[FalseQ[lst] || FalseQ[lst[[2]]],
3476    False,
3477  n=lst[[1]];
3478  tmp=lst[[2]];
3479  lst=QuotientOfLinearsParts[tmp,x];
3480  a=lst[[1]];
3481  b=lst[[2]];
3482  c=lst[[3]];
3483  d=lst[[4]];
3484  If[ZeroQ[d],
3485    False,
3486  lst=x^(n-1)*SubstForFractionalPower[u,tmp,n,(-a+c*x^n)/(b-d*x^n),x]/(b-d*x^n)^2;
3487  lst=SplitFreeFactors[Simplify[lst],x];
3488  {lst[[2]],n,tmp,lst[[1]]*(b*c-a*d)}]]]
3489
3490
3491(* If the substitution x=v^(1/n) will not complicate algebraic subexpressions of u,
3492	SubstForFractionalPowerQ[u,v,x] returns True; else it returns False. *)
3493SubstForFractionalPowerQ[u_,v_,x_Symbol] :=
3494  If[AtomQ[u] || FreeQ[u,x],
3495    True,
3496  If[FractionalPowerQ[u],
3497    SubstForFractionalPowerAuxQ[u,v,x],
3498  Catch[Scan[Function[If[Not[SubstForFractionalPowerQ[#,v,x]],Throw[False]]],u];True]]]
3499
3500SubstForFractionalPowerAuxQ[u_,v_,x_] :=
3501  If[AtomQ[u],
3502    False,
3503  If[FractionalPowerQ[u] && ZeroQ[u[[1]]-v],
3504    True,
3505  Catch[Scan[Function[If[SubstForFractionalPowerAuxQ[#,v,x],Throw[True]]],u];False]]]
3506
3507
3508(* If u has a subexpression of the form ((a+b*x)/(c+d*x))^(m/n),
3509	FractionalPowerOfQuotientOfLinears[u,1,False,x] returns {n,(a+b*x)/(c+d*x)}; else it returns False. *)
3510FractionalPowerOfQuotientOfLinears[u_,n_,v_,x_] :=
3511  If[AtomQ[u] || FreeQ[u,x],
3512    {n,v},
3513  If[CalculusQ[u],
3514    False,
3515  If[FractionalPowerQ[u] && QuotientOfLinearsQ[u[[1]],x] && Not[LinearQ[u[[1]],x]] && (FalseQ[v] || ZeroQ[u[[1]]-v]),
3516    {LCM[Denominator[u[[2]]],n],u[[1]]},
3517  Catch[Module[{lst={n,v}},
3518    Scan[Function[If[FalseQ[lst=FractionalPowerOfQuotientOfLinears[#,lst[[1]],lst[[2]],x]],Throw[False]]],u];
3519    lst]]]]]
3520
3521
3522(* If u has a subexpression of the form g[a+b*x] where g is the inverse of the function h
3523	(i.e. h[g[x]] == x) and f[x,g[a+b*x]] equals u, SubstForInverseFunctionOfLinear[u,x] returns
3524	the list {f[-a/b+h[x]/b,x]*h'[x], g[a+b*x], b} *)
3525SubstForInverseFunctionOfLinear[u_,x_Symbol] :=
3526  Module[{tmp=InverseFunctionOfLinear[u,x],h,a,b},
3527  If[FalseQ[tmp],
3528    False,
3529  h=InverseFunction[Head[tmp]];
3530  a=Coefficient[tmp[[1]],x,0];
3531  b=Coefficient[tmp[[1]],x,1];
3532  {SubstForInverseFunction[u,tmp,-a/b+h[x]/b,x]*D[h[x],x], tmp, b}]]
3533
3534
3535(* If u has a subexpression of the form g[a+b*x] where g is an inverse function,
3536	InverseFunctionOfLinear[u,x] returns g[a+b*x]; else it returns False. *)
3537InverseFunctionOfLinear[u_,x_Symbol] :=
3538  If[AtomQ[u] || CalculusQ[u] || FreeQ[u,x],
3539    False,
3540  If[InverseFunctionQ[u] && LinearQ[u[[1]],x],
3541    u,
3542  Module[{tmp},
3543  Catch[
3544    Scan[Function[If[NotFalseQ[tmp=InverseFunctionOfLinear[#,x]],Throw[tmp]]],u];
3545    False]]]]
3546
3547
3548(* If u has a subexpression of the form g[(a+b*x)/(c+d*x)] where g is the inverse of function h
3549	and f[x,g[(a+b*x)/(c+d*x)]] equals u, SubstForInverseFunctionOfQuotientOfLinears[u,x] returns
3550	the list {f[(-a+c*h[x])/(b-d*h[x]),x]*h'[x]/(b-d*h[x])^2, g[(a+b*x)/(c+d*x)], b*c-a*d} *)
3551SubstForInverseFunctionOfQuotientOfLinears[u_,x_Symbol] :=
3552  Module[{tmp=InverseFunctionOfQuotientOfLinears[u,x],h,a,b,c,d,lst},
3553  If[FalseQ[tmp],
3554    False,
3555  h=InverseFunction[Head[tmp]];
3556  lst=QuotientOfLinearsParts[tmp[[1]],x];
3557  a=lst[[1]];
3558  b=lst[[2]];
3559  c=lst[[3]];
3560  d=lst[[4]];
3561  {SubstForInverseFunction[u,tmp,(-a+c*h[x])/(b-d*h[x]),x]*D[h[x],x]/(b-d*h[x])^2, tmp, b*c-a*d}]]
3562
3563
3564(* If u has a subexpression of the form g[(a+b*x)/(c+d*x)] where g is an inverse function,
3565	InverseFunctionOfQuotientOfLinears[u,x] returns g[(a+b*x)/(c+d*x)]; else it returns False. *)
3566InverseFunctionOfQuotientOfLinears[u_,x_Symbol] :=
3567  If[AtomQ[u] || CalculusQ[u] || FreeQ[u,x],
3568    False,
3569  If[InverseFunctionQ[u] && QuotientOfLinearsQ[u[[1]],x],
3570    u,
3571  Module[{tmp},
3572  Catch[
3573    Scan[Function[If[NotFalseQ[tmp=InverseFunctionOfQuotientOfLinears[#,x]],Throw[tmp]]],u];
3574    False]]]]
3575
3576
3577(* SubstForFractionalPower[u,v,n,w,x] returns u with subexpressions equal to v^(m/n) replaced
3578	by x^m and x replaced by w. *)
3579SubstForFractionalPower[u_,v_,n_,w_,x_Symbol] :=
3580  If[AtomQ[u],
3581    If[u===x,
3582      w,
3583    u],
3584  If[FractionalPowerQ[u] && ZeroQ[u[[1]]-v],
3585    x^(n*u[[2]]),
3586  Map[Function[SubstForFractionalPower[#,v,n,w,x]],u]]]
3587
3588
3589(* SubstForInverseFunction[u,v,w,x] returns u with subexpressions equal to v replaced by x
3590	and x replaced by w. *)
3591SubstForInverseFunction[u_,v_,x_Symbol] :=
3592(*  Module[{a=Coefficient[v[[1]],0],b=Coefficient[v[[1]],1]},
3593  SubstForInverseFunction[u,v,-a/b+InverseFunction[Head[v]]/b,x]] *)
3594  SubstForInverseFunction[u,v,
3595		(-Coefficient[v[[1]],x,0]+InverseFunction[Head[v]][x])/Coefficient[v[[1]],x,1],x]
3596
3597SubstForInverseFunction[u_,v_,w_,x_Symbol] :=
3598  If[AtomQ[u],
3599    If[u===x,
3600      w,
3601    u],
3602  If[Head[u]===Head[v] && ZeroQ[u[[1]]-v[[1]]],
3603    x,
3604  Map[Function[SubstForInverseFunction[#,v,w,x]],u]]]
3605
3606
3607(* If u is a function of an inverse linear binomial of the form f[1/(a+b*x)],
3608	SubstForInverseLinear[u,x] returns the list {f[x],a+b*x,b}; else it returns False. *)
3609SubstForInverseLinear[u_,x_Symbol] :=
3610  Module[{lst=FunctionOfInverseLinear[u,x],a,b},
3611  If[FalseQ[lst],
3612    False,
3613  a=lst[[1]];
3614  b=lst[[2]];
3615  {RegularizeSubst[u,x,-a/b+1/(b*x)],a+b*x,b}]]
3616
3617
3618(* u is a function of trig functions of a linear function of x.
3619SubstInertTrigFunction[u] returns u with the trig functions replaced with
3620the inert trig functions (sin, csc and tan). *)
3621SubstInertTrigFunction[u_,x_] :=
3622  FixInertTrigFunction[SubstInertTrigFunctionAux[u,x],x]
3623
3624
3625SubstInertTrigFunctionAux[u_,x_] :=
3626  If[AtomQ[u],
3627    u,
3628  If[TrigQ[u] && LinearQ[u[[1]],x],
3629    If[SinQ[u],
3630      sin[u[[1]]],
3631    If[CosQ[u],
3632      sin[u[[1]]+Pi/2],
3633    If[TanQ[u],
3634      tan[u[[1]]],
3635    If[CotQ[u],
3636      1/tan[u[[1]]],
3637    If[SecQ[u],
3638      csc[u[[1]]+Pi/2],
3639    csc[u[[1]]]]]]]],
3640  Map[Function[SubstInertTrigFunctionAux[#,x]],u]]]
3641
3642
3643FixInertTrigFunction[u_.*f_[c_.+d_.*x_]^m_.*(a_.+b_.*g_[c_.+d_.*x_])^n_.,x_] :=
3644  u*g[c+d*x]^(-m)*(a+b*g[c+d*x])^n /;
3645FreeQ[{a,b,c,d,n},x] && IntegerQ[m] && (f===sin && g===csc || f===csc && g===sin)
3646
3647FixInertTrigFunction[f_[c_.+d_.*x_]^m_.*(A_.+B_.*g_[c_.+d_.*x_]+C_.*g_[c_.+d_.*x_]^2),x_] :=
3648  g[c+d*x]^(-m)*(A+B*g[c+d*x]+C*g[c+d*x]^2) /;
3649FreeQ[{c,d,A,B,C},x] && IntegerQ[m] && (f===sin && g===csc || f===csc && g===sin)
3650
3651FixInertTrigFunction[f_[c_.+d_.*x_]^m_.*(A_.+C_.*g_[c_.+d_.*x_]^2),x_] :=
3652  g[c+d*x]^(-m)*(A+C*g[c+d*x]^2) /;
3653FreeQ[{c,d,A,C},x] && IntegerQ[m] && (f===sin && g===csc || f===csc && g===sin)
3654
3655FixInertTrigFunction[u_,x_] := u
3656
3657
3658TryTanSubst[u_,x_Symbol] :=
3659  FalseQ[FunctionOfLinear[u,x]] &&
3660  Not[MatchQ[u,r_.*(s_+t_)^n_. /; IntegerQ[n] && n>0]] &&
3661(*Not[MatchQ[u,Log[f_[x]^2] /; SinCosQ[f]]]  && *)
3662  Not[MatchQ[u,Log[v_]]]  &&
3663  Not[MatchQ[u,1/(a_+b_.*f_[x]^n_) /; SinCosQ[f] && IntegerQ[n] && n>2]] &&
3664  Not[MatchQ[u,f_[m_.*x]*g_[n_.*x] /; IntegersQ[m,n] && SinCosQ[f] && SinCosQ[g]]] &&
3665  Not[MatchQ[u,r_.*(a_.*s_^m_)^p_ /; FreeQ[{a,m,p},x] && Not[m===2 && (s===Sec[x] || s===Csc[x])]]] &&
3666  u===ExpnExpand[u,x]
3667
3668
3669TryPureTanSubst[u_,x_Symbol] :=
3670  Not[MatchQ[u,Log[v_]]] &&
3671  Not[MatchQ[u,f_[v_]^2 /; LinearQ[v,x]]] &&
3672  Not[MatchQ[u,ArcTan[a_.*Tan[v_]] /; FreeQ[a,x]]] &&
3673  Not[MatchQ[u,ArcTan[a_.*Cot[v_]] /; FreeQ[a,x]]] &&
3674  Not[MatchQ[u,ArcCot[a_.*Tan[v_]] /; FreeQ[a,x]]] &&
3675  Not[MatchQ[u,ArcCot[a_.*Cot[v_]] /; FreeQ[a,x]]] &&
3676  u===ExpnExpand[u,x]
3677
3678
3679TryTanhSubst[u_,x_Symbol] :=
3680  FalseQ[FunctionOfLinear[u,x]] &&
3681  Not[MatchQ[u,r_.*(s_+t_)^n_. /; IntegerQ[n] && n>0]] &&
3682(*Not[MatchQ[u,Log[f_[x]^2] /; SinhCoshQ[f]]]  && *)
3683  Not[MatchQ[u,Log[v_]]]  &&
3684  Not[MatchQ[u,1/(a_+b_.*f_[x]^n_) /; SinhCoshQ[f] && IntegerQ[n] && n>2]] &&
3685  Not[MatchQ[u,f_[m_.*x]*g_[n_.*x] /; IntegersQ[m,n] && SinhCoshQ[f] && SinhCoshQ[g]]] &&
3686  Not[MatchQ[u,r_.*(a_.*s_^m_)^p_ /; FreeQ[{a,m,p},x] && Not[m===2 && (s===Sech[x] || s===Csch[x])]]] &&
3687  u===ExpnExpand[u,x]
3688
3689
3690TryPureTanhSubst[u_,x_Symbol] :=
3691  Not[MatchQ[u,Log[v_]]]  &&
3692  Not[MatchQ[u,ArcTanh[a_.*Tanh[v_]] /; FreeQ[a,x]]] &&
3693  Not[MatchQ[u,ArcTanh[a_.*Coth[v_]] /; FreeQ[a,x]]] &&
3694  Not[MatchQ[u,ArcCoth[a_.*Tanh[v_]] /; FreeQ[a,x]]] &&
3695  Not[MatchQ[u,ArcCoth[a_.*Coth[v_]] /; FreeQ[a,x]]] &&
3696  u===ExpnExpand[u,x]
3697
3698
3699(* If u divided by y is free of x, Divides[y,u,x] returns the quotient; else it returns False. *)
3700Divides[y_,u_,x_Symbol] :=
3701  Module[{v=Simplify[u/y]},
3702  If[FreeQ[v,x],
3703    v,
3704  False]]
3705
3706
3707(* If y not equal to x, y is easy to differentiate wrt x, and u divided by the derivative of y
3708  is free of x, DerivativeDivides[y,u,x] returns the quotient; else it returns False. *)
3709DerivativeDivides[y_,u_,x_Symbol] :=
3710  If[MatchQ[y,a_.*x /; FreeQ[a,x]],
3711    False,
3712  If[If[PolynomialQ[y,x], PolynomialQ[u,x] && Exponent[u,x]==Exponent[y,x]-1, EasyDQ[y,x]],
3713    Module[{v=Block[{ShowSteps=False}, D[y,x]]},
3714    If[ZeroQ[v],
3715      False,
3716    v=Simplify[u/v];
3717    If[FreeQ[v,x],
3718      v,
3719    False]]],
3720  False]]
3721
3722
3723(* If y is easy to differentiate wrt x, EasyDQ[y,x] returns True; else it returns False. *)
3724EasyDQ[y_,x_Symbol] :=
3725  If[AtomQ[y] || FreeQ[y,x] || Length[y]==0,
3726    True,
3727  If[CalculusQ[y],
3728    False,
3729  If[Length[y]==1,
3730    EasyDQ[y[[1]],x],
3731  If[BinomialQ[y,x],
3732    True,
3733  If[RationalFunctionQ[y,x] && RationalFunctionExponents[y,x]==={1,1},
3734    True,
3735  If[ProductQ[y],
3736    If[FreeQ[First[y],x],
3737      EasyDQ[Rest[y],x],
3738    If[FreeQ[Rest[y],x],
3739      EasyDQ[First[y],x],
3740    False]],
3741  If[SumQ[y],
3742    EasyDQ[First[y],x] && EasyDQ[Rest[y],x],
3743  If[Length[y]==2,
3744    If[FreeQ[y[[1]],x],
3745      EasyDQ[y[[2]],x],
3746    If[FreeQ[y[[2]],x],
3747      EasyDQ[y[[1]],x],
3748    False]],
3749  False]]]]]]]]
3750
3751
3752DownValues[Rt]={};
3753
3754
3755Rt[u_^m_,n_Integer] :=
3756  1/Rt[u^-m,n] /;
3757RationalQ[m] && m<0
3758
3759Rt[v_.*u_^w_,n_Integer] :=
3760  Module[{m=Numerator[NumericFactor[w]]},
3761  Rt[v,n]*Rt[u^(w/m),n/GCD[m,n]]^(m/GCD[m,n]) /;
3762 m>1] /;
3763Not[NegativeOrZeroQ[v]]
3764
3765(* Rt[u_*v_^m_,n_Integer] :=
3766  Rt[-u,n]/Rt[-v^-m,n] /;
3767RationalQ[m] && m<0 && NegativeQ[u] *)
3768
3769
3770Rt[u_,n_Integer] :=
3771  Map[Function[Rt[#,n]],u] /;
3772ProductQ[u] && OddQ[n]
3773
3774Rt[u_,n_Integer] :=
3775  Catch[
3776  Do[If[PositiveQ[u[[i]]],
3777       Throw[Rt[u[[i]],n]*Rt[Delete[u,i],n]]],
3778    {i,1,Length[u]}];
3779  Do[If[NegativeQ[u[[i]]] && NonzeroQ[u[[i]]+1],
3780       Throw[Rt[-u[[i]],n]*Rt[-Delete[u,i],n]]],
3781    {i,1,Length[u]}];
3782  If[u[[1]]===-1,
3783    Do[If[SumQ[u[[i]]] && (NegQ[u[[i,1]]] || NegQ[u[[i,2]]]),
3784         Throw[Rt[-First[u[[i]]] - Rest[u[[i]]],n]*Rt[-Delete[u,i],n]]],
3785      {i,2,Length[u]}];
3786    Do[If[AtomQ[u[[i]]],
3787         Throw[Rt[-u[[i]],n]*Rt[-Delete[u,i],n]]],
3788      {i,2,Length[u]}];
3789    Rt[-u[[2]],n]*Rt[Drop[u,2],n],
3790  Do[If[Not[FreeQ[Delete[u,i],Rt[-u[[i]],n]]],
3791       Throw[Rt[-u[[i]],n]*Rt[-Delete[u,i],n]]],
3792    {i,1,Length[u]}];
3793  Map[Function[Rt[#,n]],u]]] /;
3794ProductQ[u] && EvenQ[n] && Not[u[[1]]===-1 && Length[u]==2]
3795
3796
3797(* Note: These simplification rules required because not always done by Simplify! See Warts.m
3798	for examples of the problem. *)
3799
3800(* Basis: 1-Sin[z]^2 == Cos[z]^2 *)
3801Rt[u_.*(a_+b_.*Sin[v_]^2)^m_.,n_Integer] :=
3802  Rt[u*(a*Cos[v]^2)^m,n] /;
3803ZeroQ[a+b]
3804
3805(* Basis: 1-Cos[z]^2 == Sin[z]^2 *)
3806Rt[u_.*(a_+b_.*Cos[v_]^2)^m_.,n_Integer] :=
3807  Rt[u*(a*Sin[v]^2)^m,n] /;
3808ZeroQ[a+b]
3809
3810(* Basis: 1+Sinh[z]^2 == Cosh[z]^2 *)
3811Rt[u_.*(a_+b_.*Sinh[v_]^2)^m_.,n_Integer] :=
3812  Rt[u*(a*Cosh[v]^2)^m,n] /;
3813ZeroQ[a-b]
3814
3815(* Basis: 1-Cosh[z]^2 == -Sinh[z]^2 *)
3816Rt[u_.*(a_+b_.*Cosh[v_]^2)^m_.,n_Integer] :=
3817  Rt[u*(b*Sinh[v]^2)^m,n] /;
3818ZeroQ[a+b]
3819
3820
3821Rt[u_,n_Integer] :=
3822  Module[{v=ContentFactor[u]},
3823  Rt[v,n] /;
3824 NonsumQ[v]] /;
3825SumQ[u]
3826
3827
3828Rt[u_,n_] :=
3829  -Rt[-u,n] /;
3830OddQ[n] && NegativeQ[u]
3831
3832Rt[u_,n_Integer] :=
3833  Module[{v=Simplify[u]},
3834  If[LeafCount[Together[v]]<LeafCount[v], v=Together[v]];
3835  If[v=!=u,
3836    Rt[v,n],
3837  u^(1/n)]]
3838
3839
3840(* Rt[u_,n_Integer] :=
3841  If[AtomQ[u],
3842    u^(1/n),
3843  If[PowerQ[u],
3844    If[RationalQ[u[[2]]],
3845      If[u[[2]]<0,
3846        1/Rt[u[[1]]^-u[[2]],n],
3847      If[Numerator[u[[2]]]>1,
3848        Module[{gcd=GCD[Numerator[u[[2]]],n]},
3849        Rt[u[[1]]^(1/Denominator[u[[2]]]),n/gcd]^(Numerator[u[[2]]]/gcd)],
3850      u^(1/n)]],
3851    u^(1/n)],
3852  If[ProductQ[u],
3853    If[OddQ[n],
3854      Map[Function[Rt[#,n]],u],
3855    If[NegativeQ[First[u]],
3856      If[First[u]===-1,
3857        If[PowerQ[Rest[u]] && OddQ[Rest[u][[2]]],
3858          If[Rest[u][[2]]<0,
3859            1/Rt[(-Rest[u][[1]])^-Rest[u][[2]],n],
3860          Module[{gcd=GCD[Rest[u][[2]],n]},
3861          Rt[Rest[u][[1]],n/gcd]^(Rest[u][[2]]/gcd)]],
3862        u^(1/n)],
3863      Rt[-First[u],n]*Rt[-Rest[u],n]],
3864    u^(1/n)]], *)
3865
3866
3867(* If u is free of x or of the form c*(a+b*x)^m, IntSum[u,x] returns the antiderivative of u wrt x;
3868	else it returns d*Int[v,x] where d*v=u and d is free of x. *)
3869IntSum[u_,x_Symbol] :=
3870  Module[{lst=SplitFreeTerms[u,x]},
3871  Simp[lst[[1]]*x,x] + IntTerm[lst[[2]],x]]
3872
3873
3874(* If u is of the form c*(a+b*x)^m, IntTerm[u,x] returns the antiderivative of u wrt x;
3875	else it returns d*Int[v,x] where d*v=u and d is free of x. *)
3876IntTerm[c_./v_,x_Symbol] :=
3877  Simp[c*Log[RemoveContent[v,x]]/Coefficient[v,x,1],x] /;
3878FreeQ[c,x] && LinearQ[v,x]
3879
3880IntTerm[c_.*v_^m_.,x_Symbol] :=
3881  Simp[c*v^(m+1)/(Coefficient[v,x,1]*(m+1)),x] /;
3882FreeQ[{c,m},x] && NonzeroQ[m+1] && LinearQ[v,x]
3883
3884IntTerm[u_,x_Symbol] :=
3885  Map[Function[IntTerm[#,x]],u] /;
3886SumQ[u]
3887
3888IntTerm[u_,x_Symbol] :=
3889  Module[{lst=SplitFreeFactors[u,x]},
3890  Dist[lst[[1]], Int[lst[[2]],x], x]]
3891
3892
3893(* SimplerIntegrandQ[u,v,x] returns True iff u is simpler to integrate wrt x than v. *)
3894SimplerIntegrandQ[u_,v_,x_Symbol] :=
3895  Module[{lst=CancelCommonFactors[u,v],u1,v1},
3896  u1=lst[[1]];
3897  v1=lst[[2]];
3898(*If[Head[u1]===Head[v1] && Length[u1]==Length[v1]==1,
3899    SimplerIntegrandQ[u1[[1]],v1[[1]],x], *)
3900  If[LeafCount[u1]<3/4*LeafCount[v1],
3901    True,
3902  If[RationalFunctionQ[u1,x],
3903    If[RationalFunctionQ[v1,x],
3904      Apply[Plus,RationalFunctionExponents[u1,x]]<Apply[Plus,RationalFunctionExponents[v1,x]],
3905    True],
3906  False]]]
3907
3908
3909(* CancelCommonFactors[u,v] returns {u',v'} are the noncommon factors of u and v respectively. *)
3910CancelCommonFactors[u_,v_] :=
3911  If[ProductQ[u],
3912    If[ProductQ[v],
3913      If[MemberQ[v,First[u]],
3914        CancelCommonFactors[Rest[u],DeleteCases[v,First[u],1,1]],
3915      Function[{First[u]*#[[1]],#[[2]]}][CancelCommonFactors[Rest[u],v]]],
3916    If[MemberQ[u,v],
3917      {DeleteCases[u,v,1,1],1},
3918    {u,v}]],
3919  If[ProductQ[v],
3920    If[MemberQ[v,u],
3921      {1,DeleteCases[v,u,1,1]},
3922    {u,v}],
3923  {u,v}]]
3924
3925
3926(* SumSimplerQ[u,v] returns True iff for every term w of v there is a term of u
3927	equal to n*w where n<-1/2. Therefore if True, u+v will be simpler than u. *)
3928SumSimplerQ[u_,v_] :=
3929  If[RationalQ[u,v],
3930    If[v==0,
3931      False,
3932    If[v>0,
3933      u<-1,
3934    u>=-v]],
3935  SumSimplerAuxQ[Expand[u],Expand[v]]]
3936
3937
3938SumSimplerAuxQ[u_,v_] :=
3939  (RationalQ[First[v]] || SumSimplerAuxQ[u,First[v]]) &&
3940  (RationalQ[Rest[v]] || SumSimplerAuxQ[u,Rest[v]]) /;
3941SumQ[v]
3942
3943SumSimplerAuxQ[u_,v_] :=
3944  SumSimplerAuxQ[First[u],v] || SumSimplerAuxQ[Rest[u],v] /;
3945SumQ[u]
3946
3947SumSimplerAuxQ[u_,v_] :=
3948  v=!=0 &&
3949  NonnumericFactors[u]===NonnumericFactors[v] &&
3950  (NumericFactor[u]/NumericFactor[v]<-1/2 || NumericFactor[u]/NumericFactor[v]==-1/2 && NumericFactor[u]<0)
3951
3952
3953(* SimplerSqrtQ[u,v] returns True iff Rt[u,2] is simpler than Rt[v,2]. *)
3954SimplerSqrtQ[u_,v_] :=
3955  Module[{sqrtu=Rt[u,2],sqrtv=Rt[v,2]},
3956  If[IntegerQ[sqrtu],
3957    If[IntegerQ[sqrtv],
3958      sqrtu<sqrtv,
3959    True],
3960  If[IntegerQ[sqrtv],
3961    False,
3962  If[RationalQ[Rt[sqrtu]],
3963    If[RationalQ[sqrtv],
3964      sqrtu<sqrtv,
3965    True],
3966  If[RationalQ[sqrtv],
3967    False,
3968  If[PosQ[u],
3969    If[PosQ[v],
3970      LeafCount[sqrtu]<LeafCount[sqrtv],
3971    True],
3972  If[PosQ[v],
3973    False,
3974  LeafCount[sqrtu]<LeafCount[sqrtv]]]]]]]]
3975
3976
3977ClearAll[FixIntRules,FixIntRule,FixRhsIntRule]
3978
3979
3980FixIntRules[] :=
3981  (DownValues[Int]=FixIntRules[DownValues[Int]]; Null)
3982
3983
3984FixIntRules[rulelist_] :=
3985  Module[{IntDownValues=DownValues[Int],SubstDownValues=DownValues[Subst],
3986	SimpDownValues=DownValues[Simp],DistDownValues=DownValues[Dist],lst},
3987(* Print["Fixing ",Length[rulelist]," integration rules."]; *)
3988  Clear[Int,Subst,Simp,Dist];
3989  SetAttributes[{Simp,Dist,Int,Subst},HoldAll];
3990  lst=Map[Function[FixIntRule[#,#[[1,1,2,1]]]],rulelist];
3991  DownValues[Int]=IntDownValues;
3992  DownValues[Subst]=SubstDownValues;
3993  DownValues[Simp]=SimpDownValues;
3994  DownValues[Dist]=DistDownValues;
3995  ClearAttributes[{Simp,Dist,Int,Subst},HoldAll];
3996  lst]
3997
3998
3999FixIntRule[RuleDelayed[lhs_,F_[G_[list_,F_[u_+v_,test2_]],test1_]],x_] :=
4000  ReplacePart[RuleDelayed[lhs,Condition[Module[list,Condition[u+v,test2]],test1]],{{2,1,2,1,1}->FixRhsIntRule[u,x],{2,1,2,1,2}->FixRhsIntRule[v,x]}] /;
4001F===Condition && G===Module
4002
4003FixIntRule[RuleDelayed[lhs_,G_[list_,F_[u_+v_,test2_]]],x_] :=
4004  ReplacePart[RuleDelayed[lhs,Module[list,Condition[u+v,test2]]],{{2,2,1,1}->FixRhsIntRule[u,x],{2,2,1,2}->FixRhsIntRule[v,x]}] /;
4005F===Condition && G===Module
4006
4007FixIntRule[RuleDelayed[lhs_,F_[G_[list_,u_+v_],test_]],x_] :=
4008  ReplacePart[RuleDelayed[lhs,Condition[Module[list,u+v],test]],{{2,1,2,1}->FixRhsIntRule[u,x],{2,1,2,2}->FixRhsIntRule[v,x]}] /;
4009F===Condition && G===Module
4010
4011FixIntRule[RuleDelayed[lhs_,G_[list_,u_+v_]],x_] :=
4012  ReplacePart[RuleDelayed[lhs,Module[list,u+v]],{{2,2,1}->FixRhsIntRule[u,x],{2,2,2}->FixRhsIntRule[v,x]}] /;
4013G===Module
4014
4015FixIntRule[RuleDelayed[lhs_,F_[u_+v_,test_]],x_] :=
4016  ReplacePart[RuleDelayed[lhs,Condition[u+v,test]],{{2,1,1}->FixRhsIntRule[u,x],{2,1,2}->FixRhsIntRule[v,x]}] /;
4017F===Condition
4018
4019FixIntRule[RuleDelayed[lhs_,u_+v_],x_] :=
4020  ReplacePart[RuleDelayed[lhs,u+v],{{2,1}->FixRhsIntRule[u,x],{2,2}->FixRhsIntRule[v,x]}]
4021
4022
4023FixIntRule[RuleDelayed[lhs_,F_[G_[list1_,F_[G_[list2_,u_],test2_]],test1_]],x_] :=
4024  ReplacePart[RuleDelayed[lhs,Condition[Module[list1,Condition[Module[list2,u],test2]],test1]],{2,1,2,1,2}->FixRhsIntRule[u,x]] /;
4025F===Condition && G===Module
4026
4027FixIntRule[RuleDelayed[lhs_,F_[G_[list_,F_[H_[str1_,str2_,str3_,J_[u_]],test2_]],test1_]],x_] :=
4028  ReplacePart[RuleDelayed[lhs,Condition[Module[list,Condition[ShowStep[str1,str2,str3,Hold[u]],test2]],test1]],{2,1,2,1,4,1}->FixRhsIntRule[u,x]] /;
4029F===Condition && G===Module && H===ShowStep && J===Hold
4030
4031FixIntRule[RuleDelayed[lhs_,F_[G_[list_,F_[u_,test2_]],test1_]],x_] :=
4032  ReplacePart[RuleDelayed[lhs,Condition[Module[list,Condition[u,test2]],test1]],{2,1,2,1}->FixRhsIntRule[u,x]] /;
4033F===Condition && G===Module
4034
4035FixIntRule[RuleDelayed[lhs_,G_[list_,F_[u_,test2_]]],x_] :=
4036  ReplacePart[RuleDelayed[lhs,Module[list,Condition[u,test2]]],{2,2,1}->FixRhsIntRule[u,x]] /;
4037F===Condition && G===Module
4038
4039FixIntRule[RuleDelayed[lhs_,F_[G_[list_,u_],test_]],x_] :=
4040  ReplacePart[RuleDelayed[lhs,Condition[Module[list,u],test]],{2,1,2}->FixRhsIntRule[u,x]] /;
4041F===Condition && G===Module
4042
4043FixIntRule[RuleDelayed[lhs_,G_[list_,u_]],x_] :=
4044  ReplacePart[RuleDelayed[lhs,Module[list,u]],{2,2}->FixRhsIntRule[u,x]] /;
4045G===Module
4046
4047FixIntRule[RuleDelayed[lhs_,F_[u_,test_]],x_] :=
4048  ReplacePart[RuleDelayed[lhs,Condition[u,test]],{2,1}->FixRhsIntRule[u,x]] /;
4049F===Condition
4050
4051FixIntRule[RuleDelayed[lhs_,u_],x_] :=
4052  ReplacePart[RuleDelayed[lhs,u],{2}->FixRhsIntRule[u,x]]
4053
4054
4055SetAttributes[FixRhsIntRule,HoldAll];
4056
4057FixRhsIntRule[u_+v_,x_] :=
4058  FixRhsIntRule[u,x]+FixRhsIntRule[v,x]
4059
4060FixRhsIntRule[u_-v_,x_] :=
4061  FixRhsIntRule[u,x]-FixRhsIntRule[v,x]
4062
4063FixRhsIntRule[-u_,x_] :=
4064  -FixRhsIntRule[u,x]
4065
4066FixRhsIntRule[a_*u_,x_] :=
4067  Dist[a,u,x] /;
4068MemberQ[{Int,Subst},Head[Unevaluated[u]]]
4069
4070FixRhsIntRule[u_,x_] :=
4071  If[Head[Unevaluated[u]]===Dist && Length[Unevaluated[u]]==2,
4072    Insert[Unevaluated[u],x,3],
4073  If[MemberQ[{Int,Subst,Defer[Int],Simp,Dist},Head[Unevaluated[u]]],
4074    u,
4075  Simp[u,x]]]
4076