This is SigProc.m in view mode; [Download] [Up]
(* :Title: Signal Processing Primitive Objects *)
(* :Authors: Brian Evans, James McClellan *)
(*
:Summary: Provide functions which are common in DSP but
not standard in Mathematica. Functions like
Step and Impulse, as well as operators like
Upsample and Shift.
*)
(* :Context: SignalProcessing`Support`SigProc` *)
(* :PackageVersion: 2.6 *)
(*
:Copyright: Copyright 1989-1991 by Brian L. Evans
Georgia Tech Research Corporation
Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is
hereby granted, provided that the above copyright notice
appear in all copies and that both that copyright notice and
this permission notice appear in supporting documentation,
and that the name of the Georgia Tech Research Corporation,
Georgia Tech, or Georgia Institute of Technology not be used
in advertising or publicity pertaining to distribution of the
software without specific, written prior permission. Georgia
Tech makes no representations about the suitability of this
software for any purpose. It is provided "as is" without
express or implied warranty.
*)
(* :History: signal processing, operators, functions, symbolic processing *)
(* :Keywords: *)
(*
:Source: Myers, C. {Signal Representation for Symbolic and
Numeric Processing}. MIT Ph.D. Thesis. 1986.
Covell, M. {An Algorithm Design Environment}.
MIT Ph. D. Thesis, 1989.
Bamberger, R. {The Directional Filter Bank: A Multirate
Filter Bank for the Directional Decompostion of Images},
Georgia Tech Ph. D. Thesis, 1990.
*)
(* :Warning: *)
(* :Mathematica Version: 1.2 or 2.0 *)
(* :Limitation: *)
(*
:Discussion: This package introduces the functions (signals) and
operators (systems) common in signal processing but missing
in Mathematica.
Thanks to John Mitchell at the University of Chicago
for writing patches for the Summation operator and the Delta
function.
*)
(* :Functions: Aliasby operator
AliasSinc alias
ASinc alias
CConvolve operator
CircularShift operator
Convolve operator
Continuous option value
CPulse function
CStep function
Delta function
DeltaPlot function
DFT operator
DTFT operator
Discrete option value
Difference operator
Dirichlet function
DiscreteGraphics routine
Domain option
Downsample operator
DummyVariables function
Extent function
FT operator
GetDeltaFunctions function
Impulse function
Interleave operator
IntervalsToFunction routine
InvDFT operator
InvFT operator
InvL operator
InvZ operator
L operator
LineImpulse function
OperatorInOperExpr routine
OperatorName routine
ParametersInOperExpr routine
PolyphaseDownsample operator
PolyphaseUpsample operator
Periodic operator
Pulse function
RationalGCD routine
Rev operator
RewriteSummations routine
ScaleAxis operator
ScalingFactor routine
SequenceToFunction routine
SequencePlot routine
Shift operator
SignalPlot function
SignalsInOperExpr routine
Sinc function
SPSimplify function
Step function
Summation operator
TheFunction routine
ToContinuous routine
ToDiscrete routine
Unit function
Upsample operator
UpsampledFunction routine
UpsampleFactor routine
UpsampleSequence routine
Z operator
This package provides signal primitives (functions), system
primitives (operators), and supporting routines. Each new
object is placed into the SPsignals, SPsystems, or SPfunctions
list accordingly (at end of file).
Each signal primitive (function) is specified as follows:
(1) default arguments (if any),
(2) definition (so that it behaves as a function),
(3) multidimensional separability (if any),
(4) automatic simplification rules,
(5) manual simplification rules (augment Simplify),
(6) output form rules (including TeX form rules), and
(7) derivative and integration rules (if any)
Each system primitive (operator) is specified as follows:
(1) multidimensional separability (if any),
(2) manual simplification rules (augment Simplify),
(3) definition (so that it can be converted into a function form),
(4) output form rules (including TeX form rules), and
(5) specify which parameter is (are) the variable(s)
*)
If [ TrueQ[ $VersionNumber >= 2.0 ],
Off[ General::spell ];
Off[ General::spell1 ] ]
(* B E G I N P A C K A G E *)
BeginPackage[ "SignalProcessing`Support`SigProc`",
"SignalProcessing`Support`SupCode`" ]
(* U S A G E I N F O R M A T I O N *)
Aliasby::usage =
"Aliasby[m,w][x] represents the aliasing of x, a continuous-frequency \
signal, by replicating it every (2 Pi / m) in w and dividing the \
result by m."
CConvolve::usage =
"CConvolve[t][x1, x2, ...] represents the continuous convolution in t \
of functions x1, x2, .... \
CConvolve[{t1, t2, ...}][x1, x2, ...] represents the multidimensional \
continuous convolution in t1, t2, ... of functions x1, x2, ..."
CircularShift::usage =
"CircularShift[n0, N, n] represents the circular shifting of a \
sequence of length N in index variable n by n0. \
That is, the sequence is treated as a ring buffer of length N \
so each sample at index n is shifted to the right by
(n + n0) mod N places. \
See also Shift and RotateRight."
Convolve::usage =
"Convolve[n][x1, x2, ...] represents the discrete convolution in n of \
functions x1, x2, .... \
Convolve[{n1, n2, ...}][x1, x2, ...] represents the multidimensional \
discrete convolution in n1, n2, ... of functions x1, x2, ..."
Continuous::usage =
"Continuous is a possible value for a signal's domain."
CPulse::usage =
"CPulse[l,t] defines a pulse which begins at t=0 and ends at t = l. \
The CPulse has value 1 within the range (0,l), \
0 outside this range, and 1/2 at the points t=0 and t=l. \
A continuous-pulse center at the origin is written as \
CPulse[l, t + l/2] or Shift[-l/2, t][CPulse[l, t]]."
CStep::usage =
"CStep[t], a.k.a. Unit[-1][t], is the unit step function \
which is 1 for t > 0, 0 for t < 0, and 1/2 at t = 0. \
It is commonly used for continuous expressions t. \
See also Step and Unit."
Delta::usage =
"Delta[expr] is the Dirac delta function. \
The area under this functions is 1 but it only has value \
at the origin. \
That is, Integrate[ Delta[t] g[t], {t, t1, t2} ] is g[0] \
if t1 <= 0 <= t2, 0 otherwise. \
It differs from the Kronecker delta function Impulse[t]."
DeltaIntegrate::usage =
"DeltaIntegrate[fun, {x, xlower, xupper}] and DeltaIntegrate[fun, x] \
are special hooks for the built-in Integrate routine."
DeltaPlot::usage =
"DeltaPlot is a object that can generate a plot of only Dirac delta \
functions or a combination of Dirac delta functions and another plot. \
In the first case, either four or six arguments are passed: \
deltafuns, t, tmin, tmax, ymin, ymax.\
In the second case, either five or seven arguments are passed: \
deltafuns, t, tmin, tmax, plot, ymin, ymax. \
In both cases, ymin and ymax are the optional arguments. \
DeltaPlot returns a list of plots suitable for sending to Show. \
Note that 1-D Delta functions are plotted as arrows."
DFT::usage =
"DFT[L, n, k] is the forward discrete Fourier transform operator. \
Here, L is the DFT length(s), n is the time-domain variable(s), and \
k is the frequency-domain variable(s). \
Multidimensional DFT's are supported. \
Applying TheFunction to the DFT operator will invoke \
the DFT rule base (object DFTransform) if loaded."
DTFT::usage =
"DTFT[n, w] is the forward discrete-time Fourier transform operator. \
Here, n is the time-domain variable(s), and w is the frequency-domain \
variable(s). \
Multidimensional DTFT's are supported. \
Applying TheFunction to the DTFT operator will invoke the DTFT \
rule base (object DTFTransform) if loaded."
Difference::usage =
"Difference[k,n] represents the k-th backward difference with respect \
to the variable n. \
The first-order difference of f equals f[n] - f[n-1], \
the second-order difference is f[n] - 2 f[n-1] + f[n-2], and so on. \
Applying this operator to the sequence x[n] would be written as \
Difference[k,n][ x[n] ]."
Dirichlet::usage =
"Dirichlet[N, w] is the aliased sinc function. \
which is defined as Sin[N w / 2] / ( N Sin [w / 2] ). \
Aliases for Dirichlet are ASinc, AliasSinc, and AliasedSinc."
Discrete::usage =
"Discrete is a possible value for a signal's domain."
DiscreteGraphics::usage =
"DiscreteGraphics[{{x1,y1}, {x2,y2}, ... {xN,yN}}] will plot \
the points as lines drawn from the x-axis to the y-value. \
It takes two optional arguments: a line thickness and \
a point thickness. \
Each is a real value from 0 to 1 indicating a width that \
is a fraction of the size of the entire graph."
Domain::usage =
"Domain is an option for many signal processing functions. \
It is either Discrete or Continuous."
Downsample::usage =
"Downsample[m,n] represents the downsampling operator. \
Downsampling resamples a function at the points n = 0, m, 2m, 3m, ... \
In N dimensions, n is a list of N indices and m is an N x N matrix. \
Applying TheFunction to f[n] which is downsampled in one dimension, \
(written as Downsample[m, n][ f[n] ]) will produce f[m n]."
DummyVariables::usage =
"DummyVariables[dimension, variable] generates dimension dummy \
variables with variable as the root. \
For example, n can be generated by DummyVariables[1, n] or \
DummyVariables[0, n]. \
As another example, DummyVariables[3, t] returns {t1, t2, t3}. \
In this cases, the generated variables have the same context \
as variable. \
DummyVariables[dimension, variable, context] can \
be used to specify another context/package."
Extent1D::usage =
"Extent1D[expression, var] returns an interval \
{lower-limit, upper-limit} outside of which the function is zero. \
This routine assumes that var is a real variable."
FT::usage =
"FT[t, w] is the forward continuous Fourier transform operator. \
Here, t is the time-domain variable(s) and w is the \
frequency-domain variable(s). \
Applying TheFunction to this operator will invoke the continuous-time \
Fourier transform rule base (object CTFTransform) if loaded."
GetDeltaFunctions::usage =
"GetDeltaFunctions[function, variable(s)] will extract \
all delta functions from the argument function. See also DeltaPlot."
Impulse::usage =
"Impulse[n] is the unit Kronecker Delta function. \
At n = 0, the function evaluates to 1. \
Elsewhere, it evaluates to 0."
Interleave::usage =
"Interleave[n][x0, x1, ...] interleaves samples of signals \
x0, x1, ..., which are functions of n. \
This is only applicable to discrete signals."
IntervalsToFunction::usage =
"IntervalsToFunction[interlist, n, step, pulse] \
will translate the list of functions and intervals (interlist) \
into a signal expression as a function of n. \
Each element in the interlist is a list of three elements: \
<function_of_n>, <n_minus>, and <n_plus>. \
The function <function_of_n> will be defined for \
<n_minus> <= n <= <n_plus>. \
Note that <n_minus> can be an integer or -Infinity and \
that <n_plus> can be an integer or Infinity. \
The default values are n = Global`n, \
step = Step, and pulse = Pulse. \
This function also works for when n represents a continuous variable \
(step = CStep and pulse = CPulse)."
InvDFT::usage =
"InvDFT[L, k, n] is the inverse discrete Fourier transform operator. \
Here, L is the DFT length(s), n is the time-domain variable(s), and \
k is the frequency-domain variable(s). \
Multidimensional inverse DFT's are supported. \
Applying TheFunction to the InvDFT operator will invoke the \
inverse DFT rule base (object InvDFTransform) if loaded."
InvDTFT::usage =
"InvDTFT[w, n] is the inverse discrete-time Fourier transform \
operator. \
Here, n is the time-domain variable(s), and w is the \
frequency-domain variable(s). \
Multidimensional inverse DTFT's are supported. \
Applying TheFunction to the InvDTFT operator will invoke the \
inverse DTFT rule base InvDTFTransform if loaded."
InvFT::usage =
"InvFT[w, t] is the inverse discrete Fourier transform operator. \
Here, t is the time-domain variable(s) and w is the \
frequency-domain variable(s). \
Multidimensional Fourier transforms are supported. \
Applying TheFunction to this operator will invoke the inverse \
continuous-time Fourier transform rule base InvCTFTransform if loaded."
InvL::usage =
"InvL[s, t] is the inverse Laplace transform operator. \
Applying TheFunction to the InvL operator will invoke the \
bilateral inverse Laplace rule base InvLaPlace if loaded."
InvZ::usage =
"InvZ[z, n] is the inverse z-transform operator. \
Applying TheFunction to the InvZ operator will invoke the inverse \
z-transform rule base InvZTransform if loaded."
L::usage =
"L[t, s] is the forward Laplace transform operator. \
Applying TheFunction to the L operator will invoke the bilateral \
Laplace rule base if loaded."
LineImpulse::usage =
"LineImpulse[nlist, coefflist] represents a line impulse where \
nlist is a list of variables like {n1,n2,n3} and coefflist is \
a corresponding list of coefficients like {1,2,3}. \
For the previous lists, the line impulse is a set of impulse \
along the line n1 = 2 n2 = 3 n3."
OperatorInOperExpr::usage =
"OperatorInOperExpr[ operator_expression ] returns the full \
operator in operator_expression. \
For example, Shift[2,n] would be returned from \
OperatorInOperExpr[ Shift[2,n][x[n]] ]."
OperatorName::usage =
"OperatorName[ operator_expression ] returns the head of the \
expression. \
For example, OperatorName[ Shift[2,n][x[n]] ] will return Shift."
ParametersInOperExpr::usage =
"ParametersInOperExpr[ operator_expression ] returns the parameters \
of the operator in operator_expression. \
For example, (2,n) would be returned from \
ParametersInOperExpr[ Shift[2,n][x[n]] ]."
Periodic::usage =
"Periodic[k,n][f] indicates that f is a function of n which is \
periodic with period of k."
PolyphaseDownsample::usage =
"PolyphaseDownsample[m, h, n][x] is equivalent to downsampling \
x by m (w/r to n) and then filtering (w/r to n) by a polyphase \
form of the FIR filter h. \
Hence, the filtering is carried out at the lower sampling rate."
PolyphaseUpsample::usage =
"PolyphaseUpsample[l, h, n][x] is equivalent to filtering (w/r to n) \
x by a polyphase form of the FIR filter h and then upsampling the \
result by l (w/r to n). \
Hence, the filtering is carried out at the lower sampling rate."
Pulse::usage =
"Pulse[len] and Pulse[len, n] define a pulse which begins at \
n = 0 and ends at n = len - 1. \
A discrete pulse centered at the origin is written as \
Pulse[len, n + (len - 1)/2] or Shift[-(len - 1)/2, n][Pulse[len, n]]. \
Sometime, a pulse will be automatically simplified; \
e.g., Pulse[0, n] is zero and Pulse[1, n] is really Impulse[n]."
RationalGCD::usage =
"RationalGCD[e1, e2, ...] returns the greatest common divisor of the \
numerators of elements ei divided by the greatest common divisor of \
the denominators of elements ei. \
Every element must be a polynomial or a number. \
Each real-valued and complex-valued element is rationalized \
before GCD's are computed."
Rev::usage =
"Rev[n][x] represents the operation of reversing the direction of x, \
with respect to the variables(s) n."
RewriteSummations::usage =
"RewriteSummations[f, t, tlower, tupper] rewrites Summation \
and Periodic operators that appear in f so that the domain \
of the new expression includes t in [tlower, tupper]. \
It relies on the Extent1D function to compute the domain \
of the arguments to the Periodic and Summation operators."
ScaleAxis::usage =
"ScaleAxis[l,w][x] represents the compression by a factor of l (an \
integer) of the continuous w axis of x, which is usually a \
continuous-frequency signal."
ScalingFactor::usage =
"ScalingFactor[expr, variable] returns the greatest common divisor \
of all coefficients of powers of z in expr. \
The powers of z that are functions of z are not considered. \
For example, ScalingFactor[ a z + a^2 z^2, z ] returns a. \
This function enables the implementation of the similarity \
property for transforms."
SequencePlot::usage =
"SequencePlot[f, {n, start, end}] plots real-valued 1-D sequences \
and has the same options as Show. \
You will have to apply Re or Im to f to plot the real or \
imaginary values of the sequence, respectively. \
SequencePlot[f, {n1, start1, end1}, {n2, start2, end2}] plots \
2-D sequences and supports the same options as Plot3D."
SequenceToFunction::usage =
"SequenceToFunction[seq], SequenceToFunction[seq, n], and \
SequenceToFunction[seq, n, noffset] return the sequence seq, \
{x[noffset], ..., x[noffset + N - 1]}, in symbolic form as a sum of \
impulse functions. \
For example, SequenceToFunction[{1, 2, 3}] -> \
Impulse[n] + 2 Impulse[n - 1] + 3 Impulse[n - 2]. \
For multidimensional sequences, the argument n must be a list of \
variables of appropriate length. \
For example, SequenceToFunction[{{1,2},{3,4}}, {n1, n2}] -> \
Impulse[n1,n2] + 2 Impulse[n1,n2-1] + 3 Impulse[n1-1,n2] + \
4 Impulse[n1-1, n2-2]."
Shift::usage =
"Shift[m,v][x] represents the shifting of the expression x by m \
samples to the right in the v direction, i.e. x[v] --> x[v - m]."
SignalPlot::usage =
"SignalPlot[f, {t, start, end}] will plot f(t) as an one-dimensional, \
continuous-time function. \
It will show the real part as solid lines, \
and the imaginary part as dashed lines. \
Delta functions are plotted as upward pointing arrows. \
SignalPlot[f, {t1, start1, end1}, {t2, start2, end2}] treats f \
as a function of two variables t1 and t2. \
SignalPlot supports the same options as Plot for 1-D signals \
(functions) and Plot3D for 2-D signals (functions)."
SignalsInOperExpr::usage =
"SignalsInOperExpr[ operator_expression ] returns the signal(s) \
of the operator in operator_expression. \
For example, { x[n] } would be returned from \
SignalsInOperExpr[ Shift[2,n][x[n]] ]. \
Another version SignalsInOperExpr[ operator_expression, operator ] \
behaves as the first version if operator is the head of \
operator_expression; otherwise, operator_expression is returned."
Sinc::usage =
"Sinc[t] is the unit sinc function which is the ratio of \
Sin[t] over t. Note that Sinc[0] = 1."
SPSimplify::usage =
"SPSimplify[e] will simplify expression e according to Mathematica's \
simplification rules and the rules in SPSimplificationRules. \
At each iteration, Simplify is called and SPSimplificationRules \
is applied to the result. \
Unlike Simplify, SPSimplify supports a Dialogue option. \
You can specify which symbols to treat as real variables by using \
the Variables option."
Step::usage =
"Step[n] is the unit step function which is 1 for n >= 0 \
and 0 otherwise. \
It is commonly used for discrete n. \
This function differs from CStep only at the origin."
Summation::usage =
"Summation[i][f], Summation[i, iend][f], and \
Summation[i, istart, iend, inc][f] represents the summation of f \
with respect to variable i: i = (istart) to (iend) step (inc). \
The Summation operator is an abstraction of Mathematica's Sum object. \
Applying the object TheFunction to a Summation operator will invoke \
the Sum object if istart, iend, and inc are numbers."
TheFunction::usage =
"TheFunction[object] returns the mathematical function embedded \
in object. \
For list and transform objects, this function returns \
the first element after the head of the object; otherwise, the \
contents of the slot TheFunction are returned. \
For signal processing operations, \
the equivalent mathematical operation is returned."
ToContinuous::usage =
"ToContinuous[expr] replaces any discrete operator or signal \
in expr with its continuous equivalent."
ToDiscrete::usage =
"ToDiscrete[expr] replaces any continuous operator or signal \
in expr with its discrete equivalent."
Unit::usage =
"Unit[n][t] is the nth order continuous unit function in t. \
Unit[0][t] is the Dirac delta function (see Delta). \
Unit[-1][t] is the continuous step function (see CStep)."
Upsample::usage =
"Upsample[k,n][f] represents the upsampling operation on f, \
which is either an expression of n or a sequence (list) of values. \
Upsampling inserts k-1 zeroes between every two samples. \
In N dimensions, n is a list of N indices and k is an N x N matrix."
UpsampledFunction::usage =
"UpsampledFunction[m, fill, n, upf] represents the upsampling of f. \
In one-dimension, the upsampled form of f, upf, \
is obtained by evaluating n -> n / m."
UpsampleFactor::usage =
"UpsampleFactor[f, n] returns the upsampling index which can be \
a negative or positive number. \
If this routine returns 1 or -1, then no upsampling has occurred; \
if it returns 0, then f is constant with respect to n."
UpsampleSequence::usage =
"UpsampleSequence[seq,m,fill] inserts m-1 fill values between \
every two elements of seq."
Z::usage =
"Z[n, z] is the forward z-transform operator. \
Applying TheFunction to the Z operator will invoke the z-transform \
rule base ZTransform if loaded."
(* E N D U S A G E I N F O R M A T I O N *)
Begin["`Private`"]
(* C O N S T A N T S *)
axesdefaultvalue = If [ TrueQ[$VersionNumber >= 2.0], True, Automatic]
(* M E S S A G E S *)
CircularShift::badlength =
"The sequence length parameter of the CircularShift \
operator must be non-zero."
DeltaPlot::unresolved = "These symbols were assigned a value of 1: ``."
Downsample::convert =
"Converting downsampling vector into a diagonal matrix: ``."
Downsample::badmD =
"Downsampling factor has different dimensions than downsampled variables."
Pulse::notsym = "Last argument to Pulse is not a symbol."
Shift::badmD =
"Shift vector has different dimensions than the specified variables."
SequencePlot::nolist =
"It does not make sense to plot a list of 2-D sequences."
SignalPlot::nolist =
"It does not make sense to plot a list of 2-D functions."
Summation::extent =
"Could not compute which part of the summation should be plotted."
Upsample::convert =
"Converting upsampling vector into a diagonal matrix: ``."
Upsample::badmD =
"Upsampling factor has different dimensions than upsampled variables."
(* L O C A L F U N C T I O N S *)
(* breakup *)
breakup[a_, z_] := a /; FreeQ[a, z]
breakup[a_Times, z_] := Select[a, breakupq[z]]
breakup[x_, z_] := 1
breakupq[z_][a_] := FreeQ[a, z]
(* gcdfilter -- rationalize floating point numbers *)
gcdfilter[x_Complex] := ToCollection[ gcdfilter[Re[x]], gcdfilter[Im[x]] ]
gcdfilter[x_Real] := Rationalize[x]
gcdfilter[x_] := x
(* informatargs and informat *)
SetAttributes[informatargs, {Listable}]
informatargs[m_, n_Symbol] := ToString[ StringForm["`` in ``", m, n] ]
informatargs[m_, n_String] := ToString[ StringForm["`` in ``", m, n] ]
informatargs[m_, n_Pattern] := ToString[ StringForm["`` in ``", m, n] ]
informat[op_, m_, n_] :=
Format[ SequenceForm[op, Subscript[ ColumnForm[ToList[informatargs[m, n]]] ]] ]
(* intdivide -- kludge for Quotient primitive which has a problem *)
(* under Mma 1.2 when the second argument is negative *)
If [ TrueQ[ $VersionNumber >= 2.0 ],
intdivide[n_, m_] := Quotient[n, m],
intdivide[n_, m_] := Sign[m] Quotient[n, m Sign[m]] ]
(* inTeXformat *)
inTeXformat[op_, m_, n_Symbol] := Subscripted[ op[m, n] ]
inTeXformat[op_, m_, n_List] := Subscripted[ op[TeXfix[m], TeXfix[n]] ]
(* TeXfix *)
TeXfix[a_?VectorQ] := MatrixForm[ Transpose[{a}] ]
TeXfix[a_] := DelimitedMatrix[ a ]
(* DelimitedMatrix *)
DelimitedMatrix/: Format[ DelimitedMatrix[a_], TeXForm ] :=
StringForm["\\left[ `` \\right]", MatrixForm[a] ]
(* D E T E R M I N A T I O N O F V A R I A B L E S *)
DummyVariables[i_, v_] :=
If [ i < 2,
v,
Table[GenerateSymbol[v, index], {index, 1, i}] ] /;
IntegerQ[i] && ( i >= 0 )
DummyVariables[i_, v_, context_] :=
If [ i < 2,
GenerateSymbol[v, " ", context],
Table[GenerateSymbol[v, index, context], {index, 1, i}] ] /;
IntegerQ[i] && ( i >= 0 )
(* F U N C T I O N S *)
(* Aliasby *)
Aliasby/: Aliasby[1, w_][x_] := x
Aliasby/: Format[ Aliasby[m_, w_] ] := informat[ Aliasby, m, w ]
Aliasby/: Format[ Aliasby[m_, w_], TeXForm ] := inTeXformat[ Aliasby, m, w ]
Aliasby/: TheFunction[ Aliasby[m_, w_][f_] ] :=
1/m Periodic[2 Pi / m, w][ TheFunction[f] ]
Aliasby/: GetOperatorVariables[ Aliasby[m_, w_] ] := w
(* CConvolve -- continuous convolution *)
CConvolve/: CConvolve[{t_Symbol}] := CConvolve[t]
CConvolve/: CConvolve[t1_, trest__] := CConvolve[{t1, trest}]
CConvolve/: CConvolve[t_Symbol] [x_, c_. Delta[t_ + m_.]] :=
(c x) /. t -> (-m) /; FreeQ[m, t]
CConvolve/: CConvolve[t_Symbol] [c_. Delta[t_ + m_.], x_] :=
(c x) /. t -> (-m) /; FreeQ[m, t]
CConvolve/: Extent1D[ CConvolve[t_][x__], t_ ] :=
Apply[ Plus, Map[ Extent1D[t], {x} ] ]
CConvolve/: CConvolve[tlist_List] [x_, c_. Delta[t_ + m_.]] :=
CConvolve[ Complement[tlist, {t}] ][x /. t -> (-m), c] /;
MemberQ[tlist, t] && FreeQ[m, t]
CConvolve/: CConvolve[tlist_List] [c_. Delta[t_ + m_.], x_] :=
CConvolve[ Complement[tlist, {t}] ][c, x /. t -> (-m)] /;
MemberQ[tlist, t] && FreeQ[m, t]
CConvolve/: CConvolve[t_][x_, z_?ZeroQ] := z
CConvolve/: CConvolve[t_][z_?ZeroQ, x_] := z
CConvolve/: Format[CConvolve[t_]] :=
Format[ Subscripted[CConvolve[t]] ]
CConvolve/: Format[CConvolve[t_][x1_, x2_], TeXForm] :=
StringForm[ "`` \\star_{``} ``", Format[x1], t, Format[x2] ]
CConvolve/: Format[CConvolve[t_][x1_, x2_, rest__], TeXForm] :=
Block [ {format, i, length, operstr, xlist},
xlist = {x1, x2, rest};
length = Length[xlist];
operstr = ToString[StringForm["\\star_{``}", t]];
str = StringJoin[" ", operstr, " ``"];
format = Apply[ StringJoin,
Table[ str, {i, 1, length} ] ];
format = StringJoin["`` ", operstr, " ``", format];
Apply[StringForm, {format, Map[Format, xlist]}] ]
(* CircularShift *)
CircularShift/: CircularShift[n0_, N_] := CircularShift[n0, N, Global`n]
CircularShift/: CircularShift[n0_, 0, n_][x_] :=
MyMessage[CircularShift::badlength, x]
CircularShift/: Extent1D[ CircularShift[n0_, N_, n_][f_], n_ ] := { 0, N-1 }
CircularShift/: TheFunction[ CircularShift[n0_Integer, N_Integer, n_][f_List] ] :=
RotateRight[ Take[f, N], n0 ]
CircularShift/: TheFunction[ CircularShift[n0_, N_, n_][f_] ] :=
TheFunction[f Pulse[N, n]] /. ( n -> Mod[n + n0, N] )
CircularShift/: N[ CircularShift[n0_, N_, n_][f_] ] :=
N[ TheFunction[CircularShift[n0, N, n][f]] /. ( n -> Mod[n + n0, N] ) ]
CircularShift/: Format[ CircularShift[n0_, N_, n_] ] :=
informat[CircularShift, Mod[n + n0, N], n]
CircularShift/: Format[ CircularShift[m_,n_], TeXForm ] :=
inTeXformat[CircularShift, Mod[n + n0, N], n]
(* CPulse *)
CPulse[l_] := CPulse[l, Global`t] (* default args *)
CPulse/: CPulse[l_, t_] := 1 /; N[0 < t < l] (* definition *)
CPulse/: CPulse[l_, t_] := 0 /; N[(t < 0) || (t > l)]
CPulse/: CPulse[l_, t_] := 1/2 /; N[(t == 0) || (t == l)]
CPulse/: CPulse[Infinity, t_] := CStep[t]
CPulse/: TheFunction[CPulse[l_, t_]] := CStep[t] - CStep[t - l]
CPulse/: Extent1D[ CPulse[l_, a_. t_ + b_.], t_ ] :=
Which [ Positive[a], {-b/a, (l-b)/a},
Negative[a], {(l-b)/a, -b/a},
True, Extent1DOrder[-b/a, (l-b)/a] ] /;
FreeQ[{a,b,l}, t]
CPulse/: Format[ CPulse[l_, n_] ] := (* output forms *)
Format[ CPulse Subscript[l] [n] ]
CPulse/: Format[ CPulse, TeXForm ] := "\\sqcap"
CPulse/: Format[ CPulse[l_, n_], TeXForm ] :=
StringForm[ "\\sqcap_{``} (``)", l, n ]
Derivative[0,1][CPulse] := (* derivative rule *)
( Delta[#2] + Delta[#2 - #1] )&
Unprotect[Integrate] (* integration rules *)
Integrate/: Integrate[f_. CPulse[L_, a_. x_ + b_.] + c_.,
vars1___, x_Symbol, vars2___] :=
1/a CPulse[a x + b] ( Integrate[f, vars1, x, vars2] /. x -> a x + b ) +
Integrate[c, vars1, x, vars2] /;
FreeQ[{a, b, L}, x]
Integrate/: Integrate[expr_. CPulse[L_, a_. x_ + b_.] + c_.,
vars1___, {x_Symbol, x1_, x2_}, vars2___] :=
Sign[x2 - x1] *
cpulseintersect[ Min[x1, x2], Max[x1, x2],
Min[-b/a, (L - b)/a], Max[-b/a, (L - b)/a] ] *
Integrate[expr,
vars1,
{x, Max[Min[x1,x2], Min[-b/a, (L - b)/a]],
Min[Max[x1,x2], Max[-b/a, (L - b)/a]]},
vars2] +
Integrate[c, vars1, {x, x1, x2}, vars2] /;
FreeQ[{a, b, L}, x]
Protect[Integrate]
cpulseintersect[x1_, x2_, x3_, x4_] := Step[x4 - x1] Step[x2 - x3]
(* CStep *)
CStep/: CStep[Infinity] := 1 (* definition *)
CStep/: CStep[t_] := 1 /; N[ t > 0 ]
CStep/: CStep[t_] := 0 /; N[ t < 0 ]
CStep/: CStep[0] := 1/2
CStep/: CStep[0.] := 0.5
CStep/: CStep[-Infinity] := 0
CStep/: Extent1D[ CStep[a_. t_ + b_.], t_ ] :=
Which [ Positive[a], {-b/a, Infinity},
Negative[a], {-Infinity, -b/a},
True, Extent1DOrder[-b/a, Sign[a] Infinity] ] /;
FreeQ[{a,b,l}, t]
CStep/: CStep[t_, args__] := CStep[t] CStep[args] (* multidimensional *)
CStep/: CStep[List[args__]] := CStep[args] (* separability *)
CStep/: CStep[n_Symbol + m_.] CStep[n_Symbol + k_.] := (* automatic *)
CStep[n + Min[m,k]] /; (* simplification *)
NumberQ[m] && NumberQ[k] (* rules *)
CStep/: CStep[n_Symbol + m_.] CStep[-n_Symbol + k_.] :=
CPulse[k + m, n + m] /;
N[ -m <= k ]
CStep/: CStep[n_Symbol + m_.] CStep[-n_Symbol + k_.] := 0 /;
N[ -m > k ]
CStep/: Simplify[CStep[a_ n_Symbol + b_.]] := (* man. simp. rules *)
CStep[n + b/a] /;
MyFreeQ[{a,b}, n] && Implies[ NumberQ[N[a]], N[a > 0] ]
CStep/: Simplify[CStep[- a_ n_Symbol + b_.]] :=
CStep[-n + b/a] /;
MyFreeQ[{a,b}, n] && Implies[ NumberQ[N[a]], N[a > 0] ]
CStep/: Format[ CStep, TeXForm ] := "u_{-1}" (* output form *)
Derivative[1][CStep] := Delta (* derivative rule *)
Unprotect[Integrate] (* integration rules *)
Integrate/: Integrate[f_. CStep[a_. x_ + b_.] + c_.,
vars1___, x_Symbol, vars2___] :=
1/a CStep[a x + b] ( Integrate[f, vars1, x, vars2] /. x -> a x + b ) +
Integrate[c, vars1, x, vars2] /;
FreeQ[{a, b}, x]
Integrate/: Integrate[expr_. CStep[a_. x_ + b_.] + c_.,
vars1___, {x_Symbol, x1_, x2_}, vars2___] :=
Sign[x2 - x1] *
cstepintersect[x1, x2, a, b] *
Integrate[expr,
vars1,
{x, csteplbound[x1, x2, a, b], cstepubound[x1, x2, a, b]},
vars2] +
Integrate[c, vars1, {x, x1, x2}, vars2] /;
FreeQ[{a, b}, x]
Protect[Integrate]
cstepintersect[x1_, x2_, a_, b_] :=
If [ Positive[a],
Step[Max[x1, x2] + b/a],
Step[-b/a - Min[x1,x2]] ]
csadj[x_] := x //. SignalProcessing`Support`SupCode`Private`MinMaxRules
csteplbound[x1_, x2_, a_, b_] := csadj[Max[Min[x1, x2], -b/a]] /; Positive[a]
csteplbound[x1_, x2_, a_, b_] := csadj[Min[x1, x2]] /; Negative[a]
cstepubound[x1_, x2_, a_, b_] := csadj[Max[x1, x2]] /; Positive[a]
cstepubound[x1_, x2_, a_, b_] := csadj[Min[Max[x1, x2], -b/a]] /; Negative[a]
Format[csteplbound[x1_, x2_, a_, b_]] :=
SequenceForm["LeftEndpointOf[", {x1,x2}, " and step at ", -b/a, "]"]
Format[cstepubound[x1_, x2_, a_, b_]] :=
SequenceForm["RightEndpointOf[", {x1,x2}, " and step at ", -b/a, "]"]
(* Convolve -- discrete convolution *)
Convolve/: Convolve[{n_Symbol}] := Convolve[n]
Convolve/: Convolve[n1_, nrest__] := Convolve[{n1, nrest}]
Convolve/: Convolve[n_] [x_, c_. Impulse[n_ + m_.]] :=
(c x) /. n -> (-m) /; FreeQ[m, t]
Convolve/: Convolve[n_] [c_. Impulse[n_ + m_.], x_] :=
(c x) /. n -> (-m) /; FreeQ[m, t]
Convolve/: Extent1D[ Convolve[n_][x__], n_ ] :=
Apply[ Plus, Map[ Extent1D[n], {x} ] ]
Convolve/: Convolve[nlist_List] [x_, c_. Impulse[n_ + m_.]] :=
Convolve[ Complement[nlist, {n}] ][x /. n -> (-m), c] /;
MemberQ[nlist, n] && FreeQ[m, n]
Convolve/: Convolve[nlist_List] [c_. Impulse[n_ + m_.], x_] :=
Convolve[ Complement[nlist, {n}] ][c, x /. n -> (-m)] /;
MemberQ[nlist, n] && FreeQ[m, n]
Convolve/: Convolve[n_][x_, z_?ZeroQ] := z
Convolve/: Convolve[n_][z_?ZeroQ, x_] := z
(* Formatting the convolution operator *)
Convolve/: Format[Convolve[n_]] :=
Format[ Subscripted[Convolve[n]] ]
Convolve/: Format[Convolve[n_][x1_, x2_], TeXForm] :=
StringForm[ "`` \\star_{``} ``", Format[x1], n, Format[x2] ]
Convolve/: Format[Convolve[n_][x1_, x2_, rest__], TeXForm] :=
Block [ {format, i, length, operstr, xlist},
xlist = {x1, x2, rest};
length = Length[xlist];
operstr = ToString[StringForm["\\star_{``}", n]];
str = StringJoin[" ", operstr, " ``"];
format = Apply[ StringJoin,
Table[ str, {i, 1, length} ] ];
format = StringJoin["`` ", operstr, " ``", format];
Apply[StringForm, {format, Map[Format, xlist]}] ]
(* Delta *)
Delta/: Delta[Infinity] := 0 (* definition *)
Delta/: Delta[t_] := 0 /; N[ t != 0 ]
Delta/: Delta[-Infinity] := 0
Delta/: Delta[a_. x_Symbol + b_.] Delta[c_. x_ + d_.] := 0 /; ( b c != a d )
Delta/: Delta[a_. x_Symbol + b_.] Delta[a_. x_ + d_.] := 0 /; ( b != d )
Delta/: Extent1D[ Delta[a_. t_ + b_.], t_ ] := { -b/a, -b/a } /;
FreeQ[{a,b}, t]
Delta/: Delta[t_, args__] := Delta[t] Delta[args] (* multidimensional *)
Delta/: Delta[List[args__]] := Delta[args] (* separability *)
Delta/: Format[ Delta, TeXForm ] := "\\delta" (* output form *)
Derivative[1][Delta] := Unit[1] (* derivative rule *)
(* The following Delta rules were written by John Mitchell *)
(* and modified by Brian Evans. *)
getivars[ x_Symbol ] := x
getivars[ {x_Symbol, xl_, xu_} ] := x
Unprotect[Integrate] (* integration rules *)
Integrate/: Integrate[a_. + expr_. Delta[term_], vars_] :=
Integrate[a, vars] + DeltaIntegrate[expr Delta[term], vars] /;
! FreeQ[ term, getivars[vars] ]
Integrate/: Integrate[a_. + expr_. Delta[term_], vars1___, vars_, vars2___] :=
Integrate[a, vars1, vars, vars2] +
Integrate[ DeltaIntegrate[expr Delta[term], vars], vars1, vars2 ] /;
! FreeQ[ term, getivars[vars] ]
Protect[Integrate]
(* DeltaIntegrate *)
DeltaIntegrate[expr_. Delta[a_. x_ + b_.], x_Symbol] :=
Limit[expr, x -> -b/a] CStep[x + b/a] / Abs[a] /;
FreeQ[{a,b}, x] && FreeQ[expr, Delta]
DeltaIntegrate[expr_. Delta[a_. x_ + b_.], {x_Symbol, x1_, x1_}] := 0
DeltaIntegrate[expr_. Delta[a_ x_ + b_.], {x_Symbol, x1_, x2_}] :=
If [ N[x1 > x2],
-1 DeltaIntegrate[expr Delta[a x + b], {x, x2, x1}],
Integrate[expr Delta[x + b/a] / Abs[a], {x, x1, x2}],
Integrate[expr Delta[x + b/a] / Abs[a], {x, x1, x2}] ] /;
FreeQ[{a,b}, x] && FreeQ[expr, Delta]
DeltaIntegrate[expr_. Delta[x_ + c_.], {x_Symbol, x1_, x2_}] :=
If [ N[x1 > x2],
-1 DeltaIntegrate[expr Delta[x + c], {x, x2, x1}],
Limit[expr, x -> -c] CStep[-c - x1] CStep[c + x2],
Limit[expr, x -> -c] CStep[-c - x1] CStep[c + x2] ] /;
FreeQ[c, x] && FreeQ[expr, Delta]
(* CStep[-c - x1] CStep[c + x2] <--> x1 <= -c <= x2 *)
DeltaIntegrate[Delta[a_. x_ + b_.] Delta[c_.x_ + d_.],
{x_Symbol, x1_, x2_}] :=
If [ N[x1 > x2],
-1 DeltaIntegrate[Delta[a x + b] Delta[c x + d], {x, x2, x1}],
(1/Abs[a c]) Delta[-b/a + d/c] *
CStep[-(b/a) - x1] CStep[(b/a) + x2],
(1/Abs[a c]) Delta[-b/a + d/c] *
CStep[-(b/a) - x1] CStep[(b/a) + x2] ] /;
FreeQ[{a,b,c,d}, x]
DeltaIntegrate[Delta[a_. x_ + b_.]^2, {x_Symbol, x1_, x2_}] :=
If [ N[x1 > x2],
-1 DeltaIntegrate[Delta[a x + b]^2, {x, x2, x1}],
(1/a^2) Delta[0] CStep[-(b/a) - x1] CStep[(b/a) + x2],
(1/a^2) Delta[0] CStep[-(b/a) - x1] CStep[(b/a) + x2] ] /;
FreeQ[{a,b}, x]
(* DeltaPlot-- plot Delta functions as special case of continuous plotting *)
dpcleanup[deltafuns_, t_, tmin_, tmax_] :=
Block [ {delfuns, varlist = {}},
delfuns = deltafuns /.
( d_ Summation[index_, istart_, iend_, inc_][c_] :>
Summation[index, istart, iend, inc][c d] );
delfuns = delfuns /.
{ Summation[index_, istart_, iend_, inc_]
[c_. Delta[b_. t + a_.]] :>
Block [ {aa = a, adjfun, bb = b, cc = c, defaults, f1, f2,
i, indexfunoft, minindex, maxindex, rules, varlist},
varlist = Select[GetVariables[{a, b, c}],
((! SameQ[#1, t]) &&
(! SameQ[#1, index]))&];
If [ ! EmptyQ[varlist],
defaults = Map[(#1 -> 1)&, varlist];
aa = a /. defaults;
bb = b /. defaults;
cc = c /. defaults ];
rules = Solve[ bb t + aa == 0, index ];
indexfunoft = Replace[index, First[rules] ];
f1 = N[ indexfunoft /. t -> tmin ];
f2 = N[ indexfunoft /. t -> tmax ];
minindex = Max[istart, inc Floor[Min[f1, f2] / inc]];
maxindex = Min[iend, inc Ceiling[Max[f1, f2] / inc]];
adjfun = ((cc /. t -> - aa / bb) Delta[bb t + aa]) /.
index -> i;
Apply[Plus,
Table[adjfun, {i, minindex, maxindex, inc}]]] };
varlist = Sort[ varlist ~Join~
Select[ GetVariables[delfuns],
(! SameQ[#1, t])& ] ];
If [ ! EmptyQ[varlist],
Message[ DeltaPlot::unresolved, varlist ];
delfuns = delfuns /. Map[(#1 -> 1)&, varlist] ];
delfuns ]
getlocation[ c_. Delta[a_. t_ + b_.], t_ ] := N[ - b / a ]
DeltaPlot[deltafuns_, t_, start_, end_] :=
DeltaPlot[deltafuns, t, start, end, 0, 1]
DeltaPlot[deltafuns_, t_, start_, end_, plot_] := plot /;
FreeQ[deltafuns, t]
(* Use PlotRange as function to find range of plot [see MJ v1 #4 p47] *)
DeltaPlot[deltafuns_, t_, start_, end_, plot_] :=
Block [ {xmax, xmin, ylist, ymax, ymin},
{{xmin, xmax}, {ymin, ymax}} = PlotRange[plot];
DeltaPlot[deltafuns, t, start, end, plot, ymin, ymax] ]
DeltaPlot[deltafuns_, t_, start_, end_, min_, max_] := NullPlot /;
FreeQ[deltafuns, t]
(* every version of DeltaPlot calls this one *)
DeltaPlot[deltafuns_, t_, start_, end_, min_, max_] :=
Block [ {bottom, delfuns, height, length,
locations, nend, nstart, points, width},
nstart = N[start];
nend = N[end];
delfuns = Expand[ dpcleanup[deltafuns, t, nstart, nend] ];
height = N[max - min];
width = nend - nstart;
points = If [ SameQ[Head[delfuns], Plus],
Map[getlocation[#1, t]&, Apply[List, delfuns]],
{ getlocation[delfuns, t] } ];
locations = Select[ points, N[LessEqual[nstart, #1, nend]]& ];
If [ min <= 0,
bottom = 0; length = max,
bottom = min; length = height ];
length = Min[height, max];
If [ SameQ[locations, {}],
NullPlot,
Map [ Arrow2D[{#1, bottom}, width, height, length]&,
locations ] ] ]
DeltaPlot[deltafuns_, t_, start_, end_, plot_, min_, max_] :=
Block [ {deltaplot, ymax = max, ymin = min},
If [ ymax == ymin,
Which [ ymin > 0, ymin = -ymax,
ymin == 0, ymax = 1,
ymin < 0, ymax = -ymin ] ];
deltaplot = DeltaPlot[deltafuns, t, start, end, ymin, ymax];
If [ SameQ[deltaplot, NullPlot],
plot,
Prepend[ deltaplot, plot ] ] ]
(* Difference *)
Difference/: TheFunction[Difference[k_, n_][f_]] :=
Block [ {jj, newf},
newf = TheFunction[f] /. n ~ReplaceWith~ (n - jj);
Apply[ Plus,
Table[(-1)^jj Binomial[k,jj] newf, {jj, 0, k}] ] ] /;
IntegerQ[k] && k > 0
Difference/: Extent1D[ Difference[k_, n_][f_], n_ ] := Extent1D[f, n]
Difference/: N[Difference[1, n_][f_]] := f - ( f /. n ~ReplaceWith~ (n - 1) )
Difference/: N[Difference[k_,n_][f_]] :=
Apply[Plus,
Table[(-1)^jj Binomial[k,jj] f /. n ~ReplaceWith~ (n - jj),
{jj, 0, k}] ] /;
IntegerQ[k] && k > 0
Difference/: Format[ Difference[k_, n_] ] := informat[Difference, k, n]
Difference/: Format[ Difference, TeXForm ] := "\\Delta"
Difference/: Format[ Difference[k_,n_], TeXForm ] :=
inTeXformat[ Difference, k, n ]
Difference/: GetOperatorVariables[ Difference[k_, n_] ] := n
(* Dirichlet *)
Dirichlet/: Dirichlet[len_, 0] := len (* definition *)
Dirichlet/: Dirichlet[len_, k_?EvenQ Pi] := len (-1)^(len - 1)
Dirichlet/: Dirichlet[len_Integer, w_?NumberQ] :=
Sin[len w / 2] / ( len Sin[w / 2] )
Dirichlet/: TheFunction[Dirichlet[len_, w_]] :=
Sin[len w / 2] / ( len Sin[w / 2] )
Dirichlet/: N[ Dirichlet[len_, w_] ] := N [ TheFunction[Dirichlet[len, w]] ]
Dirichlet/: Format[ Dirichlet[l_, n_] ] := (* output forms *)
Format[ Dirichlet Subscript[l] [n] ]
(* DiscreteGraphics *)
oneline[xycoord_] :=
ToCollection[ Line[{{xycoord[[1]], 0}, xycoord}], Point[xycoord] ]
DiscreteGraphics[coordlist_List, lthick_:0.008, pthick_:0.024 ] :=
Graphics[ Join[ { Thickness[lthick], PointSize[pthick] },
N [ Map[oneline, coordlist] ] ] ]
(* Downsample [Myers, 219] [Bamberger, ch. 2] *)
(* Error checking of downsample parameters *)
Downsample/: Downsample[m_List, n_List][f_] :=
MyMessage[ Downsample::convert,
Downsample[DiagonalMatrix[m], n][f],
m ] /;
VectorQ[m] && SameQ[Length[m], Length[n]] && ! PatternQ
Downsample/: Downsample[m_List, n_List][f_] :=
MyMessage[Downsample::badmD, f] /;
VectorQ[m] && ! SameQ[Length[m], Length[n]]
Downsample/: Downsample[m_List, n_List][f_] :=
MyMessage[Downsample::badmD, f] /;
MatrixQ[m] && ! Apply[SameQ, Append[Dimensions[m], Length[n]]]
Downsample/: Downsample[m_List, n_Symbol][f_] :=
MyMessage[Downsample::badmD, f]
(* degenerate cases *)
Downsample/: Downsample[1, n_Symbol][c_] := c
Downsample/: Downsample[-1, n_Symbol][c_] := Rev[n][c]
(* convert upsample into a functional form *)
Downsample/: TheFunction[Downsample[m_, n_Symbol][f_]] :=
TheFunction[f] /. ( n -> m n )
Downsample/: TheFunction[Downsample[m_, n_List][f_]] :=
TheFunction[f] /. ( n ~ReplaceWith~ (m . n) ) /;
MatrixQ[m] && VectorQ[n]
Downsample/: N [ Downsample[m_, n_][f_] ] :=
N [ TheFunction[Downsample[m,n][f]] ]
(* extent of downsample operation *)
Downsample/: Extent1D[ Downsample[m_, n_][f_], n_ ] :=
intdivide[ Extent1D[f, n], m ]
(* formatting of the downsample operator *)
Downsample/: Format[ Downsample[m_, n_List] ] :=
Block [ {bar},
bar = TableForm[ Apply[ Table,
{ " | ", Dimensions[n] } ] ];
Format[ SequenceForm[ Downsample,
Subscript[ TableForm[m] ],
Subscript[ bar ],
Subscript[ TableForm[n] ] ] ] ]
Downsample/: Format[ Downsample[m_, n_] ] :=
Format[ Subscripted[Downsample[m,n]] ]
Downsample/: Format[ Downsample, TeXForm ] := "\\downarrow"
Downsample/: Format[ Downsample[m_, n_], TeXForm ] :=
inTeXformat[ Downsample, m, n ]
Downsample/: GetOperatorVariables[ Downsample[m_, n_] ] := n
(* DFT [Myers, 221] *)
DFT/: DFT[L_, n_] := DFT[L, n, DummyVariables[Length[n], Global`k]]
DFT/: DFT[L_, n_, k_] [ InvDFT[L_, ki_, n_] [f_] ] :=
If [ SameQ[k, ki], f, f /. ReplaceWith[ki, k] ] /;
Length[k] == Length[ki]
DFT/: DFT^-1[a__] := InvDFT[a]
DFT/: Format[ DFT, TeXForm ] := "{\\cal DFT}"
DFT/: Format[ DFT[L_, n_, k_], TeXForm ] :=
StringForm[ "{\\cal DFT}_{``, L = ``}", n, L]
DFT/: GetOperatorVariables[ DFT[L_, n_, k_] ] := n
DFT/: Extent1D[ DFT[L_, n_, k_][f_], n_ ] := {0, L}
DFT/: Extent1D[ DFT[L_, n_, k_][f_], k_ ] := {0, L}
(* DTFT *)
DTFT/: DTFT[n_] := DTFT[n, DummyVariables[Length[n], Global`w]]
DTFT/: DTFT[n_, w_] [ InvDTFT[wi_, n_] [f_] ] :=
If [ SameQ[w, wi], f, f /. ReplaceWith[wi, w] ] /;
Length[w] == Length[wi]
DTFT/: DTFT^-1[a__] := InvDTFT[a]
DTFT/: Format[ DTFT, TeXForm ] := "{\\cal DTFT}"
DTFT/: Format[ DTFT[n_, w_], TeXForm ] := StringForm[ "{\\cal DTFT}_{``}", n ]
(* Extent1D *)
Extent1DUnion[ {x1_, y1_}, {x2_, y2_} ] := { Min[x1, x2], Max[y1, y2] }
Extent1DIntersection[ {x1_, y1_}, {x2_, y2_} ] := { Max[x1, x2], Min[y1, y2] }
Extent1DOrder[ x1_, y1_ ] := { Min[x1, y1], Max[x1, y1] }
Extent1D[t_][x_] := Extent1D[x, t]
Extent1D[x_ + y_, n_] := Extent1DUnion[ Extent1D[x, n], Extent1D[y, n] ]
Extent1D[x_ y_, n_] := Extent1DIntersection[ Extent1D[x, n], Extent1D[y, n] ]
Extent1D[0, n_] := {0, 0}
Extent1D[x_, n_] := {-Infinity, Infinity}
(* FT *)
FT/: FT[n_] := FT[n, DummyVariables[Length[n], Global`w]]
FT/: FT[n_, w_] [ InvFT[wi_, n_] [f_] ] :=
If [ SameQ[w, wi], f, f /. ReplaceWith[wi, w] ] /;
Length[w] == Length[wi]
FT/: FT^-1[a__] := InvFT[a]
FT/: Format[ FT, TeXForm ] := "{\\cal F}"
FT/: Format[ FT[n_, w_], TeXForm ] := StringForm[ "{\\cal F}_{``}", n ]
(* GetDeltaFunctions *)
choose[{a_, aterm_}] := If [ SameQ[aterm, 0], a, aterm ]
(* rules specific for 1-D functions of t *)
GetDeltaFunctions[ c_. Delta[a_. t_Symbol + b_.], t_Symbol ] :=
c Delta[a t + b]
(* rules specific for m-D functions of t1, t2, ... *)
GetDeltaFunctions[ c_. Delta[a_. t_Symbol + b_.], tlist_List ] :=
c Delta[a t + b] /;
MemberQ[tlist, t]
(* rules for all dimensions *)
GetDeltaFunctions[ a_ + b_, rest__ ] :=
GetDeltaFunctions[a, rest] + GetDeltaFunctions[b, rest]
GetDeltaFunctions[ h_[b__], rest__ ] :=
Block [ {arglist, deltalist},
arglist = {b};
deltalist = Map[ GetDeltaFunctions[#1, rest]&, arglist ];
If [ SameQ[Apply[Plus, deltalist], 0],
0,
Apply[h, Map[choose, Transpose[{arglist, deltalist}]]] ] ]
GetDeltaFunctions[ x_, rest__ ] := 0
(* Impulse *)
Impulse/: Impulse[Infinity] := 0 (* definition *)
Impulse/: Impulse[n_] := 0 /; N[ n != 0 ]
Impulse/: Impulse[n_] := 1 /; N[ n == 0 ]
Impulse/: Impulse[-Infinity] := 0
Impulse/: Extent1D[ Impulse[a_. n_ + b_.], n_ ] := { -b/a, -b/a } /;
FreeQ[{a,b}, n]
Impulse/: Impulse[n_, args__] := Impulse[n] Impulse[args] (* multidimensional *)
Impulse/: Impulse[List[args__]] := Impulse[args] (* separability *)
Impulse/: Format[ Impulse[n_], TeXForm ] := (* output form rule *)
StringForm["\\delta[``]", n]
(* Interleave [Myers, 219-220] *)
Interleave/: Interleave[n_][x_] := x (* definition *)
Interleave/: TheFunction[Interleave[n_][x1_, x__]] :=
Block [ {index = Unique["k"], L, xlist},
xlist = List[x1, x];
L = Length[xlist];
Summation[index, 0, L-1, 1]
[ Shift[index, n] [Upsample[L, n]
[ Element[xlist, index + 1] ] ] ] ]
Interleave/: N [ Interleave[n_][x1_, x__] ] :=
N [ TheFunction[Interleave[n][x1,x]] ]
Interleave/: Format[ Interleave[n_] ] := (* output form rules *)
Format[ Subscripted[Interleave[n]] ]
Interleave/: Format[ Interleave[n_], TeXForm ] :=
Format[ Subscripted[Interleave[n]] ]
(* IntervalsToFunction *)
IntervalsToFunction[interlist_, n_:Global`n, step_:Step, pulse_:Pulse] :=
Block [ {int, len, signal},
MakeOne[interval_] :=
Block [
{f, nminus, nplus, pulselen},
f = interval[[1]];
nminus = interval[[2]];
nplus = interval[[3]];
pulselen = nplus - nminus + 1;
Which [ SameQ[nminus, -Infinity],
f step[nplus - n],
SameQ[nplus, Infinity],
f step[n - nminus],
True,
f pulse[pulselen, n - nminus] ] ];
len = Length[interlist];
signal = MakeOne[ interlist[[1]] ];
For [ int = 2, int <= len, int++,
signal += MakeOne[ interlist[[int]] ] ];
signal ]
(* InvDFT [Myers, 221] *)
InvDFT/: InvDFT[L_, k_] :=
InvDFT[L, k, DummyVariables[Length[k], Global`n]]
InvDFT/: InvDFT[L_, k_, ni_] [ DFT[L_, n_, k_] [f_] ] :=
If [ SameQ[ni, n], f, f /. ReplaceWith[n, ni] ] /;
Length[ni] == Length[n]
InvDFT/: Format[ InvDFT, TeXForm ] := "{\\cal DFT}^{-1}"
InvDFT/: Format[ InvDFT[L_, k_, n_], TeXForm ] :=
StringForm[ "{\\cal DFT}^{-1}_{``, L = ``}", k, L ]
InvDFT/: GetOperatorVariables[ InvDFT[L_, k_, n_] ] := k
InvDFT/: Extent1D[ InvDFT[L_, k_, n_][f_], n_ ] := {0, L}
InvDFT/: Extent1D[ InvDFT[L_, k_, n_][f_], k_ ] := {0, L}
(* InvDTFT *)
InvDTFT/: InvDTFT[w_] := InvDTFT[w, DummyVariables[Length[w], Global`n]]
InvDTFT/: InvDTFT[w_, ni_] [ DTFT[n_, w_] [f_] ] :=
If [ SameQ[ni, n], f, f /. ReplaceWith[n, ni] ] /;
Length[ni] == Length[n]
InvDTFT/: Format[ InvDTFT, TeXForm ] := "{\\cal DTFT}^{-1}"
InvDTFT/: Format[ InvDTFT[w_, n_], TeXForm ] :=
StringForm[ "{\\cal DTFT}^{-1}_{``}", w ]
(* InvFT *)
InvFT/: InvFT[w_] := InvFT[w, DummyVariables[Length[w], Global`t]]
InvFT/: InvFT[w_, ti_] [ FT[t_, w_] [f_] ] :=
If [ SameQ[ti, t], f, f /. ReplaceWith[t, ti] ] /;
Length[ti] == Length[t]
InvFT/: Format[ InvFT, TeXForm ] := "{\\cal F}^{-1}"
InvFT/: Format[ InvFT[w_, t_], TeXForm ] :=
StringForm[ "{\\cal F}^{-1}_{``}", w ]
(* InvL *)
InvL/: InvL[s_] := InvL[s, DummyVariables[Length[s], Global`t]]
InvL/: InvL[s_, ti_] [ L[t_, s_] [f_] ] :=
If [ SameQ[ti, t], f, f /. ReplaceWith[t, ti] ] /;
Length[t] == Length[ti]
InvL/: Format[ InvL, TeXForm ] := "{\\cal L}^{-1}"
InvL/: Format[ InvL[s_, t_], TeXForm ] := StringForm[ "{\\cal L}^{-1}_{``}", s ]
(* InvZ [Myers, 221] *)
InvZ/: InvZ[zi_] := InvZ[zi, DummyVariables[Length[zi], Global`n]]
InvZ/: InvZ[z_, ni_] [ Z[n_, z_] [f_] ] :=
If [ SameQ[ni, n], f, f /. ReplaceWith[n, ni] ] /;
Length[n] == Length[ni]
InvZ/: Format[ InvZ[z_, n_], TeXForm ] := "{\\cal Z}^{-1}"
InvZ/: Format[ InvZ[z_, n_], TeXForm ] := StringForm[ "{\\cal Z}^{-1}_{``}", z ]
(* L *)
L/: L[t_] := L[t, DummyVariables[Length[t], Global`s]]
L/: L[t_, s_] [ InvL[si_, t_] [f_] ] :=
If [ SameQ[s, si], f, f /. ReplaceWith[si, s] ] /;
Length[s] == Length[si]
L/: L^-1[a__] := InvL[a]
L/: Format[ L, TeXForm ] := "{\\cal L}"
L/: Format[ L[t_, s_], TeXForm ] := StringForm[ "{\\cal L}_{``}", t ]
(* LineImpulse *)
Unprotect[samecoefficient];
Unprotect[mergecoefficient];
SetAttributes[samecoefficient, Listable];
samecoefficient[c1_, c2_] :=
If [ SameQ[c1,c2],
! SameQ[c1, Null],
SameQ[c1, Null] || SameQ[c2, Null] ]
SetAttributes[mergecoefficient, Listable];
mergecoefficient[c1_, c2_] :=
Which [ SameQ[c1, Null], c2,
SameQ[c2, Null], c1,
True, c1 ]
Protect[samecoefficient];
Protect[mergecoefficient];
LineImpulseMerge[nlist_, ncoeffs_, klist_, kcoeffs_] :=
Block [ {commonvars, kscale, nscale, scaledkcoeffs, scaledncoeffs},
scaledncoeffs = ncoeffs;
scaledkcoeffs = kcoeffs;
commonvars = Intersection[nlist, klist];
If [ ! EmptyQ[commonvars],
normvar = First[commonvars];
nscale = AssociateItem[normvar, nlist, ncoeffs];
scaledncoeffs = ncoeffs / nscale;
kscale = AssociateItem[normvar, klist, kcoeffs];
scaledkcoeffs = kcoeffs / kscale ];
allvars = Union[nlist, klist];
coeffs1 = AssociateItem[allvars, nlist, scaledncoeffs];
coeffs2 = AssociateItem[allvars, klist, scaledkcoeffs];
{ Apply[And, samecoefficient[coeffs1, coeffs2]],
LineImpulse[allvars, mergecoefficient[coeffs1, coeffs2]] } ]
LineImpulse/: LineImpulse[n_?AtomQ, c_] := Impulse[c n]
LineImpulse/: LineImpulse[nlist_, ncoeffs_] LineImpulse[klist_, kcoeffs_] :=
LineImpulseMerge[nlist, ncoeffs, klist, kcoeffs] [[2]] /;
! EmptyQ[Intersection[nlist,klist]] && LineImpulseMerge[nlist, ncoeffs, klist, kcoeffs] [[1]]
LineImpulse/: TheFunction[ LineImpulse[nlist_, ncoeffs_] ] :=
Impulse[ Apply[Plus, nlist, ncoeffs] ]
LineImpulse/: N [ LineImpulse[nlist_, ncoeffs_] ] :=
N [ TheFunction[ LineImpulse[nlist, ncoeffs] ] ]
LineImpulse/: Format[ LineImpulse[nlist_List, ncoeffs_List] ] :=
Format[Impulse[Apply[Plus, nlist ncoeffs]]] /;
Length[nlist] == Length[ncoeffs]
(* OperatorInOperExpr *)
OperatorInOperExpr[ h_[a__][s__] ] := h[a]
OperatorInOperExpr[ h_[s__] ] := h
(* OperatorName *)
OperatorName[ h_[a__][s__] ] := h
OperatorName[ h_[a__] ] := h
OperatorName[ x_ ] := x
(* ParametersInOperExpr *)
ParametersInOperExpr[ h_[a__][s__] ] := a
ParametersInOperExpr[ h_[s__] ] := Null
(* Periodic *)
Periodic/: Format[ Periodic[k_, n_] ] := informat[Periodic, k, n]
Periodic/: Format[ Periodic[k_, n_], TeXForm ] := inTeXformat[Perodic, k, n]
Periodic/: GetOperatorVariables[ Periodic[k_, n_] ] := n
(* PolyphaseDownsample *)
PolyphaseDownsample/: GetOperatorVariables[ PolyphaseDownsample[m_, h_, n_] ] := n
(* PolyphaseUpsample *)
PolyphaseUpsample/: GetOperatorVariables[ PolyphaseUpsample[l_, h_, n_] ] := n
(* Pulse *)
Pulse[l_] := Pulse[l, Global`n] (* default args *)
Pulse[0, n_] := 0 (* definition *)
Pulse[1, n_] := Impulse[n]
Pulse[Infinity, n_] := Step[n]
Pulse/: Pulse[l_, n_] := 1 /; N[0 <= n < l]
Pulse/: Pulse[l_, n_] := 0 /; N[( n < 0 ) || ( n >= l )]
Pulse/: TheFunction[Pulse[l_, n_]] := Step[n] - Step[n - l]
Pulse/: Extent1D[ Pulse[l_, a_. n_ + b_.], n_ ] :=
Which [ Positive[a], {-b/a, (l-b)/a},
Negative[a], {(l-b)/a, -b/a},
True, Extent1DOrder[-b/a, (l-b)/a] ] /;
FreeQ[{a,b,l}, n]
Pulse/: Format[ Pulse[l_, n_] ] := (* output forms *)
Format[ Pulse Subscript[l] [n] ]
Pulse/: Format[ Pulse, TeXForm ] := "\\sqcap"
Pulse/: Format[ Pulse[l_, n_], TeXForm ] :=
StringForm[ "\\sqcap_{``} [``]", l, n ]
Derivative[0,1][Pulse] := (* derivative rule *)
( Impulse[#2] + Impulse[#2 - #1] )&
(* RationalGCD *)
RationalGCD[ ] := 0
RationalGCD[ x_ ] := x
RationalGCD[ arg1_, rest__ ] := rationalGCD[{arg1, rest}]
rationalGCD[ numlist_List ] :=
Block [ {denomgcd, gcdfun, gcdlist, newlist, numergcd},
newlist = Flatten[numlist];
gcdlist = Map[ gcdfilter, newlist ];
gcdfun = If [ TrueQ[$VersionNumber >= 2.0],
PolynomialGCD, GCD ];
numergcd = Apply[gcdfun, Map[Numerator, gcdlist]];
denomgcd = Apply[gcdfun, Map[Denominator, gcdlist]];
numergcd / denomgcd ]
(* Rev *)
Rev/: Rev[n_][Rev[n_][x_]] := x
Rev/: Rev[n_][Rev[m_][x_]] :=
Block [ {remaining},
remaining = SetExclusion[ToList[n], ToList[m]];
Which [ EmptyQ[remaining],
x,
SameQ[Length[remaining], 1],
Rev[ remaining[[1]] ] [x],
True,
Rev[remaining][x] ] ] /;
! EmptyQ[Intersection[ToList[n], ToList[m]]]
Rev/: Extent1D[ Rev[n_][f_], n_ ] :=
Block [ {extent},
extent = Extent1D[f, n];
{ -Second[extent], -First[extent] } ]
Rev/: TheFunction[Rev[n_][x_]] := ( TheFunction[x] /. n ~ReplaceWith~ (-n) )
Rev/: N[ Rev[n_][x_] ] := N [ TheFunction[Rev[n][x]] ]
Rev/: Format[ Rev[n_] ] := Format[ Subscripted[Rev[n]] ]
Rev/: Format[ Rev[n_], TeXForm ] := Format[ Subscripted[Rev[n]] ]
(* RewriteSummations *)
donotrewrite[f_, t_] := FreeQ[f, Summation] && FreeQ[f, Periodic[k_,t] ]
RewriteSummations[ f_, t_, tl_, tu_ ] := f /; donotrewrite[f, t]
RewriteSummations[ f_, t_, tl_, tu_ ] :=
Block [ {ii},
f /. { Periodic[k_, v_][g_] :> (* use v_ not t *)
rewriteonesummation[ g /. t -> t + ii k,
t, tl, tu,
ii, -Infinity, Infinity, 1 ] /;
SameQ[v, t] && donotrewrite[g, t],
Summation[i_, il_, iu_, inc_][g_] :>
rewriteonesummation[ g, t, tl, tu, i, il, iu, inc ] /;
donotrewrite[g, t] } ]
rewriteonesummation[ g_, t_, tl_, tu_, i_, il_, iu_, inc_ ] :=
Block [ {ext, il0, ilact, iu0, iuact, lext, lsol, uext, usol, valid},
ext = Simplify[ Extent1D[g, t] ] //.
SignalProcessing`Support`SupCode`Private`MinMaxRules;
valid = ListQ[ext] && SameQ[Length[ext], 2];
If [ ! valid, ext = { -Infinity, Infinity } ];
{lext, uext} = ext;
If [ FreeQ[lext, i] && ! FreeQ[uext, i], lext = uext ];
If [ FreeQ[uext, i] && ! FreeQ[lext, i], uext = lext ];
If [ FreeQ[lext, i] && FreeQ[uext, i],
Message[ Summation::extent ];
Summation[i, il, iu, inc][g],
lsol = Solve[ lext == tl, i ];
usol = Solve[ uext == tu, i ];
If [ SameQ[Head[lsol], Solve] || SameQ[Head[usol], Solve],
Message[ Summation::extent ];
Summation[i, il, iu, inc][g],
il0 = Min[ Map[ GetRoot, lsol ] ];
iu0 = Max[ Map[ GetRoot, usol ] ];
ilact = Max[il, Min[il0, iu0]];
iuact = Min[iu, Max[il0, iu0]];
If [ InfinityQ[-Infinity],
ilact = ilact - Mod[ilact, inc];
iuact = iuact - Mod[iuact, inc] + inc,
ilact = ilact - Mod[ilact - il, inc];
iuact = iuact - Mod[iuact - il, inc] + inc ];
Sum[ g, {i, ilact, iuact, inc} ] ] ] ]
(* ScaleAxis [Myers, 220] *)
ScaleAxis/: TheFunction[ScaleAxis[l_, w_Symbol][x_]] :=
TheFunction[x] /. w -> l w
ScaleAxis/: TheFunction[ScaleAxis[{l__},{w__}][x_]] :=
( TheFunction[x] /. {w} ~ReplaceWith~ ({l} . {w}) )
ScaleAxis/: N[ ScaleAxis[l_, w_][x_] ] := N[ TheFunction[ ScaleAxis[l,w][x] ] ]
ScaleAxis/: Format[ ScaleAxis[l_,w_] ] := informat[ScaleAxis, l, w]
ScaleAxis/: Format[ ScaleAxis[l_,w_], TeXForm ] := inTeXformat[ScaleAxis, l, w]
ScaleAxis/: GetOperatorVariables[ ScaleAxis[l_, w_] ] := w
(* ScalingFactor -- must be independent of variable z *)
ScalingFactor[f_, z_] :=
breakup[ Apply[ RationalGCD, GetAllFactors[f, z] ], z ]
(* SequencePlot *)
Options[ SequencePlot ] :=
{ Axes -> axesdefaultvalue,
DisplayFunction :> $DisplayFunction,
PlotLabel -> "Sequence Plot",
PlotRange -> All }
baseticks = { 1, 2, 2, 5, 5, 5, 5, 5, 10, 10 };
getticks[nstart_, nend_] :=
Block [ {factor, i, ninc, ns, nterm},
ninc = Round[(nend - nstart) / 5];
If [ ninc == 0, ninc = 1 ];
If [ ninc > 2,
factor = 10;
While [ ninc > factor, factor *= 10 ];
factor /= 10;
nterm = intdivide[ninc, factor];
ninc = factor * baseticks[[nterm]] ];
ns = Sign[nstart] ninc intdivide[Abs[nstart], ninc];
Table[i, {i, ns, nend, ninc}] ]
dgetvalue[f_, n_Symbol, n0_Integer] := GetValue[f, n, n0]
dgetvalue[f_, n_Symbol, n0_Real] := GetValue[f, n, Round[n0]]
dgetvalue[f_, {n1_Symbol, n2_Symbol}, {n01_?NumberQ, n02_?NumberQ}] :=
GetValue[f, {n1, n2}, {Round[n01], Round[n02]}]
SequencePlot[f_List, {n1_Symbol, st1_, end1_},
{n2_Symbol, st2_, end2_}, op___] :=
MyMessage[ SequencePlot::nolist, NullPlot ]
SequencePlot[f_, {n1_Symbol, st1_, end1_}, {n2_Symbol, st2_, end2_}, op___] :=
Block [ {funct, ftemp, funs, n1length, n2length, n1str, n2str,
n1temp, n2temp, nstart, nend, oplist, plot},
nstart = Floor[N[{st1, st2}]];
nend = Ceiling[N[{end1, end2}]];
n1length = nend[[1]] - nstart[[1]];
n2length = nend[[2]] - nstart[[2]];
n1str = StripPackage[n1];
n2str = StripPackage[n2];
oplist = Join [ ToList[op],
Options[SequencePlot],
{ PlotPoints -> {n1length + 1, n2length + 1},
AxesLabel -> {n1str, n2str, " "},
Ticks -> Automatic } ];
funct = ToDiscrete[f];
ftemp = N[ TheFunction[ funct ] ];
(* Generate three-dimensional coordinates for plot *)
Off[Power::infy, Infinity::indt];
plot = Apply[ Plot3D,
Join[ { dgetvalue[ ftemp, {n1, n2},
{n1temp, n2temp} ],
{ n1temp, nstart[[1]], nend[[1]] },
{ n2temp, nstart[[2]], nend[[2]] } },
oplist ] ];
On[Power::infy, Infinity::indt];
plot ]
SequencePlot[f_, {n_Symbol, start_, end_}, op___] :=
Block [ {factor, ftemp, funct, funs, length, linethickness,
nend, nstart, nstr, ntemp, oplist, plot,
pointthickness, showoptions},
nstart = Floor[N[start]];
nend = Ceiling[N[end]];
(* Set up the options *)
nticks = getticks[nstart, nend];
nstr = StripPackage[n];
oplist = Join [ Flatten[ToList[op]],
Options[SequencePlot],
{ AxesLabel -> { nstr, " " },
Ticks -> { nticks, Automatic } } ];
factor = N[ Log[10, nend - nstart + 3 ] ];
linethickness = 0.008 / factor;
pointthickness = 0.024 / factor;
(* Extract the functional form of the expression *)
funct = ToDiscrete[f];
ftemp = N[ TheFunction[ funct ] ];
(* Handle any infinite summations *)
ftemp = RewriteSummations[ftemp, n, nstart, nend];
(* Generate form for 1-D function *)
SetAttributes[seqFun1D, Listable]; (* avoid fun pointers *)
seqFun1D[g_] :=
DiscreteGraphics [
Table [ {ntemp, dgetvalue[g, n, ntemp]},
{ntemp, nstart, nend}],
linethickness,
pointthickness ];
(* Plot "time"-domain *)
Off[Power::infy, Infinity::indt];
showoptions = RemoveOptions[oplist, specialPlotOptions];
plot = Show [ seqFun1D[ftemp], showoptions ];
On[Power::infy, Infinity::indt];
plot ]
(* SequenceToFunction *)
SequenceToFunction[seq_, n_:Global`n, noffset_:0] :=
Block [ {},
(* Variable no. of arguments -- could not use Function *)
impulsegen[l__] := seq[[l]] Apply[Impulse,
n - {l} - noffset + 1];
Apply[ Plus, Flatten [ Array[impulsegen, Dimensions[seq]] ] ] ]
(* SignalPlot *)
specialPlotOptions =
Complement[ Sort[ Map[First, Options[Plot]] ],
Sort[ Map[First, Options[Graphics]] ] ]
sigPlot1D[args__][g_] := SignalPlot[g, args]
Options[ SignalPlot ] :=
{ Axes -> axesdefaultvalue,
DisplayFunction :> $DisplayFunction,
PlotLabel -> "Signal Plot",
PlotRange -> All,
Ticks -> Automatic }
SignalPlot[ f_List, {t1_Symbol, start1_, end1_},
{t2_Symbol, start2_, end2_}, op___ ] :=
MyMessage[ SignalPlot::nolist, NullPlot ]
SignalPlot[ f_, {t1_Symbol, start1_, end1_},
{t2_Symbol, start2_, end2_}, op___ ] :=
Block [ {deltafuns, freqresp, ftemp, funct, oplist,
t1str, t2str, t1temp, t2temp},
(* Set up for plotting *)
t1str = StripPackage[t1];
t2str = StripPackage[t2];
oplist = Join[ ToList[op],
{ AxesLabel -> { t1str, t2str, " " } },
Options[ SignalPlot ] ];
(* Make function continuous and replace non-sep delta's *)
funct = ToContinuous[f] /.
Delta[a_. t1 + b_. t2 + c_.] :> Impulse[a t1 + b t2 + c];
(* Separate delta functions from rest of funct *)
deltafuns = GetDeltaFunctions[funct, {t1, t2}];
ftemp = funct /.
{ h_[ c_. Delta[a_. t1 + b_.] ] :> 0,
h_[ c_. Delta[a_. t1 + b_.] + x_ ] :> h[x],
Delta[a_. t1 + b_.] :> 0,
h_[ c_. Delta[a_. t2 + b_.] ] :> 0,
h_[ c_. Delta[a_. t2 + b_.] + x_ ] :> h[x],
Delta[a_. t2 + b_.] :> 0 };
(* Convert freq. response into plottable function form *)
ftemp = N [ TheFunction[funct] ];
(* Plot delta functions separately from rest of function *)
Plot3D[ GetValue[ftemp, {t1, t2}, {t1temp, t2temp}],
{ t1temp, start1, end1 },
{ t2temp, start2, end2 },
Release[oplist] ] ]
SignalPlot[f_List, {t_Symbol, start_, end_}, op___] :=
Block [ {fun, oplist, showoptions, theplots},
fun = sigPlot1D[{t,start,end}, DisplayFunction->Identity, op];
theplots = Map[ fun, f ];
oplist = Join[ToList[op], Options[SignalPlot]];
showoptions = RemoveOptions[oplist, specialPlotOptions];
Show[ theplots, ToCollection[showoptions] ] ]
SignalPlot[f_, {t_Symbol, start_, end_}, op___] :=
Block [ {deltafuns, ftemp, funct, i, imstyle,
nend = N[end], nstart = N[start], oplist,
plot, showoptions, restyle, tstr, ttemp },
(* Set up for plotting *)
tstr = StripPackage[t];
restyle = Thickness[0.006];
imstyle = Dashing[{0.05,0.05}];
oplist = Join[ ToList[op],
{ AxesLabel -> { tstr, " " },
DisplayFunction -> Identity,
PlotStyle -> { restyle, imstyle } },
Options[ SignalPlot ] ];
(* Separate delta functions from rest of funct *)
funct = ToContinuous[f];
deltafuns = GetDeltaFunctions[funct, t];
ftemp = funct /.
{ h_[ c_. Delta[a_. t + b_.] ] :> 0,
h_[ c_. Delta[a_. t + b_.] + x_ ] :> h[x],
Delta[a_. t + b_.] :> 0 };
(* Convert function into plottable functional form *)
ftemp = N[ TheFunction[ftemp] ];
(* Handle any infinite summations *)
ftemp = RewriteSummations[ftemp, t, nstart, nend];
(* Plot delta functions separately from rest of ftemp *)
Off[Power::infy, Infinity::indt];
(* 1. Generate the graphics for the entire signal *)
If [ ZeroQ[ftemp],
plot = If [ ! AtomQ[deltafuns], (* delta funs found *)
DeltaPlot[deltafuns, t, nstart, nend],
NullPlot ];
plot = { Plot[ 0,
{ ttemp, nstart, nend},
Release[oplist] ],
plot },
plot = Plot[ { Re[GetValue[ftemp, t, ttemp]],
Im[GetValue[ftemp, t, ttemp]] },
{ ttemp, nstart, nend },
Release[oplist] ];
If [ ! AtomQ[deltafuns], (* delta funs found *)
plot = DeltaPlot[deltafuns, t, nstart, nend, plot]] ];
(* 2. Plot the entire signal *)
oplist = Join[ ToList[op], Options[SignalPlot] ];
showoptions = RemoveOptions[oplist, specialPlotOptions];
plot = Show[ plot, ToCollection[showoptions] ];
On[Power::infy, Infinity::indt];
plot ]
(* SignalsInOperExpr *)
SignalsInOperExpr[ h_[s__] ] := s
SignalsInOperExpr[ h_[a__][s__] ] := s
SignalsInOperExpr[ h_[s__], h_ ] := s
SignalsInOperExpr[ h_[s__], op_ ] := h[s] /; ! SameQ[h, op]
SignalsInOperExpr[ h_[a__][s__], h_ ] := s
SignalsInOperExpr[ h_[a__][s__], op_ ] := h[a][s] /; ! SameQ[h, op]
(* Shift [Myers, 217] *)
Shift/: Shift[m_, n_List] := Shift[ Table[m, Length[n]], n ] /; ! ListQ[m]
Shift/: Shift[m_List, n_List][x_] := MyMessage[ Shift::badmD, x ] /;
Length[m] != Length[n]
Shift/: Shift[0, n_][x_] := x
Shift/: Extent1D[ Shift[m_, n_][f_], n_ ] := Extent1D[f, n] + m
Shift/: TheFunction[Shift[k_,n_][x_]] :=
( TheFunction[x] /. n ~ReplaceWith~ (n - k) )
Shift/: N[ Shift[k_,n_][x_] ] := N [ TheFunction[ Shift[k,n][x] ] ]
Shift/: Format[ Shift[m_,n_] ] := informat[Shift, m, n]
Shift/: Format[ Shift[m_,n_], TeXForm ] := inTeXformat[Shift, m, n]
Shift/: GetOperatorVariables[ Shift[l_, n_] ] := n
(* Sinc *)
Sinc/: Sinc[-Infinity] := 0
Sinc/: Sinc[0] := 1
Sinc/: Sinc[0.] := 1.
Sinc/: Sinc[Infinity] := 0
Sinc/: Sinc[x_?NumberQ] := Sin[x] / x
Sinc/: Sinc[x_, y__] := Sinc[x] Sinc[y]
Sinc/: Format[Sinc, TeXForm] := "{\\rm sinc}"
Sinc/: Derivative[1][Sinc] := (( Cos[#1] / #1 ) - ( Sinc[#1] / #1 ))&
(* SPSimplify *)
Options[SPSimplify] :=
Join[{ Dialogue -> False, Variables -> {} }, Options[Simplify]]
SPSimplify[ x_, op___ ] :=
Block [ {dialflag, dialogue, different, laste, newe,
oplist, trig, varrules, varflag, variables},
oplist = ToList[op] ~Join~ Options[SPSimplify];
trig = Replace[ Trig, oplist ];
dialogue = Replace[ Dialogue, oplist ];
dialflag = InformUserQ[dialogue];
variables = Replace[ Variables, oplist ];
varflag = ! EmptyQ[variables];
If [ varflag,
varrules = makesimplifyrules[variables] ];
newe = x;
different = True;
While [ different,
laste = newe;
newe = If [ TrueQ[ $VersionNumber >= 2.0 ],
Simplify[laste, Trig -> trig],
Simplify[laste] ];
newe = newe /. SPSimplificationRules;
If [ varflag, newe = newe /. varrules ];
different = ! SameQ[laste, newe];
If [ dialflag && different,
Print["which simplifies to"]; Print[newe] ] ];
newe ]
makesimplifyrules[var_Symbol] := makesimplifyrules[var, {}]
makesimplifyrules[var1_Symbol, var2_Symbol, rest___] :=
makesimplifyrules[{var1, var2, rest}]
makesimplifyrules[varlist_List] :=
Apply[ Join,
Map[ makesimplifyrules[#,
Complement[varlist, ToList[#]]]&,
varlist] ]
makesimplifyrules[t_, varlist_] :=
{ Delta[a_ t + b_.] :> Delta[t + b/a] / Abs[a] /;
FreeQ[a, t] && MyFreeQ[b, varlist],
d_. (y_. + amp1_. Delta[t + t0_.]) :>
d y + Limit[d amp1, t -> -t0] Delta[t + t0] /;
FreeQ[t0, t] && (! FreeQ[d amp1, t]) &&
MyFreeQ[t0, varlist] && ! InfinityQ[ Limit[d amp1, t -> -t0] ],
c_. Sign[b_. t] + c_ :> 2 c CStep[b t] /;
FreeQ[b, t],
CStep[a_ t + b_.] :> CStep[t + b/a] / Abs[a] /;
Positive[a] && FreeQ[a, t] && MyFreeQ[b, varlist],
CStep[a_ t + b_.] :> CStep[-t - b/a] / Abs[a] /;
Negative[a] && FreeQ[a, t] && MyFreeQ[b, varlist] }
(* Step *)
Step/: Step[Infinity] := 1 (* definition *)
Step/: Step[t_] := 1 /; N[ t > 0 ]
Step/: Step[t_] := 0 /; N[ t < 0 ]
Step/: Step[0] := 1
Step/: Step[0.] := 1
Step/: Step[-Infinity] := 0
Step/: Extent1D[ Step[a_. n_ + b_.], n_ ] :=
Which [ Positive[a], {-b/a, Infinity},
Negative[a], {-Infinity, -b/a},
True, Extent1DOrder[-b/a, Sign[a] Infinity] ] /;
FreeQ[{a,b,l}, n]
Step/: Step[t_, args__] := Step[t] Step[args] (* multidimensional *)
Step/: Step[List[args__]] := Step[args] (* separability *)
Step/: Step[t_]^a_ := Step[t] (* automatic *)
Step/: Step[n_Symbol + m_.] Step[n_Symbol + k_.] := (* simplification *)
Step[n + Min[m,k]] /; (* rules *)
NumberQ[m] && NumberQ[k]
Step/: Step[n_Symbol + m_.] Step[-n_Symbol + k_.] :=
Pulse[k + m, n + m] /;
N[ -m <= k ]
Step/: Step[n_Symbol + m_.] Step[-n_Symbol + k_.] := 0 /;
N[ -m > k ]
Step/: Simplify[Step[a_ n_Symbol + b_.]] := (* man. simp. rules *)
Step[n + b/a] /;
MyFreeQ[{a,b}, n] && Implies[ NumberQ[N[a]], N[a > 0] ]
Step/: Simplify[Step[- a_ n_Symbol + b_.]] :=
Step[-n + b/a] /;
MyFreeQ[{a,b}, n] && Implies[ NumberQ[N[a]], N[a > 0] ]
Step/: Format[ Step[x_], TeXForm ] := (* output form *)
StringForm["u[``]", x]
Derivative[1][Step] := Impulse (* derivative rule *)
(* Summation *)
Summation/: Summation[i_, n_] := Summation[i, 1, n, 1]
Summation/: Summation[i_, istart_, iend_] := Summation[i, istart, iend, 1]
Summation/: TheFunction[Summation[i_Symbol, istart_, iend_, inc_][f_]] :=
Block [ {tempsym},
If [ NumberQ[istart] && NumberQ[iend] && NumberQ[inc],
Sum[ TheFunction[f /. i -> tempsym],
{tempsym, istart, iend, inc} ],
Summation[i, istart, iend, inc][ TheFunction[f] ] ] ]
Summation/: Extent1D[ Summation[i_, istart_, iend_, inc_][f_], n_ ] :=
Block [ {extent},
extent = Extent1D[f, n];
Extent1DOrder[ extent /. i -> istart,
extent /. i -> iend ] ] /;
FreeQ[{i,istart,iend,inc}, n]
Summation/: N[Summation[i_Symbol, istart_?NumberQ, iend_?NumberQ, inc_?NumberQ][f_]] :=
Sum[ N[f], {i, istart, iend, inc} ]
Summation/: Format[ Summation[i_, istart_, iend_, 1], TeXForm ] :=
StringForm[ "\\sum_{`` = ``}^{``}", i, istart, iend ]
Summation/: Format[ Summation[i_, istart_, iend_, inc_], TeXForm ] :=
StringForm["\\sum_{``=``, `` = `` + ``}^{``}",
i, istart, i, i, inc, iend]
(* The following rules were suggested by John Mitchell *)
getdvars[ x_Symbol ] := x
getdvars[ {x_Symbol, k_} ] := x
Unprotect[D]
D/: D[expr_. Summation[i_, istart_, iend_, inc_][f_], x__] :=
Summation[i, istart, iend, inc][ D[expr f, x] ] /;
MyFreeQ[ i, Map[getdvars, {x}] ]
Protect[D]
Unprotect[Integrate]
Integrate/: Integrate[ expr_. Summation[i_, istart_, iend_, inc_][f_], x__] :=
Summation[i, istart, iend, inc][ Integrate[expr f, x] ] /;
MyFreeQ[ i, Map[getdvars, {x}] ]
Protect[Integrate]
(* TheFunction *)
TheFunction[x_?AtomQ] := x
TheFunction[Hold[x__]] := Hold[x]
TheFunction[Sign[x_]] := CStep[x] - CStep[-x] (* Step or CStep will work *)
TheFunction[h_[a_]] := h [ TheFunction[a] ]
TheFunction[h_[a1_, a__]] := Apply[ h, Map[TheFunction, { a1, a }] ]
(* ToContinuous *)
ToContinuous[expr_] := ReplaceRepeated[expr, ToContinuousRules]
ToContinuousRules =
{
Impulse[n_] :> Delta[n],
Step[n_] :> CStep[n],
Pulse[l_, n_] :> CPulse[l, n],
Convolve[n_] :> CConvolve[n]
}
(* ToDiscrete *)
ToDiscrete[expr_] := ReplaceRepeated[expr, ToDiscreteRules]
ToDiscreteRules =
{
CStep[t_] :> Step[t],
Delta[t_] :> Impulse[t],
CPulse[l_, t_] :> Pulse[l, t],
CConvolve[t_] :> Convolve[t]
}
(* Unit *)
Unit/: Unit[0][t_] := Delta[t] (* definition *)
Unit/: Unit[-1][t_] := CStep[t]
Unit/: Unit[n_][t_?NumberQ] :=
t^-(n + 1) / Factorial[-(n + 1)] CStep[t] /; N[n < 0]
Unit/: Extent1D[ Unit[n_Integer][a_. t_ + b_.], t_ ] := {-b/a, -b/a} /;
FreeQ[{a,b}, t] && ( n <= 0 )
Unit/: Extent1D[ Unit[n_Integer][a_. t_ + b_.], t_ ] :=
Extent1DOrder[ -b/a, Sign[a] Infinity ] /;
FreeQ[{a,b}, t] && ( n > 0 )
Unit/: Unit[n_][List[args]] := Unit[n][args] (* multidimensional *)
Unit/: Unit[n_][t1_, t__] := Unit[n][t1] Unit[n][t] (* separability *)
Unit/: TheFunction[Unit[n_][t__]] :=
t^-(n + 1) / Factorial[-(n + 1)] CStep[t] /; N[n < 0]
Unit/: Format[ Unit[n_] ] := Subscripted[ Unit[n] ] (* output forms *)
Unit/: Format[ Unit[n_], TeXForm ] := StringForm[ "u_{``}", n ]
Derivative[1][Unit[n_]] := Unit[n+1] (* derivative rule *)
Unprotect[Integrate] (* integration rules *)
Integrate/: Integrate[ expr_. Unit[n_][a_. x_ + b_.], x_Symbol ] :=
Limit[expr, x -> -b/a] Unit[n-1][a x + b] / a /;
FreeQ[{a,b,c}, x]
Integrate/: Integrate[ expr_. Unit[n_][a_ x_ + b_.], {x_Symbol, x1_, x2_}] :=
Integrate[expr Unit[n][x + b/a] / a, x] /;
FreeQ[{a,b}, x]
Integrate/: Integrate[expr_. Unit[n_][x_ + c_.], {x_Symbol, x1_, x2_}] :=
Limit[expr, x -> -c] CStep[-c - x1] CStep[c + x2] Unit[n-1][x + c] /;
FreeQ[c, x] (* CStep[-c - x1] CStep[c + x2] <--> x1 <= -c <= x2 *)
Protect[Integrate]
(* Upsample [Myers, 218-219] [Bamberger, ch. 2] *)
(* Error checking of upsample parameters *)
Upsample/: Upsample[m_List, n_List][f_] :=
MyMessage[Upsample::convert, Upsample[DiagonalMatrix[m], n][f], m] /;
VectorQ[m] && SameQ[Length[m], Length[n]]
Upsample/: Upsample[m_List, n_List][f_] :=
MyMessage[Upsample::badmD, f] /;
VectorQ[m] && ! SameQ[Length[m], Length[n]]
Upsample/: Upsample[m_List, n_List][f_] :=
MyMessage[Upsample::badmD, f] /;
MatrixQ[m] && ! Apply[SameQ, Append[Dimensions[m], Length[n]]]
Upsample/: Upsample[m_List, n_Symbol][f_] :=
MyMessage[Upsample::badmD, f]
(* degenerate cases *)
Upsample/: Upsample[1, n_][f_] := f
Upsample/: Upsample[-1, n_][f_] := Rev[n][f]
(* convert upsample into a functional form *)
Upsample/: N[Upsample[m_,n_][f_List]] := UpsampleSequence[f, m, 0]
Upsample/: TheFunction[Upsample[m_, n_Symbol][f_List]] :=
UpsampleSequence[f, m, 0]
Upsample/: TheFunction[Upsample[m_, n_Symbol][f_]] :=
UpsampledFunction[m, 0, n, TheFunction[f] /. n -> n / m]
(* extent of upsampled function *)
Upsample/: Extent1D[ Upsample[m_, n_][f_], n_ ] := m Extent1D[f, n]
(* formatting of the upsample operator *)
Upsample/: Format[ Upsample[m_, n_List] ] :=
Block [ {bar},
bar = TableForm[ Table[ " | ", Release[Dimensions[n]] ] ];
Format[ SequenceForm[ Upsample,
Subscript[ TableForm[m] ],
Subscript[ bar ],
Subscript[ TableForm[n] ] ] ] ]
Upsample/: Format[ Upsample[m_, n_] ] :=
Format[ Subscripted[Upsample[m, n]] ]
Upsample/: Format[ Upsample, TeXForm ] := "\\uparrow"
Upsample/: Format[ Upsample[m_, n_], TeXForm ] :=
inTeXformat[ Upsample, m, n ]
Upsample/: GetOperatorVariables[ Upsample[l_, n_] ] := n
(* UpsampledFunction *)
UpsampledFunction[m_Integer, l_, n_Integer, f_] :=
If [ IntegerQ[n / m], f, l ]
UpsampledFunction[m_?NumberQ, l_, n_?NumberQ, f_] :=
If [ IntegerQ[Rationalize[n / m]], f, l ]
(* UpsampleFactor -- must be independent of variable z *)
UpsampleFactor[f_, z_] :=
Block [ {ratgcd},
If [ FreeQ[f, z], Return[0] ];
ratgcd = Apply[ RationalGCD, GetAllExponents[f, z] ];
ratgcd = breakup[ratgcd, z];
If [ IntegerQ[ratgcd],
ratgcd,
Numerator[ratgcd] ] ]
(* UpsampleSequence *)
UpsampleSequence[seq_, m_:2, fill_:0] :=
Block [ {fillcount, input, len, newseq},
len = Length[seq];
newseq = List[ seq[[1]] ];
(* Build the new sequence newseq by appending
m - 1 fill elements and then by appending
a value from the original sequence. *)
For [ input = 2, input <= len, input++,
For [ fillcount = 1, fillcount < m, fillcount++,
AppendTo[newseq, fill] ];
AppendTo[newseq, seq[[input]] ] ];
newseq ] /;
IntegerQ[m] && ( m >= 2 )
(* Z *)
Z/: Z[n_] := Z[n, DummyVariables[Length[n], Global`z]]
Z/: Z[n_, z_] [ InvZ[zi_, n_] [f_] ] :=
If [ SameQ[z, zi], f, f /. ReplaceWith[zi, z] ] /;
Length[z] == Length[zi]
Z/: Z^-1[a__] := InvZ[a]
Z/: Format[ Z, TeXForm ] := "{\\cal Z}"
Z/: Format[ Z[n_, z_], TeXForm ] := StringForm[ "{\\cal Z}_{``}", n ]
(* E N D P A C K A G E *)
End[]
EndPackage[]
(* A L I A S E S *)
Unprotect[ { AliasedSinc, AliasSinc, ASinc } ]
Clear[ AliasedSinc, AliasSinc, ASinc ]
AliasedSinc = Dirichlet
AliasedSinc::usage = Dirichlet::usage
AliasSinc = Dirichlet
AliasSinc::usage = Dirichlet::usage
ASinc = Dirichlet
ASinc::usage = Dirichlet::usage
Protect[ { AliasedSinc, AliasSinc, ASinc } ]
If [ TrueQ[ $VersionNumber >= 2.0 ],
On[ General::spell ];
On[ General::spell1 ] ]
(* H E L P I N F O R M A T I O N *)
Block [ {newfuns},
newfuns =
{ DeltaIntegrate, DeltaPlot, DiscreteGraphics,
DummyVariables, GetDeltaFunctions, IntervalsToFunction,
OperatorInOperExpr, OperatorName, ParametersInOperExpr,
ScalingFactor, SequencePlot, SequenceToFunction,
SignalPlot, SignalsInOperExpr, "Signum",
SPSimplify, TheFunction, ToContinuous,
ToDiscrete, UpsampledFunction, UpsampleFactor,
UpsampleSequence };
Combine[ SPfunctions, newfuns ];
Apply[ Protect, newfuns ];
(* Under Mma 2.0, Delta is used by Integrate *)
If [ TrueQ[ $VersionNumber >= 2.0 ],
Unprotect[Delta] ] ]
Block [ {newoperators},
newoperators =
{ Aliasby, CConvolve, CircularShift,
Convolve, DFT, Difference,
Downsample, DTFT, FT,
Interleave, InvDFT, InvDTFT,
InvFT, InvL, InvZ,
L, PolyphaseDownsample, PolyphaseUpsample,
Periodic, Rev, RewriteSummations,
ScaleAxis, Shift, Summation,
Upsample, Z };
Combine[ SPoperators, newoperators ];
Apply[ Protect, newoperators ] ]
Block [ {newsignals},
newsignals =
{ "AliasSinc", "ASinc", CPulse,
CStep, Delta, Dirichlet,
Impulse, LineImpulse, Pulse,
Sinc, Step, Unit };
Combine[ SPsignals, newsignals ];
Apply[ Protect, newsignals ] ]
(* When encoded using ":=", these next rules causes Simplify to *)
(* carry out incorrect simplifications when an expression contains *)
(* an Impulse term and a term containing 1/n because Simplify will *)
(* group the expression over a common denominator thereby putting *)
(* the n in front of Impulse[n] which whould force it to zero, *)
(* thereby eliminating a perfectly valid term. *)
Unprotect[ SPSimplificationRules ]
AppendTo[ SPSimplificationRules,
( f_ Impulse[n_Symbol + m_.] :> (f /. n -> -m) Impulse[n + m] /;
NumberQ[m] && ! FreeQ[f, n] ) ]
AppendTo[ SPSimplificationRules, ( x_ Sinc[b_. x_] :> Sin[b x] / b ) ]
AppendTo[ SPSimplificationRules, ( Sinc[-x_] :> Sinc[x] ) ]
AppendTo[ SPSimplificationRules, ( Delta[-x_] :> Delta[x] ) ]
AppendTo[ SPSimplificationRules, ( Delta[a_?Positive x_] :> Delta[x] / a ) ]
AppendTo[ SPSimplificationRules, ( Impulse[-x_] :> Impulse[x] ) ]
AppendTo[ SPSimplificationRules, ( CPulse[L_, L_ - x_] :> CPulse[L, x] ) ]
(* Simplifications when an impulse is the input *)
AppendTo[ SPSimplificationRules,
( Downsample[L_, n_][a_. Impulse[n_]] :> a Impulse[n] ) ]
AppendTo[ SPSimplificationRules,
( Upsample[L_, n_][a_. Impulse[n_]] :> a Impulse[n] ) ]
(* Simplifications when an exponential is the input *)
AppendTo[ SPSimplificationRules,
( Rev[n_Symbol][Exp[ Complex[0, a_] b_. n_ ] ] :>
Exp[-I a b n] ) ]
AppendTo[ SPSimplificationRules,
( ScaleAxis[l_,w_Symbol][Exp[Complex[0, a_] b_. w_]] :>
Exp[I a b w l] ) ]
(* Other simplifications: when these are encoded *)
(* using ":=", they can cause rules in some of the *)
(* packages to confuse Mathematica to no end. For *)
(* example, hard wiring these rules will cause *)
(* the "RewriteRules.m" package to hang. *)
AppendTo[ SPSimplificationRules,
( Aliasby[m_, w_][c_] :> c /; MyFreeQ[c,w] ) ]
AppendTo[ SPSimplificationRules,
( Difference[k_, n_][c_] :> 0 /; MyFreeQ[c,n] ) ]
AppendTo[ SPSimplificationRules,
( Downsample[m_, n_][c_] :> c /; MyFreeQ[c, n] ) ]
AppendTo[ SPSimplificationRules,
( Periodic[k_,n_][x_] :> x /; MyFreeQ[x, n] ) ]
AppendTo[ SPSimplificationRules,
( Rev[n_][x_] :> x /; MyFreeQ[x, n] ) ]
AppendTo[ SPSimplificationRules,
( ScaleAxis[l_, w_][c_] :> c /; MyFreeQ[c, w] ) ]
AppendTo[ SPSimplificationRules,
( Shift[m_, n_][x_] :> x /; MyFreeQ[x, n] ) ]
Protect[ SPSimplificationRules ]
(* E N D M E S S A G E *)
Print["The knowledge base of signal processing operators has been loaded."]
Null
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.