> mujsort:=proc(a) local j,k,b,c,newa; newa:=a; b:=[]; for j to nops(newa) do b:=[op(b),convert(newa[j],string)]; od; newa:=b; b:=sort(b,lexorder); c:=[]; for j to nops(b) do for k while not(b[j]=newa[k]) do od; c:=[op(c),a[k]]; od; c; end:

> PrectiProm:=proc(prom::anything) local st,i; global nez,zav; st:=convert(prom,string); for i from 1 while not(substring(st,i)="(") do od; nez:=convert(substring(st,i+1..length(st)-1),symbol); zav:=convert(substring(st,1..i-1),symbol); end:

> char:=proc(DR::equation,promen::anything) PrectiProm(promen); simplify(simplify(subs(zav(nez)=exp(lambda*nez),DR))/exp(lambda*nez)): end:

> part:=proc(OR,podm) local i,soust,konst; PrectiProm(lhs(OR)); soust:={op(2,op(1,podm))=simplify(subs(nez=op(1,op(1,podm)),rhs(OR)))}; for i from 2 to nops(podm) do soust:=soust union {op(2,op(i,podm))=simplify(subs(nez=op(1,op(i,podm)),diff(rhs(OR),nez$(i-1))))} od; konst:=seq(c[i],i=1..nops(podm)); y(x)=subs(solve(soust,{konst}),rhs(OR)); end:

> sol:=proc(r::anything,n::integer) local res; if type(r,complexcons) then if type(r,realcons) then res:=nez^(n-1)*exp(r*nez) else if abs(Im(r))=Im(r) then res:=nez^(n-1)*exp(Re(r)*nez)*cos(abs(Im(r))*nez) else res:=nez^(n-1)*exp(Re(r)*nez)*sin(abs(Im(r))*nez); fi; fi else error "sorry, tohle neumim."; fi end:

> hom:=proc() global fund; local E,promenne,koreny,nas,i,prava,s; E:=args[1]; promenne:=args[2];koreny:=mujsort([solve(char(E,promenne),lambda)]); nas:=1; fund:=[sol(koreny[1],nas)]; for i from 2 to nops(koreny) do if koreny[i]=koreny[i-1] then nas:=nas+1 else nas:=1; fi; fund:=[op(fund),sol(koreny[i],nas)]; od; prava:=0; for s to nops(fund) do prava:=prava+c[s]*fund[s] od; if nargs=3 then if args[3]="fund" then print(fund); zav(nez)=prava else part(zav(nez)=prava,args[3]) fi; else zav(nez)=prava fi; end:

> varconst:=proc() local j,p,n,konst,soust,konstder,prava,DR,prome; DR:=args[1]; prome:=args[2]; hom(lhs(DR)=0,prome); n:=nops(fund); soust:={sum(k[i]*fund[i],i=1..n)=0}; for j from 1 to n-2 do soust:=soust union {sum(k[i]*diff(fund[i],nez$j),i=1..n)=0}; od; soust:=soust union {sum(k[i]*diff(fund[i],nez$n-1),i=1..n)=rhs(DR)}; konstder:=mujsort(simplify(solve(soust,{seq(k[h],h=1..n)}))); konst:=map(a -> simplify(int(rhs(a),nez)),konstder); prava:=sum(c[i]*fund[i],i=1..n)+simplify(sum(fund[i]*konst[i],i=1..n)); if nargs=3 then part(zav(nez)=prava,args[3]) else zav(nez)=prava; fi; end:

> param:=proc(pr) local sez, V ,prvek, i; if type(pr,`function`) or type(pr,`polynom`) then
if (op(0,pr) = `sin`) or (op(0,pr) = `cos`) then
[0, coeff(op(pr),x), 0];
elif op(0,pr) = `exp` then
[coeff(op(pr),x), 0, 0]
elif type(pr,`polynom`) then
[0, 0, degree(pr,x)]; fi;
else
sez:=[op(pr)];
V:=[0,0,0];
for i from 1 to nops(sez) do
prvek:=op(i,sez);
if (op(0,prvek) = `sin`) or (op(0,prvek) = `cos`) then
V:=subsop( 2 = coeff(op(prvek),x), V);
elif op(0,prvek) = `exp` then
V:=subsop( 1 = coeff(op(prvek),x), V);
elif type(prvek,`polynom`) then
V:=subsop( 3 = degree(prvek,x), V);
fi;
od;
V;
fi:

end:

> neurkoef:=proc() local E,prom,i,j,par,kor,sez,L,P,alfa,beta,stupen,moc,R,S,Yg,Yp,ABrce; E:=args[1]; prom:=args[2]; L:=lhs(E); P:=rhs(E); kor:=roots(expand(lhs(char(L=0,prom))),lambda,I); Yg:=rhs(hom(L=0,prom)); if type(P,`+`) then sez:=[op(P)] else sez:=[P]; fi; for i to nops(sez) do par:=param(op(i,sez)); alfa:=par[1]; beta:=par[2]; stupen:=par[3]; moc:=0; for j from 1 to nops(kor) do if kor[j][1]=alfa+beta*I then moc:=kor[j][2]; fi; od; R:=0; S:=0; for j from 0 to stupen do R:=R+A[j]*nez^j; S:=S+B[j]*nez^j; od; Yp:=nez^moc*exp(alfa*nez)* (R*cos(beta*nez)+S*sin(beta*nez)); ABrce:=normal(simplify(subs(zav(nez)=Yp,L)))=sez[i]; Yp:=simplify(subs(solve({seq(subs(nez=j,ABrce),j=1..2*stupen+2)}),Yp)); Yg:=simplify(Yg+Yp); od; if nargs=3 then part(zav(nez)=Yg,args[3]) else zav(nez)=Yg; fi; end: