summaryrefslogtreecommitdiff
path: root/texmf-dist/scripts/ketcindy/ketlib/maximaL/fourier_sec.max
diff options
context:
space:
mode:
Diffstat (limited to 'texmf-dist/scripts/ketcindy/ketlib/maximaL/fourier_sec.max')
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/maximaL/fourier_sec.max260
1 files changed, 0 insertions, 260 deletions
diff --git a/texmf-dist/scripts/ketcindy/ketlib/maximaL/fourier_sec.max b/texmf-dist/scripts/ketcindy/ketlib/maximaL/fourier_sec.max
deleted file mode 100644
index c70f7f46..00000000
--- a/texmf-dist/scripts/ketcindy/ketlib/maximaL/fourier_sec.max
+++ /dev/null
@@ -1,260 +0,0 @@
-/*
-Package fourier_sec, to study piecewise defined functions
-(sectionally defined, hence the name).
-
-Author: Jose A. Vallejo
- Faculty of Sciences
- Universidad Autonoma de San Luis Potosi (Mexico)
- http://galia.fc.uaslp.mx/~jvallejo
-
-It is assumed that the functions are defined using the format
- if ... then ... else ...
-as, for example,
-(%i1) absolute(x):=if (x<=0) then -x elseif (x>0) then x$
-(it will not work with 'abs').
-It provides three functions:
-1. 'paritycheck', to check if a given piecewise defined
- function is even or odd (or none). For instance,
- (%i2) paritycheck(absolute(x),x);
- (%o2) 0
- A '0' means 'even', '1' is 'odd', and '-1' is 'none'
-2. 'fourier_sec_coeff', to compute the Fourier sine and cosine
- coefficients. The function must have compact support.For
- instance, for the unit step we have:
- (%i3) h(x):=if (-%pi<=x and x<0) then 0 elseif (0<=x and x<=%pi) then 1$
- (%i4) fourier_sec_coeff(h(x),x);
- (%o4) [1/2,0,-((-1)^n-1)/(%pi*n)]
-3. 'fourier_sec_series', to compute the Fourier series, truncated
- or not. The series for the unit step to the 10th order:
- (%i5) fourier_sec_series(h(x),x,10);
- (%o5) (2*sin(9*x))/(9*%pi)+(2*sin(7*x))/(7*%pi)+(2*sin(5*x))/(5*%pi)+(2*sin(3*x))/(3*%pi)+(2*sin(x))/%pi+1/2
- and the whole Fourier series
- (%i6) fourier_sec_series(h(x),x,inf);
- (%o6) (sum(((1/n-(-1)^n/n)*sin(n*x))/%pi,n,1,inf))+1/2
-*/
-
-
-load(fourie)$
-
-load(simplify_sum)$
-
-paritycheck(funvar,x):=block([subintervals,subvalues,tmp1,tmp2,token1,token0,tmp3,
- subvalues_list,subintervals_list,icentral:0,middle,minusmiddle,token2,
- side_subintervals_list,L,side_subvalues_list,
- zero_subintervals,tmp4,tmp5,non_zero_side_subvalues_list,
- non_zero_side_subintervals_list,LL,token3,expr1,expr2],
- local(M,N,P,Q,count1,count2,count3,count4),
- subintervals:makelist(part(funvar,i),i,makelist(2*k-1,k,1,(length(funvar)-2)/2)),
- subvalues:makelist(part(funvar,i),i,makelist(2*k,k,1,(length(funvar)-2)/2)),
- for j:1 thru length(subintervals) do (if operatorp(subintervals[j],["<",">","<=",">="]) then tmp1[j]:1 else tmp1[j]:0),
- tmp1:makelist(tmp1[j],j,1,length(subintervals)),
- tmp2:sublist_indices(tmp1,lambda([x],x=1)),
-
- /* if length(tmp2)=0 all the subintervals in the domain of funvar are bounded! */
-
- if is(equal(length(tmp2),0)) then
- (
- subvalues_list:copylist(subvalues),
- tmp3:copylist(subintervals),
- for j:1 thru length(tmp3) do
- (
- M[j]:makelist(part(tmp3[j],k),k,1,length(tmp3[j])),
- for m:1 thru 2 do N[j,m]:makelist(part(M[j],m,n),n,1,length(M[j])),
- P[j]:append(N[j,1],N[j,2]),Q[j]:sort(delete(x,P[j]),"<")
- ),
- subintervals_list:makelist(Q[j],j,1,length(tmp3)),
- for i:1 thru length(subintervals_list) do (if is(lmin(subintervals_list[i])*lmax(subintervals_list[i])<0) then icentral:i),
- if is(icentral>0) then middle:subvalues_list[icentral],
- if is(icentral>0) then
- (if evenfunp(middle,x) then token2:0 elseif oddfunp(middle,x) then token2:1 else return(-1))
- else
-
- /* now we analyze what happens if icentral=0, so there are only side intervals */
-
- (
- /* as before, there must be an even number of symmetric intervals, otherwise -1 */
- side_subintervals_list:copylist(subintervals_list),
- if not(evenp(length(side_subintervals_list))) then return(-1),
- L:length(side_subintervals_list)/2,
- for k:1 thru L do count1[k]:charfun(is(equal(side_subintervals_list[k],reverse(map("-",side_subintervals_list[2*L+1-k]))))),
- if sum(count1[j],j,1,L)#L then return(-1),
- side_subvalues_list:copylist(subvalues_list),
- for k:1 thru L do count2[k]:charfun(is(equalp(side_subvalues_list[k],ratsubst(-x,x,side_subvalues_list[2*L+1-k])))),
- if is(equal(sum(count2[j],j,1,L),L)) then token3:0,
- for k:1 thru L do count3[k]:charfun(is(equalp(side_subvalues_list[k],-ratsubst(-x,x,side_subvalues_list[2*L+1-k])))),
- if is(equal(sum(count3[j],j,1,L),L)) then token3:1,
- if is(not(equalp(token3,0)) and not(equalp(token3,1))) then return(-1) ,
- return(token3)
- ),
-
- /* and what happens if icentral#0 */
-
- side_subintervals_list:delete(subintervals_list[icentral],subintervals_list),
- if is(equal(length(side_subintervals_list),0)) then (if is(equal(token1,token2)) then return(token1*token2) else return(-1)),
- if not(evenp(length(side_subintervals_list))) then return(-1),
- L:length(side_subintervals_list)/2,
- for k:1 thru L do count1[k]:charfun(is(equal(side_subintervals_list[k],reverse(map("-",side_subintervals_list[2*L+1-k]))))),
- if sum(count1[j],j,1,L)#L then return(-1),
- side_subvalues_list:delete(subvalues_list[icentral],subvalues_list),
-
- /* remove those subintervals in which funvar vanishes */
-
- zero_subintervals:sublist_indices(side_subvalues_list,lambda([x],x=0)),
- tmp4:copylist(side_subintervals_list),
- for j:1 thru length(zero_subintervals) do
- (tmp4:delete(side_subintervals_list[zero_subintervals[j]],tmp4)),
- non_zero_side_subintervals_list:tmp4,
- tmp5:copylist(side_subvalues_list),
- for j:1 thru length(zero_subintervals) do
- (tmp5:delete(side_subvalues_list[zero_subintervals[j]],tmp5)),
- non_zero_side_subvalues_list:tmp5,
-
- /* if length(non_zero_side_subintervals_list)=0 then we are done just with token2 */
-
- if is(equal(length(non_zero_side_subintervals_list),0)) then return(token2),
-
- /* otherwise, we must also take into account token3 */
- LL:length(non_zero_side_subintervals_list)/2,
- for k:1 thru LL do count2[k]:charfun(is(equalp(non_zero_side_subvalues_list[k],ratsubst(-x,x,non_zero_side_subvalues_list[2*LL+1-k])))),
- if is(equal(sum(count2[j],j,1,LL),LL)) then token3:0,
- for k:1 thru LL do count3[k]:charfun(is(equalp(non_zero_side_subvalues_list[k],-ratsubst(-x,x,non_zero_side_subvalues_list[2*LL+1-k])))),
- if is(equal(sum(count3[j],j,1,LL),LL)) then token3:1,
- if is(not(equal(token3,0) or equal(token3,1))) then return(-1) elseif
- is(token2#token3) then return(-1)
- elseif is(equal(token2,0)) then return(0)
- elseif is(equal(token2,1)) then return(1)
-
- ),
-
- /* we continue here with unbounded intervals */
-
- expr1:subvalues[tmp2[1]],
- expr2:ratsubst(-x,x,subvalues[tmp2[2]]),
- if is(equalp(expr1,expr2)) then token1:0
- elseif is(equalp(expr1,-expr2)) then token1:1
- else return(-1),
-
- /* the problem when defining token1 is that if the asymptotic value is 0, then it is always token1:0 */
- /* although the function could be odd. To cope with this, we define token0 below */
-
- tmp3:makelist(subintervals[i],i,sublist_indices(tmp1,lambda([x],x=0))),
- if is(equal(length(tmp3),0)) then return(token1),
- subvalues_list:makelist(subvalues[i],i,sublist_indices(tmp1,lambda([x],x=0))),
- token0:if member(0,makelist(subvalues[i],i,tmp2)) then 0 else 7,
- for j:1 thru length(tmp3) do
- (
- M[j]:makelist(part(tmp3[j],k),k,1,length(tmp3[j])),
- for m:1 thru 2 do N[j,m]:makelist(part(M[j],m,n),n,1,length(M[j])),
- P[j]:append(N[j,1],N[j,2]),Q[j]:sort(delete(x,P[j]),"<")
- ),
- subintervals_list:makelist(Q[j],j,1,length(tmp3)),
- for i:1 thru length(subintervals_list) do (if is(lmin(subintervals_list[i])*lmax(subintervals_list[i])<0) then icentral:i),
- if is(icentral>0) then middle:subvalues_list[icentral],
- if is(icentral>0) then
- (if evenfunp(middle,x) then token2:0 elseif oddfunp(middle,x) then token2:1 else return(-1))
- else
-
- /* now we analyze what happens if icentral=0, so there are only non-bounded intervals and side intervals */
-
- (
- /* as before, there must be an even number of symmetric intervals, otherwise -1 */
- side_subintervals_list:copylist(subintervals_list),
- if not(evenp(length(side_subintervals_list))) then return(-1),
- L:length(side_subintervals_list)/2,
- for k:1 thru L do count1[k]:charfun(is(equal(side_subintervals_list[k],reverse(map("-",side_subintervals_list[2*L+1-k]))))),
- if sum(count1[j],j,1,L)#L then return(-1),
- side_subvalues_list:copylist(subvalues_list),
- for k:1 thru L do count2[k]:charfun(is(equalp(side_subvalues_list[k],ratsubst(-x,x,side_subvalues_list[2*L+1-k])))),
- if is(equal(sum(count2[j],j,1,L),L)) then token3:0,
- for k:1 thru L do count3[k]:charfun(is(equalp(side_subvalues_list[k],-ratsubst(-x,x,side_subvalues_list[2*L+1-k])))),
- if is(equal(sum(count3[j],j,1,L),L)) then token3:1,
- if is(not(equal(token3,0)) and not(equal(token3,1))) then return(-1) elseif
- is(not(equal(token1,token3)) and not(equal(token0,0))) then return(-1)
- elseif is( equal(token0,0) and equal(token3,0)) then return(0)
- elseif is( equal(token0,0) and equal(token3,1)) then return(1)
- elseif is(not(equal(token0,0)) and equal(token1,token3)) then return(token3)
- elseif is(not(equal(token0,0)) and not(equal(token1,token3))) then return(-1)
- ),
-
- /* and what happens if icentral#0 */
-
- side_subintervals_list:delete(subintervals_list[icentral],subintervals_list),
- if is(equal(length(side_subintervals_list),0)) then (if is(equal(token1,token2)) then return(token1*token2) else return(-1)),
- if not(evenp(length(side_subintervals_list))) then return(-1),
- L:length(side_subintervals_list)/2,
- for k:1 thru L do count1[k]:charfun(is(equal(side_subintervals_list[k],reverse(map("-",side_subintervals_list[2*L+1-k]))))),
- if sum(count1[j],j,1,L)#L then return(-1),
- side_subvalues_list:delete(subvalues_list[icentral],subvalues_list),
-
- /* remove those subintervals in which funvar vanishes */
-
- zero_subintervals:sublist_indices(side_subvalues_list,lambda([x],x=0)),
- tmp4:copylist(side_subintervals_list),
- for j:1 thru length(zero_subintervals) do
- (tmp4:delete(side_subintervals_list[zero_subintervals[j]],tmp4)),
- non_zero_side_subintervals_list:tmp4,
- tmp5:copylist(side_subvalues_list),
- for j:1 thru length(zero_subintervals) do
- (tmp5:delete(side_subvalues_list[zero_subintervals[j]],tmp5)),
- non_zero_side_subvalues_list:tmp5,
-
- /* if length(non_zero_side_subintervals_list)=0 then we are done just with token1 and token2 */
-
- if is(equal(length(non_zero_side_subintervals_list),0)) then (if is(equal(token1,token2)) then return(token1*token2) else return(-1)),
-
- /* otherwise, we must also take into account token3 */
- LL:length(non_zero_side_subintervals_list)/2,
- for k:1 thru LL do count2[k]:charfun(is(equalp(non_zero_side_subvalues_list[k],ratsubst(-x,x,non_zero_side_subvalues_list[2*LL+1-k])))),
- if is(equal(sum(count2[j],j,1,LL),LL)) then token3:0,
- for k:1 thru LL do count3[k]:charfun(is(equalp(non_zero_side_subvalues_list[k],-ratsubst(-x,x,non_zero_side_subvalues_list[2*LL+1-k])))),
- if is(equal(sum(count3[j],j,1,LL),LL)) then token3:1,
- if is(not(equal(token0,0)) and is(not(equal(token1,token2)) or not(equal(token1,token3)) or not(equal(token2,token3))) ) then return(-1)
- elseif is(not(equal(token0,0)) and is(equal(token1,0)) ) then return(0)
- elseif is(not(equal(token0,0)) and is(equal(token1,1)) ) then return(1)
- elseif is( equal(token0,0) and equal(token3,0) and equal(token2,0)) then return(0)
- elseif is( equal(token0,0) and equal(token3,1) and equal(token2,1)) then return(1)
- else return(-1)
-
-)$
-
-fourier_sec_coeff(fuvar,x):=
-block([pp,LL,lm,a0,coeff],
- local(a,b,n,MM,NN,PP,QQ),
- declare(n,integer),
- pp:((length(fuvar)/2)-1),
- LL:makelist(part(fuvar,i),i,makelist(2*s-1,s,1,pp)),
- for j:1 thru length(LL) step 1 do
- (
- MM[j]:makelist(part(LL[j],r),r,1,length(LL[j])),
- for r:1 thru 2 do NN(j,r):=makelist(part(MM[j],r,k),k,1,length(MM[j])),
- PP[j]:append(NN(j,1),NN(j,2)),QQ[j]:delete(x,PP[j])
- ),
- for i:1 thru pp step 1 do partsums[i]:sort(QQ[i],"<"),
- for i:1 thru pp step 1 do partfunc[i]:part(fuvar,2*i),
- lm:lmax(unique(flatten(makelist(QQ[q],q,1,length(LL))))),
- a0:(1/(2*lm))*sum(integrate(partfunc[i],x,partsums[i][1],partsums[i][2]),i,1,pp),
- if is(equal(paritycheck(fuvar,x),1)) then a(n):=0 else a(n):=(1/lm)*sum(adefint(partfunc[i]*cos(%pi*n*x/lm),x,partsums[i][1],partsums[i][2]),i,1,pp),
- if is(equal(paritycheck(fuvar,x),0)) then b(n):=0 else b(n):=(1/lm)*sum(adefint(partfunc[i]*sin(%pi*n*x/lm),x,partsums[i][1],partsums[i][2]),i,1,pp),
- coeff:[a0,simplify_sum(a(n)),simplify_sum(b(n))],
- factor(ratsimp(coeff))
-)$
-
-fourier_sec_series(fuvar,x,u):=
-block([pp,LL,lm,a0,coeff],
- local(a,b,n,MM,NN,PP,QQ),
- declare(n,integer),
- pp:((length(fuvar)/2)-1),
- LL:makelist(part(fuvar,i),i,makelist(2*s-1,s,1,pp)),
- for j:1 thru length(LL) step 1 do
- (
- MM[j]:makelist(part(LL[j],r),r,1,length(LL[j])),
- for r:1 thru 2 do NN(j,r):=makelist(part(MM[j],r,k),k,1,length(MM[j])),
- PP[j]:append(NN(j,1),NN(j,2)),QQ[j]:delete(x,PP[j])
- ),
- for i:1 thru pp step 1 do partsums[i]:sort(QQ[i],"<"),
- for i:1 thru pp step 1 do partfunc[i]:part(fuvar,2*i),
- lm:lmax(unique(flatten(makelist(QQ[q],q,1,length(LL))))),
- a0:(1/(2*lm))*sum(integrate(partfunc[i],x,partsums[i][1],partsums[i][2]),i,1,pp),
- if is(equal(paritycheck(fuvar,x),1)) then a(n):=0 else a(n):=(1/lm)*sum(adefint(partfunc[i]*cos(%pi*n*x/lm),x,partsums[i][1],partsums[i][2]),i,1,pp),
- if is(equal(paritycheck(fuvar,x),0)) then b(n):=0 else b(n):=(1/lm)*sum(adefint(partfunc[i]*sin(%pi*n*x/lm),x,partsums[i][1],partsums[i][2]),i,1,pp),
- a0+intosum(sum(a(n)*cos(%pi*n*x/lm),n,1,u))+intosum(sum(b(n)*sin(%pi*n*x/lm),n,1,u)))$ \ No newline at end of file