## Reologiai alapelemek soros es parhuzamos kapcsolasainak
## eloallitasa
##
## Az eredo egyenletet is eloallitja
## Nem nezi, hogy van-e nemtrivialis kozos oszto
## Elokeszuletek:
F := 3: ## Ennyifajta kulonbozo elembol epitkezunk
Nmax := 4: ## A max. ennyi elembol allo kapcsolasokat allitjuk elo
S := -1/2: ## A soros es a parhuzamos kapcsolasokat
P := -S: ## ezekkel a szamokkal jeloljuk
igazit := proc(Op) local X: ## Egyszerusit es d
X := collect(expand(Op), d): ## novekvo hatvanyai
series( simplify(X), d, infinity ): ## szerint rendez
end:
minfokszam := proc(Op) local i, x: i := 0: x := Op:
while subs( d=0, x ) = 0 do x := x/d: i := i + 1: od: i:
end: ## A gyari ldegree nem jo erre a celra
maxfokszam := proc(Op) local i, x: i := -1: x := Op:
while x <> 0 do x := diff(x, d): i := i + 1: od: i:
end: ## A gyari degree nem jo erre a celra
kifejtKs := proc(k, n) ## k: kapcsolas sorszama,
## n: eddig ennyi elem lett beszamozva
local K, j, i, l, S: K := Ks[k]: j := n:
for i to nops(K) do l := op(i, K):
if l > F then
S := kifejtKs(l, j):
K := subsop(i = op(1, [S]), K):
j := op(2, [S]):
elif l >= 1 then
j := j + 1:
K := subsop(i = o1k(Pop[l], j), K):
fi:
od: sp(K), j:
end: ## Igy all ossze az alapelemek kapcsolasakent
SPl[S] := Soros: SPl[P] := Parh:
sp := L -> subsop(1 = SPl[ op(1, L) ], L):
## Konvencionalisabb jelolesek az egyutthatokra:
Konvl := [C, mu, M]:
o1k:= proc(Op, oo) local i, X: X := Op:
for i to F do X := subs( U[i-1] = Konvl[i], X ): od:
subs( o = oo, X ):
end:
## 45678901234567890123456789012345678901234567890123456789012345678901234567890
## 1 2 3 4 5 6 7 8
Ks := NULL: ## A talalt kapcsolasok sorozata, egyelore ures
Ts := NULL: ## Eltesszuk azt is, amelyik alakban talaltuk
kmin[1] := 1: ## A kapcsolasok sorozataban az egyelemu
kmax[1] := F: ## kapcsolasok sorszama 1-tol F-ig terjed majd
for k from kmin[1] to kmax[1] do
## Az egyelemu kapcsolasokat egyszeruen a sorszamukkal jeloljuk, most
## beirjuk oket a kapcsolasok sorozataba, fokszamaikat pedig leolvas-
## suk a sigma = P_0 D^(k-1) epsilon alaku egyenletukbol:
Ks := Ks, k: Ts := Ts, k: n[k] := 1: ## n: hanyelemes kapcsolas
Aop[k] := 1: ## A bal oldalon a sigma-ra hato operator
Pop[k] := U[k-1][o]: ## A jobb oldalon az epsilon-ra hato operator
## d^(k-1) utani resze, U az egyutthato
a[k] := 0: m[k] := k - 1: ## A bal oldal maximalis fokszama, a jobb
ph[k] := m[k]: p[k] := 0: ## oldal minimalis es maximalis fokszama,
od: ## a ketto kulonbsege (max. - min.)
for N from 2 to Nmax do ## Eloallitjuk az N elembol allo kapcsolasokat
kmin[N] := kmax[N-1] + 1: ## Kezdeti ertekek;
kmax[N] := kmax[N-1]: ## egyelore meg egyet sem talaltunk
for SP in [S, P] do ## Eloszor a sorosakat, utana a parhuzamosakat
for N1 to floor(N/2) do ## Egy N1 es egy N2 = N - N1 >= N1 elem-
N2 := N - N1: ## bol allo kapcsolasakent keressuk oket
for k1 from kmin[N1] to kmax[N1] do ## Vesszuk sorban az N1
for k2 from kmin[N2] to kmax[N2] do ## es az N2 elemueket
if op(1, Ks[k1]) = SP then ## Ha az elso valto-
s := op( 2 .. nops(Ks[k1]), Ks[k1] ): ## zo is soros/par-
else ## huz., egyesitjuk /
s := k1: ## felemeljuk a maga-
fi: ## sabb szintre
if op(1, Ks[k2]) = SP then ## A masodik
s := s, op( 2 .. nops(Ks[k2]), Ks[k2] ): ## valtozoval
else ## ugyanez
s := s, k2:
fi: l := sort( [SP, s] ): i := 2: ## Sorrendbe rendezzuk
for i from nops(l) to 3 by -1 do ## Ha egyfajta elembol
if l[i] <= F and l[i-1] = l[i] then ## tobb szerepel,
l := subsop(i = NULL, l): ## egyetlen eredo
fi: ## elemme vonjuk ossze
od:
megnincs := true:
for k to kmax[N] do ## Uj kapcsolas-e
if l = Ks[k] then megnincs := false: fi:
od: ## A ciklus lejarta utan k erteke kmax[N] + 1
if megnincs and nops(l) > 2 then ## Pl. [S, 1] nem uj
kmax[N] := k: n[k] := N: ## Eggyel noveljuk kmax[N] -et
Ks := Ks, l: ## Eltesszuk az ujat, es azt az
Ts := Ts, [SP, k1, k2]: ## alakjat is, amelyben talaltuk
Bop := subs( o = o + n[k1], Aop[k2] ): ## Eltoljuk az
Qop := subs( o = o + n[k1], Pop[k2] ): ## egyutthatoit
if SP = P then ## Kiszamoljuk es eltesszuk a fokszamokat:
a[k] := a[k1] + a[k2]: m[k] := min( m[k1], m[k2] ):
ph[k] := max( a[k2] + ph[k1], a[k1] + ph[k2] ):
p[k] := ph[k] - m[k]:
Po := d^(m[k1] - m[k]) * Pop[k1]:
Qo := d^(m[k2] - m[k]) * Qop:
Aop[k] := igazit( Aop[k1] * Bop ):
Pop[k] := igazit( Bop * Po + Aop[k1] * Qo ):
else ## Eloszor is a Kronecker-delta(m[k1], m[k2]):
if m[k1] = m[k2] then Kd := 1: else Kd := 0: fi:
if m[k1] >= m[k2] then m[k] := m[k1]:
a[k] := max( ph[k1] - m[k2] + a[k2], a[k1] + p[k2] ):
## Most pedig az operatorok:
t := 1/( Kd*coeff(Pop[k1], d, 0) + coeff(Qop, d, 0) ):
Op := d^(m[k1] - m[k2]) * Pop[k1] * Bop:
Aop[k] := igazit( t * ( Op + Qop * Aop[k1] ) ):
else m[k] := m[k2]:
a[k] := max( ph[k2] - m[k1] + a[k1], a[k2] + p[k1] ):
t := 1/( coeff(Pop[k1], d, 0) ):
Op := d^(m[k2] - m[k1]) * Qop * Aop[k1]:
Aop[k] := igazit( t * ( Op + Pop[k1] * Bop ) ):
fi: ## m[k1] >= m[k2] volt-e
p[k] := p[k1] + p[k2]: ## Most pedig ha-
ph[k] := p[k] + m[k]: ## rom ettol fug-
Pop[k] := igazit( t * Pop[k1] * Qop ): ## getlen keplet
fi: ## S vagy P volt-e
fi: ## Uj volt-e
od: ## k2
od: ## k1
od: ## N1
od: ## SP
od: ## N
## 1 2 3 4 5 6 7 8
## 45678901234567890123456789012345678901234567890123456789012345678901234567890
## A kapott operatorok es a fokszamok bizonyos ellenorzesei:
for k to kmax[Nmax] do
if minfokszam(Aop[k]) <> 0 then
print(k, "Aop min", minfokszam(Aop[k]) ):
fi:
if simplify( coeff(Aop[k], d, 0) - 1 ) <> 0 then
print(k, "A_0", coeff(Aop[k], d, 0) ):
fi:
if maxfokszam(Aop[k]) <> a[k] then
print(k, "a", maxfokszam(Aop[k]), a[k] ):
fi:
if minfokszam(Pop[k]) <> 0 then
print(k, "Pop min", minfokszam(Pop[k]) ):
fi:
if maxfokszam(Pop[k]) <> p[k] then
print(k, "p", maxfokszam(Pop[k]), p[k] ):
fi:
if ph[k] <> p[k] + m[k] then
print(k, "ph", ph[k], p[k] + m[k]):
fi:
od: ## Ha nem ir ki semmit, akkor nem talalt semmi hibat
## Mely negyelemesek vannak tehetetlensegi Poynting-Thomson-on belul:
for k from kmin[4] to kmax[4] do
if a[k] <= 1 and ph[k] <= 2 then
print( k, op( 1, [kifejtKs(k, 0)] ) ):
print( o1k(Aop[k], 1)*sigma = o1k(igazit(d^(m[k])*Pop[k]), 1)*epsilon ):
fi:
od: