(*^

::[paletteColors = 128;
fontset = title, "New York", 24, L3, center, bold, nohscroll;
fontset = subtitle, "New York", 18, L2, center, bold, nohscroll;
fontset = subsubtitle, "New York", 14, L2, center, bold, nohscroll;
fontset = section, "New York", 14, L2, bold, nohscroll, grayBox;
fontset = subsection, "New York", 12, L2, bold, nohscroll, blackBox;
fontset = subsubsection, "New York", 10, L2, bold, nohscroll, whiteBox;
fontset = text, "New York", 10, L2, nohscroll;
fontset = smalltext, "New York", 9, L2, nohscroll;
fontset = input, "Courier", 10, L2, bold, nowordwrap;
fontset = output, "Courier", 10, L2, nowordwrap;
fontset = message, "Courier", 10, L2, R65535, nowordwrap;
fontset = print, "Courier", 10, L2, nowordwrap;
fontset = info, "Courier", 10, L2, nowordwrap;
fontset = postscript, "Courier", 12, L2, nowordwrap;
fontset = name, "Geneva", 10, L2, italic, B65535, nowordwrap, nohscroll;
fontset = header, "Times", 10, L2;
fontset = footer, "Times", 12, L2, center;
fontset = help, "Geneva", 10, L2, nohscroll;
fontset = clipboard, "New York", 12, L2;
fontset = completions, "New York", 12, L2, nowordwrap;
fontset = network, "Courier", 10, L2, nowordwrap;
fontset = graphlabel, "Courier", 12, L2, nowordwrap;
fontset = special1, "New York", 12, L2, nowordwrap;
fontset = special2, "New York", 12, L2, center, nowordwrap;
fontset = special3, "New York", 12, L2, right, nowordwrap;
fontset = special4, "New York", 12, L2, nowordwrap;
fontset = special5, "New York", 12, L2, nowordwrap;]
:[font = input; initialization; ]
*)
(* Declarations (Odd,Even,..) and basic mathematical relations.
Package written 5.6.90 by
Pekka Janhunen
Finnish Meteorological Institute
Geophysics Dept.
pjanhune@finsun.csc.fi
*)

BeginPackage["Declare`"]

Declare::usage = "Declare[a,Odd] or
Declare[{x,y},Real] etc. Possible declarations are
Odd,Even,Integer,Real,Positive,Negative,
NonPositive,NonNegative."

NonPositive::usage = "NonPositive[x] is True if x >= 0"

RealQ::usage = "RealQ[x] is True if x is real"

Odd::usage = "Odd is a possible second argument for Declare."

Even::usage = "Even is a possible second argument for Declare."

NonZero::usage = "NonZero[x] is True if x != 0."

EqnCanonical::usage = "EqnCanonical[eqn] removes manifestly
nonzero factors from eqn, i.e. simplifies eqn."

Begin["`Private`"]

Declare[a_Symbol,Odd]:=
(OddQ[a]^= True; EvenQ[a]^= False; IntegerQ[a]^= True;
RealQ[a]^= True; Null)

Declare[a_Symbol, Even]:=
(OddQ[a]^= False; EvenQ[a]^= True; IntegerQ[a]^= True;
RealQ[a]^= True; Null)

Declare[a_Symbol, Integer]:=
(IntegerQ[a]^= True; RealQ[a]^= True;
Null)

Declare[a_Symbol, Real]:=
(RealQ[a]^= True; Null)

Declare[a_Symbol, Positive]:=
(Positive[a]^= True; Negative[a]^= False;
NonPositive[a]^= False; NonNegative[a]^= True;
RealQ[a]^= True; Null)

Declare[a_Symbol, Negative]:=
(Negative[a]^= True; Positive[a]^= False;
NonNegative[a]^= False; NonPositive[a]^= True;
RealQ[a]^= True; Null)

Declare[a_Symbol, NonNegative]:=
(NonNegative[a]^= True; Negative[a]^= False;
RealQ[a]^= True; Null)

Declare[a_Symbol, NonPositive]:=
(NonPositive[a]^= True; Positive[a]^= False;
RealQ[a]^= True; Null)

Declare[x_List, attr_Symbol]:=
(Declare[#,attr]& /@ x; Null)

Unprotect[Positive]
Positive[x_ y_]:= Positive[x] == Positive[y]
Positive[x_?Positive + y_?NonNegative] = True
Positive[x_?NonPositive + y_?NonPositive] = False
Positive[_?Positive ^ _?RealQ] = True
Positive[_?NonPositive ^ _?OddQ] = False
Protect[Positive]

Unprotect[NonNegative]
NonNegative[x_?NonNegative y_?NonNegative] = True
NonNegative[x_?Negative y_?Positive] = False
NonNegative[x_?NonNegative + y_?NonNegative]= True
NonNegative[x_?Negative + y_?NonPositive] = False
NonNegative[_?NonNegative ^ _?RealQ] = True
NonNegative[_?RealQ ^ _?EvenQ] = True
Protect[NonNegative]

Unprotect[NonPositive]
NonPositive[x_]:= !Positive[x]
Protect[NonPositive]

Unprotect[Negative]
Negative[x_]:= !NonNegative[x]
Protect[Negative]

Unprotect[NonZero]
NonZero[_^_?NonPositive] = True
NonZero[_?NonZero ^ _?RealQ] = True
NonZero[_?Positive] = True
NonZero[_?Negative] = True
NonZero[x_?NumberQ]:= x != 0
Protect[NonZero]

EqnCanonical[f_]:=
f //. {_?NonZero x_ == 0 :> x == 0,
_?NonZero == 0 :> False}

Unprotect[Abs]
Abs[x_?NonNegative]:= x;
Abs[x_?Negative]:= -x;
NonNegative[Abs[_]]^= True
RealQ[Abs[_]]^= True
Abs/: Abs[x_?RealQ]^n_?EvenQ:= x^n
Protect[Abs]

Unprotect[IntegerQ]
IntegerQ[x_?IntegerQ + y_?IntegerQ] = True
IntegerQ[x_?IntegerQ * y_?IntegerQ] = True
IntegerQ[_?IntegerQ ^ n_?IntegerQ]:= True /; NonNegative[n]
Protect[IntegerQ]

Unprotect[Floor,Ceiling]
IntegerQ[Floor[_]]^= True
IntegerQ[Ceiling[_]]^= True
Protect[Floor,Ceiling]

Unprotect[RealQ]
RealQ[_Real] = True
RealQ[_Integer] = True
RealQ[_Rational] = True
RealQ[_Complex] = False
RealQ[Re[_]] = True
RealQ[Im[_]] = True
RealQ[Arg[_]] = True
RealQ[_?NonNegative ^ _?RealQ] = True
RealQ[_?Negative ^ x_]:= False /; !IntegerQ[x]
RealQ[_?RealQ ^ _?IntegerQ] = True
RealQ[x_?RealQ + y_?RealQ] = True
RealQ[x_?RealQ * y_?RealQ] = True
Protect[RealQ]

Unprotect[Re,Im]
Re[x_?RealQ] = x
Im[_?RealQ] = 0
Protect[Re,Im]

Unprotect[Power]
x_?(NumberQ[#]&&Negative[#]&) ^ n_?EvenQ:= (-x)^n
x_?(NumberQ[#]&&Negative[#]&) ^ n_?OddQ:= x (-x)^(n-1)
(x_?RealQ ^n_?EvenQ)^a_?RealQ:= Abs[x]^(n a)
Protect[Power]

Unprotect[EvenQ]
EvenQ[n_?EvenQ + m_?EvenQ] = True
EvenQ[n_?EvenQ + m_?OddQ] = False
EvenQ[n_?OddQ + m_?OddQ] = True
EvenQ[n_?EvenQ * m_?IntegerQ] = True
EvenQ[n_?OddQ * m_?OddQ] = False
EvenQ[_?EvenQ ^ n_?IntegerQ]:= True /; Positive[n]
EvenQ[_?OddQ ^ n_?IntegerQ]:= False /; Positive[n]
Protect[EvenQ]

Unprotect[OddQ]
OddQ[x_]:= !EvenQ[x]
Protect[OddQ]

Unprotect[Unequal];
Unequal/: (False!=True):= True;
Protect[Unequal]

Unprotect[Equal];
Equal/: False == True:= False;
Protect[Equal]

Unprotect[DirectedInfinity];
DirectedInfinity/: _?Positive DirectedInfinity[1] = Infinity;
DirectedInfinity/: _?Negative DirectedInfinity[1] = - Infinity;
DirectedInfinity/: _?Positive DirectedInfinity[-1] = -Infinity;
DirectedInfinity/: _?Negative DirectedInfinity[-1] = Infinity;
Protect[DirectedInfinity]

Unprotect[E,Pi,Catalan,EulerGamma]
Declare[{E,Pi,Catalan,EulerGamma},Positive]
Protect[E,Pi,Catalan,EulerGamma]

Print[{Declare,NonPositive,RealQ,NonZero,EqnCanonical}]

End[]

EndPackage[]

Null
(*
;[s]
5:0,0;2840,1;2841,0;4205,2;4275,0;4845,-1;
3:3,13,9,Courier,1,10,0,0,0;1,14,10,Courier,1,12,0,0,0;1,12,9,Courier,1,10,0,0,0;
^*)