# Berechnungen für Systeme mit impliziten kinematischen Zwangsbedingungen
# Beschreibung
# Allgemeine Berechnungen zu den impliziten Zwangsbedingungen
# Die Bedingungen müssen vorher in einer Roboterspezifischen Datei berechnet werden (händische Erstellung der kinematischen Schleifen und sonstigen Zwangsbedingungen
#
# Dateiname:
# robot -> Berechnung für allgemeinen Roboter
# kinematic_constraints_calculations_implicit -> Berechnungen bezüglich implizit definierter kinematischer Zwangsbedingungen
# Quellen
# [Docquier2013] Docquier, Nicolas and Poncelet, Antoine and Fisette, Paul: ROBOTRAN: a powerful symbolic gnerator of multibody models (2013)
# [DoThanhKotHeiOrt2009b] Do Thanh et al.: On the inverse dynamics problem of general parallel robots (2009)
# [ParkChoPlo1999] Park, FC and Choi, Jihyeon and Ploen, SR: Symbolic formulation of closed chain dynamics in independent coordinates
# Autor
# Moritz Schappler, schappler@imes.uni-hannover.de, 2018-02
# Institut fuer Mechatronische Systeme, Leibniz Universitaet Hannover
# Initialisierung
interface(warnlevel=0): # Unterdrücke die folgende Warnung.
restart: # Gibt eine Warnung, wenn über Terminal-Maple mit read gestartet wird.
interface(warnlevel=3):
interface(rtablesize=30):
with(StringTools): # Für Zeitausgabe
with(LinearAlgebra):
with(codegen):
with(CodeGeneration):
codegen_act := true:
codegen_opt := 2: # Hoher Optimierungsgrad.
;
read "../helper/proc_MatlabExport":
read "../helper/proc_simplify2":
read "../helper/proc_convert_s_t":
read "../helper/proc_convert_t_s":
with(RealDomain): # Schränkt alle Funktionen auf den reellen Bereich ein. Muss nach Definition von MatlabExport kommen. Sonst geht dieses nicht.
;
read "../robot_codegen_constraints/proc_subs_kintmp_exp":
# Definition und Zwangsbedingungen
read "../robot_codegen_definitions/robot_env_IC":
read sprintf("../codeexport/%s/tmp/tree_floatb_definitions", robot_name_OL):
read "../robot_codegen_definitions/robot_env_IC":
# Term-Vereinfachungen: 0=keine; 1=fast alle; 2=auch Zeitableitung der Projektionsmatrix
if not assigned(simplify_options) or simplify_options(1)=-1 then
  use_simplify := 1: # standardmäßig simplify-Befehle anwenden.
else
  use_simplify := simplify_options(1): # erster Eintrag ist für Zwangsbedingungen
end if:

# Lesen der Zwangsbedingungen
kin_constraints_exist := false:
constrfile := sprintf("../codeexport/%s/tmp/kinematic_constraints_implicit_maple.m", robot_name):
if FileTools[Exists](constrfile) then
  read constrfile:
  implconstr_s := implconstr_s: # Für Sichtbarkeit der Variablen
  implconstr_t := implconstr_t: # Für Sichtbarkeit der Variablen
  kin_constraints_exist := kin_constraints_exist: # Für Sichtbarkeit der Variablen
end if:

if kin_constraints_exist = true then:
  printf("Kinematische Zwangsbedingungen in impliziter Form gelesen.\n"):
else
  printf("Es gibt keine impliziten Zwangsbedingungen. Offene Struktur oder nur explizit definierte Bedingungen. Keine weiteren Berechnungen notwendig."):
  restart: # Funktioniert nicht. Gedacht, damit im worksheet-Modus nichts mehr passieren kann.
  robot_name := "": # Damit werden die Export-Befehle ungültig
  codegen_act := false:
  quit:
end if:
NIZB := RowDimension(implconstr_s):
# Gelenkdefinitionen
# Setze aktuierte Gelenke als Minimalkoordinaten voraus
NAJ := add(mu(k), k=1..NJ):
NPJ := NQJ-NAJ:
# Bestimme Indizes der aktiven und passiven Gelenke
# Entspricht Partitionierung der Gelenkwinkel in q1 und q2 in [Docquier2013]. Hier kann die Reihenfolge von aktiven und passiven Winkeln auch durchmischt sein.
IndAct := Matrix(NAJ, 1):
IndPass:= Matrix(NPJ, 1):
ka := 1: kp := 1:
for i from 1 to NQJ do
  if mu(i) = 1 then
    IndAct(ka) := i:
    ka := ka + 1:
  else
    IndPass(kp) := i:
    kp := kp + 1:
  end if:
end do:
printf("Indizes der %d aktiven Gelenke:\n", NAJ);
Transpose(IndAct);
printf("Indizes der %d passiven Gelenke:\n", NPJ);
Transpose(IndPass);
printf("%d Zwangsbedingungsgleichungen\n", NIZB);
# Positionsvektor der Minimalkoordinaten zur Umrechnung OL zu TE/DE
# Zum Vergleich des Ergebnisses aus den expliziten Zwangsbedingungen und den des offenen Systems
posNQJ := Matrix(NJ,1):
for i from 1 to NJ do
  if SearchText("qJ",convert(theta(i),string)) = 1 or SearchText("qJ",convert(d(i),string)) = 1 then
    posNQJ(i) := 1:
  end if:
end do:
# Jacobi-Matrix der Impliziten Zwangsbedingungen in Abhängigkeit der unabhängigen Koordinaten
#
# Entspricht J1 in [Docquier2013], A in [ParkChoPlo1999]
Phia_s := Matrix(NIZB, NAJ):
# Jacobi-Matrix berechnen
for i from 1 to NIZB do
  for j from 1 to NAJ do
    k := IndAct(j):
    Phia_s(i,j) := diff(implconstr_s(i,1), qJ_s(k,1)):
  end do:
end do:
# Jacobi-Matrix der Impliziten Zwangsbedingungen in Abhängigkeit der abhängigen Koordinaten
#
# Entspricht J2 in [Docquier2013], P in [ParkChoPlo1999]
Phip_s := Matrix(NIZB, NPJ):
# Jacobi-Matrix berechnen
for i from 1 to NIZB do
  for j from 1 to NPJ do
    k := IndPass(j):
    Phip_s(i,j) := diff(implconstr_s(i,1), qJ_s(k,1)):
  end do:
end do:
# Vereinfache die Ausdrücke
#
if use_simplify >= 1 then
  tmp_t11 := time():
  tmp_l11 := length(Phia_s):
  printf("%s: Beginne Term-Vereinfachung der %dx%d Zwangsbedingungs-Jacobi für aktive Gelenke. Länge: %d.\n", \
     FormatTime("%Y-%m-%d %H:%M:%S"), RowDimension(Phia_s), ColumnDimension(Phia_s), tmp_l11):
  Phia_s := simplify2(Phia_s):
  tmp_l21 := length(Phia_s):
  tmp_t21 := time():
  tmp_l12 := length(Phip_s):
  printf("%s: Beginne Term-Vereinfachung der %dx%d Zwangsbedingungs-Jacobi für passive Gelenke. Länge: %d.\n", \
     FormatTime("%Y-%m-%d %H:%M:%S"), RowDimension(Phip_s), ColumnDimension(Phip_s), tmp_l12):
  Phip_s := simplify2(Phip_s):
  tmp_l22 := length(Phip_s):
  tmp_t22 := time():
  printf("%s: Terme für Zwangsbedingungs-Jacobis vereinfacht. Länge (aktiv/passiv): %d->%d / %d->%d. Rechenzeit %1.1fs und %1.1fs.\n", \
    FormatTime("%Y-%m-%d %H:%M:%S"), tmp_l11, tmp_l21, tmp_l12, tmp_l22, tmp_t21-tmp_t11, tmp_t22-tmp_t21):
end if:
# Zeitableitung der Jacobi-Matrix
# Wird benötigt, um die Beschleunigung der Gelenkkoordinaten der offenen Struktur zu berechnen.
Phia_t := convert_s_t(Phia_s):
PhiaD_t := diff~(Phia_t, t):
PhiaD_s := convert_t_s(PhiaD_t):

Phip_t := convert_s_t(Phip_s):
PhipD_t := diff~(Phip_t, t):
PhipD_s := convert_t_s(PhipD_t):

# Vereinfache die Ausdrücke
#

if use_simplify >= 1 then
  tmp_t11 := time():
  tmp_l11 := length(PhiaD_s):
  printf("%s: Beginne Term-Vereinfachung der Zeitableitung der %dx%d Zwangsbedingungs-Jacobi für aktive Gelenke. Länge: %d.\n", \
     FormatTime("%Y-%m-%d %H:%M:%S"), RowDimension(PhiaD_s), ColumnDimension(PhiaD_s), tmp_l11):
  PhiaD_s := simplify2(PhiaD_s):
  tmp_l21 := length(PhiaD_s):
  tmp_t21 := time():
  tmp_l12 := length(PhipD_s):
  printf("%s: Beginne Term-Vereinfachung der Zeitableitung der %dx%d Zwangsbedingungs-Jacobi für passive Gelenke. Länge: %d.\n", \
     FormatTime("%Y-%m-%d %H:%M:%S"), RowDimension(PhipD_s), ColumnDimension(PhipD_s), tmp_l12):
  PhipD_s := simplify2(PhipD_s):
  tmp_l22 := length(PhipD_s):
  tmp_t22 := time():
  printf("%s: Terme für Zwangsbedingungs-Jacobis (Zeitableitung) vereinfacht. Länge (aktiv/passiv): %d->%d / %d->%d. Rechenzeit %1.1fs und %1.1fs.\n", \
    FormatTime("%Y-%m-%d %H:%M:%S"), tmp_l11, tmp_l21, tmp_l12, tmp_l22, tmp_t21-tmp_t11, tmp_t22-tmp_t21):
end if:
# Exportiere Code für folgende Skripte
# Speichere Maple-Ausdruck (Eingabe-Format und internes Format)
save Phia_s, sprintf("../codeexport/%s/tmp/kinematic_constraints_explicit_active_jacobian_maple.m", robot_name):
save PhiaD_s, sprintf("../codeexport/%s/tmp/kinematic_constraints_explicit_active_jacobian_time_derivative_maple.m", robot_name):
save Phip_s, sprintf("../codeexport/%s/tmp/kinematic_constraints_explicit_passive_jacobian_maple.m", robot_name):
save PhipD_s, sprintf("../codeexport/%s/tmp/kinematic_constraints_explicit_passive_jacobian_time_derivative_maple.m", robot_name):
save posNQJ, IndAct, IndPass, sprintf("../codeexport/%s/tmp/positionVector_NQJ_maple.m", robot_name):
printf("Ausdrücke für Kinematische ZB gespeichert (Maple)\n"):
if codegen_act then
  MatlabExport(implconstr_s, sprintf("../codeexport/%s/tmp/kinconstr_impl_matlab.m", robot_name), codegen_opt):
  MatlabExport(Phia_s, sprintf("../codeexport/%s/tmp/kinconstr_impl_active_jacobian_matlab.m", robot_name), codegen_opt):
  MatlabExport(PhiaD_s, sprintf("../codeexport/%s/tmp/kinconstr_impl_active_jacobianD_matlab.m", robot_name), codegen_opt):
  MatlabExport(Phip_s, sprintf("../codeexport/%s/tmp/kinconstr_impl_passive_jacobian_matlab.m", robot_name), codegen_opt):
  MatlabExport(PhipD_s, sprintf("../codeexport/%s/tmp/kinconstr_impl_passive_jacobianD_matlab.m", robot_name), codegen_opt):
  MatlabExport(posNQJ, sprintf("../codeexport/%s/tmp/positionVector_NQJ_matlab.m", robot_name), codegen_opt):
  printf("Ausdrücke für Kinematische ZB gespeichert (Matlab)\n"):
end if:

# Invertierung der Gradientenmatrix
# Invertiere die Gradientenmatrix bezüglich der passiven Gelenke
n1 := RowDimension(Phip_s):
n2 := ColumnDimension(Phip_s):
# Erstelle Matrix ppf mit der Form der Gradientmatrix Phip_s
ppf := Matrix(n1,n2,symbol=uu):
for i from 1 to n1 do
  for j from 1 to n2 do
    if Phip_s(i,j) = 0 then
      ppf(i,j) := 0:
    end if:
  end do:
end do:
# Invertiere die allgemeine Form der Matrix und setze dann die Einträge ein.
InvPhip_sf := MatrixInverse(ppf):
InvPhip_s := InvPhip_sf:

for i from 1 to n1 do
  for j from 1 to n2 do
    if not Phip_s(i,j) = 0 then
      InvPhip_s := subs({ppf(i,j)=Phip_s(i,j)}, InvPhip_s):
    end if:
  end do:
end do:

# Vereinfache den Ausdruck
if use_simplify >= 1 then
  tmp_t1 := time(): tmp_l1 := length(InvPhip_s):
  printf("%s: Beginne Term-Vereinfachung der inversen %dx%d Zwangsbedingungs-Jacobi für passive Gelenke. Länge: %d.\n", \
     FormatTime("%Y-%m-%d %H:%M:%S"), RowDimension(InvPhip_s), ColumnDimension(InvPhip_s), tmp_l1):
  InvPhip_s := simplify2(InvPhip_s):
  tmp_t2 := time(): tmp_l2 := length(InvPhip_s):
  printf("%s. Inverse Passiv-Gelenk-Jacobi der ZB vereinfacht. Länge: %d->%d. Rechenzeit %1.1fs.\n", \
    FormatTime("%Y-%m-%d %H:%M:%S"), tmp_l1, tmp_l2, tmp_t2-tmp_t11):
end if:
save InvPhip_s, sprintf("../codeexport/%s/tmp/kinematic_constraints_explicit_passive_jacobian_inv_maple", robot_name):
if codegen_act then
  MatlabExport(InvPhip_sf, sprintf("../codeexport/%s/tmp/kinconstr_impl_passive_jacobian_inv_matlab.m", robot_name), codegen_opt):
end if:

# Projektionsmatrix aus impliziter Gradientenmatrix
#
# Form der Projektionsmatrix anschauen
B21f := -InvPhip_sf.Phia_s:
# Projektionsmatrix berechnen. [Docquier2013], Text nach Gl. 12
B21 := -InvPhip_s.Phia_s:
# Vereinfache den Ausdruck
if use_simplify >= 1 then
  tmp_t1 := time(): tmp_l1 := length(B21):
  printf("%s: Beginne Term-Vereinfachung der %dx%d Zwangsbedingungs-Projektionsmatrix. Länge: %d.\n", \
     FormatTime("%Y-%m-%d %H:%M:%S"), RowDimension(B21), ColumnDimension(B21), tmp_l1):
  B21 := simplify2(B21):
  tmp_t2 := time(): tmp_l2 := length(B21):
  printf("%s. ZB-Projektionsmatrix vereinfacht. Länge: %d->%d. Rechenzeit %1.1fs.\n", \
    FormatTime("%Y-%m-%d %H:%M:%S"), tmp_l1, tmp_l2, tmp_t2-tmp_t11):
end if:
save B21, sprintf("../codeexport/%s/tmp/kinconstr_impl_projection_jacobian_maple", robot_name):
if codegen_act then
  MatlabExport(B21, sprintf("../codeexport/%s/tmp/kinconstr_impl_projection_jacobian_matlab.m", robot_name), codegen_opt):
end if:

# Zeitableitung der Projektionsmatrix
# [ParkChoPlo1999], Text nach Gl. 73
# [DoThanhKotHeiOrt2009b], Gl. 20
B21D := (InvPhip_s . PhipD_s . InvPhip_s . Phia_s ) + (-InvPhip_s.PhiaD_s):
# Vereinfache den Ausdruck
if use_simplify >= 2 then
  tmp_t1 := time(): tmp_l1 := length(B21D):
  printf("%s: Beginne Term-Vereinfachung der Zeitableitung der %dx%d Zwangsbedingungs-Projektionsmatrix. Länge: %d.\n", \
     FormatTime("%Y-%m-%d %H:%M:%S"), RowDimension(B21D), ColumnDimension(B21D), tmp_l1):
  B21D := simplify2(B21D):
  tmp_t2 := time(): tmp_l2 := length(B21D):
  printf("%s. ZB-Projektionsmatrix-Zeitableitung vereinfacht. Länge: %d->%d. Rechenzeit %1.1fs.\n", \
    FormatTime("%Y-%m-%d %H:%M:%S"), tmp_l1, tmp_l2, tmp_t2-tmp_t11):
end if:
save B21D, sprintf("../codeexport/%s/tmp/kinconstr_impl_projection_jacobian_derivative_maple", robot_name):
if codegen_act then
  MatlabExport(B21D, sprintf("../codeexport/%s/tmp/kinconstr_impl_projection_jacobian_derivative_matlab.m", robot_name), codegen_opt):
end if:

printf("Fertig\n"):


`is_element/prime_W` := (N::posint) -> (A::set) -> proc(x)
 `is_element/vector_functions`(N)(A)(x) and
 `sum/vector_functions`(N)(A)(x) = [0$N];
end;

######################################################################

`is_equal/prime_W` := (N::posint) -> (A::set) -> proc(x,y)
 return `is_equal/vector_functions`(N)(A)(x,y);
end;

######################################################################

`is_leq/prime_W` := NULL;

######################################################################

`is_zero/prime_W` := (N::posint) -> (A::set) -> proc(x)
 return `is_zero/vector_functions`(N)(A)(x);
end;

######################################################################

`norm/prime_W` := (N::posint) -> (A::set) -> proc(x)
 return `norm/vector_functions`(N)(A)(x);
end;

######################################################################

`normalise/prime_W` := (N::posint) -> (A::set) -> proc(x)
 local r,a;
 r := `norm/vector_functions`(N)(A)(x);
 if r = 0 then return FAIL; fi;
 return table([seq(a = simplify(x[a] /~ r),a in A)]);
end;

######################################################################

`random_element/prime_W` := (N::posint) -> (A::set) -> proc()
 local x,a,u;

 u := [0$N];
 x := table();
 for a in A do
  x[a] := `random_element/R`(N)();
  u := u +~ x[a];
 od:
 u := u /~ nops(A);
 for a in A do
  x[a] := x[a] -~ u;
 od;

 return eval(x);
end;

`list_elements/W` := NULL;
`count_elements/W` := NULL;

######################################################################
# Here C is assumed to be a subset of B, and rho is the usual map
# from W(N,B) to W(N,C).

`rho/prime_W` := (B,C) -> proc(x)
 local y,z,c;

 y := table();
 for c in C do y[c] := x[c]; od;
 z := `normalise/W`(N)(C)(y);
 return eval(z);
end;


(*
 Copyright (C) 2017 M.A.L. Marques

 This Source Code Form is subject to the terms of the Mozilla Public
 License, v. 2.0. If a copy of the MPL was not distributed with this
 file, You can obtain one at http://mozilla.org/MPL/2.0/.
*)

(* type: mgga_exc *)

(* prefix:
  mgga_x_mvsb_params *params;

  assert(p->params != NULL);
  params = (mgga_x_mvsb_params * ) (p->params);
*)

$include "mgga_x_mvs.mpl"

mvsb_beta := (t, x) -> mvs_alpha(t, x)*K_FACTOR_C/(t - K_FACTOR_C):

mvsb_f := (x, u, t) -> (1 + params_a_k0*mvs_fa(mvsb_beta(t,x)))
       / (1 + params_a_b*(X2S*x)^4)^(1/8):

f := (rs, z, xt, xs0, xs1, u0, u1, t0, t1) ->
  mgga_exchange(mvsb_f, rs, z, xs0, xs1, u0, u1, t0, t1):


(*
 Copyright (C) 2017 M.A.L. Marques

 This Source Code Form is subject to the terms of the Mozilla Public
 License, v. 2.0. If a copy of the MPL was not distributed with this
 file, You can obtain one at http://mozilla.org/MPL/2.0/.
*)

(* type: mgga_exc *)
(* prefix:
  mgga_c_m06l_params *params;

  assert(p->params != NULL);
  params = (mgga_c_m06l_params * )(p->params);
*)

$include "mgga_c_vsxc.mpl"
$include "mgga_c_m05.mpl"

m06l_f := (rs, z, xs0, xs1, ts0, ts1) ->
  + m05_f(rs, z, xs0, xs1, ts0, ts1)
  + vsxc_f(rs, z, xs0, xs1, ts0, ts1):

f := (rs, z, xt, xs0, xs1, us0, us1, ts0, ts1) ->
  m06l_f(rs, z, xs0, xs1, ts0, ts1):


#@ Not autoload

E := proc(u)
 local n,i;
 if type(u,`+`) then
  return(map(E,u));
 else
  return('E'(u));
 fi;
end:

H := proc(u)
 local n,i,J;
 if type(u,`+`) then
  return(map(H,u));
 else
  return('H'(u));
 fi;
end:

P := proc(u)
 local n,i;
 if type(u,`+`) then
  return(map(P,u));
 else
  return('P'(u));
 fi;
end:

o := proc(a,b)
 if a=0 or b=0 then
  return(0);
 elif type(b,`+`) then
  return(map2(o,a,b));
 elif type(a,indexed) and op(0,a)=x and op(2,a)=[] then
  return(b);
 elif type(b,indexed) and op(0,b)=x and op(2,b)=[] then
  return(a);
 else
  return('o'(args));
 fi;
end:

is_o := proc(u)
 type(u,specfunc(anything,o));
end:

SpherePi := proc(n,m)
 local stem,is_stable,G;
 stem := n-m;
 is_stable := evalb(m>stem+1);

 if stem<0 or m<=0 or (n>1 and m=1) then
  return(Group());
 elif stem=0 then
  return(Group([],[x[n,[]]]));
 elif is_stable then
  G := StableSpherePi(stem);
  return(Group(map(a -> x[m,op(2,a)],op(1,G))));
 else
  return('SpherePi'(n,m));
 fi;
end:

Source := proc(a)
 if type(a,indexed) and op(0,a) = x then
  return(op(1,a) + `+`(op(op(2,a))));
 elif is_o(a) and nops(a) > 0 then
  return Source(op(nops(a),a))
 else
  return('Source'(args));
 fi;
end:

Target := proc(a)
 if type(a,indexed) and op(0,a) = x then
  return(op(1,a));
 elif is_o(a) and nops(a) > 0 then
  return Target(op(1,a))
 else
  return('Target'(args));
 fi;
end:

Stem := proc(a) Source(a) - Target(a); end:

IsAdmissible := proc(a)
 local m,J,r,i;
 if type(a,indexed) and op(0,a) = x then
  m := op(1,a);
  J := op(2,a);
  r := nops(J);
  if r>0 and J[1] >= m then
   return(false);
  fi;
  for i from 1 to r-1 do
   if J[i+1] > 2*J[i] then
    return(false);
   fi;
  od;
  return(true);
 else
  return('IsAdmissible'(args));
 fi;
end:

# 1-stem

SpherePi( 3, 2) := Group([],[x[2,[1]]]):
SpherePi( 4, 3) := Group([x[3,[1]]]):

StableSpherePi( 1) := Group([x[infinity,[1]]]):

# 2-stem

SpherePi( 4, 2) := Group([x[2,[1,1]]]):
SpherePi( 5, 3) := Group([x[3,[1,1]]]):

StableSpherePi( 2) := Group([x[infinity,[1,1]]]):

# 3-stem

SpherePi( 5, 2) := Group([x[2,[1,1,1]]]):
SpherePi( 6, 3) := Group([x[3,[2,1]],
                          x[3,[1,1,1]]]):
SpherePi( 7, 4) := Group([x[4,[2,1]],
                          x[4,[1,1,1]]],
                         [x[4,[3]]]):

StableSpherePi( 3) := Group([x[infinity,[3]],
		             x[infinity,[2,1]],
		             x[infinity,[1,1,1]]]):

# 4-stem

SpherePi( 6, 2) := Group([x[2,[1,1,1,1]],
                          x[2,[1,2,1]]]):
SpherePi( 7, 3) := Group([x[3,[2,1,1]]]):
SpherePi( 8, 4) := Group([x[4,[3,1]],
                          x[4,[2,1,1]]]):
SpherePi( 9, 5) := Group([x[5,[3,1]]]):

StableSpherePi( 4) := Group([]):

# 5-stem

SpherePi( 7, 2) := Group([x[2,[1,2,1,1]]]):
SpherePi( 8, 3) := Group([x[3,[2,1,1,1]]]):
SpherePi( 9, 4) := Group([x[4,[3,1,1]],
                          x[4,[2,1,1,1]]]):
SpherePi(10, 5) := Group([x[5,[3,1,1]]]):
SpherePi(11, 6) := Group([],[x[6,[5,0]]]):

StableSpherePi( 5) := Group([]):

# 6-stem

SpherePi( 8, 2) := Group([x[2,[1,2,1,1,1]]]):
SpherePi( 9, 3) := Group([]):
SpherePi(10, 4) := Group([x[4,[3,3]],
                          x[4,[3,2,1]],
                          x[4,[3,1,1,1]]]):
SpherePi(11, 5) := Group([x[5,[3,3]]]):
SpherePi(12, 6) := Group([x[6,[3,3]]]):
SpherePi(13, 7) := Group([x[7,[3,3]]]):

StableSpherePi( 6) := Group([x[infinity,[3,3]]]):

# 7-stem

SpherePi( 9, 2) := Group([]):
SpherePi(10, 3) := Group([]):
SpherePi(11, 4) := Group([]):
SpherePi(12, 5) := Group([x[5,[4,1,1,1]]]):
SpherePi(13, 6) := Group([x[6,[5,1,1]],
                          x[6,[4,1,1,1]]]):
SpherePi(14, 7) := Group([x[7,[6,1]],
                          x[7,[5,1,1]],
                          x[7,[4,1,1,1]]]):
SpherePi(15, 8) := Group([x[8,[6,1]]],[x[8,[7]]]):

StableSpherePi( 7) := Group([x[infinity,[7]],
		             x[infinity,[6,1]],
                             x[infinity,[5,1,1]],
                             x[infinity,[4,1,1,1]]]):

# 8-stem

SpherePi(10, 2) := Group([]):
SpherePi(11, 3) := Group([x[3,[2,3,3]]]):
SpherePi(12, 4) := Group([x[4,[2,3,3]]]):
SpherePi(13, 5) := Group([x[5,[2,3,3]]]):
SpherePi(14, 6) := Group([x[6,[5,3]],
                          x[6,[5,2,1]],
                          x[6,[5,1,1,1]],
                          x[6,[2,3,3]]]):
SpherePi(15, 7) := Group([x[7,[6,1,1]],
                          x[7,[5,3]],
                          x[7,[2,3,3]]]):
SpherePi(16, 8) := Group([x[8,[7,1]],
                          x[8,[6,1,1]],
                          x[8,[5,3]],
                          x[8,[2,3,3]]]):
SpherePi(17, 9) := Group([x[9,[7,1]],
                          x[9,[5,3]],
                          x[9,[2,3,3]]]):

StableSpherePi( 8) := Group([x[infinity,[5,3]],
                             x[infinity,[2,3,3]]]):

# 9-stem

SpherePi(11, 2) := Group([x[2,[1,2,3,3]]]):
SpherePi(12, 3) := Group([x[3,[2,4,1,1,1]],
                          x[3,[1,2,3,3]]]):
SpherePi(13, 4) := Group([x[4,[3,3,3]],
                          x[4,[2,4,1,1,1]],
                          x[4,[1,2,3,3]]]):
SpherePi(14, 5) := Group([x[5,[3,3,3]],
                          x[5,[2,4,1,1,1]],
                          x[5,[1,2,3,3]]]):
SpherePi(15, 6) := Group([x[6,[3,3,3]],
                          x[6,[2,4,1,1,1]],
                          x[6,[1,2,3,3]]]):
SpherePi(16, 7) := Group([x[7,[6,1,1,1]],
                          x[7,[3,3,3]],
                          x[7,[2,4,1,1,1]],
                          x[7,[1,2,3,3]]]):
SpherePi(17, 8) := Group([x[8,[7,1,1]],
                          x[8,[6,1,1,1]],
                          x[8,[3,3,3]],
                          x[8,[2,4,1,1,1]],
                          x[8,[1,2,3,3]]]):
SpherePi(18, 9) := Group([x[9,[7,1,1]],
                          x[9,[3,3,3]],
                          x[9,[2,4,1,1,1]],
                          x[9,[1,2,3,3]]]):
SpherePi(19,10) := Group([x[10,[3,3,3]],
                          x[10,[2,4,1,1,1]],
                          x[10,[1,2,3,3]]],
                         [x[10,[9,0]]]):

StableSpherePi( 9) := Group([x[infinity,[3,3,3]],
                             x[infinity,[2,4,1,1,1]],
                             x[infinity,[1,2,3,3]]]):

# 10-stem

SpherePi(12, 2) := Group([x[2,[1,2,4,1,1,1]],
                          x[2,[1,1,2,3,3]]]):
SpherePi(13, 3) := Group([x[3,[2,2,3,3]],
                          x[3,[1,2,4,1,1,1]],
                          x[3,[1,1,2,3,3]]]):
SpherePi(14, 4) := Group([x[4,[3,6,1]],
                          x[4,[3,5,1,1]],
                          x[4,[3,4,1,1,1]],
                          x[4,[2,2,3,3]],
                          x[4,[1,2,4,1,1,1]],
                          x[4,[1,1,2,3,3]]]):
SpherePi(15, 5) := Group([x[5,[4,3,3]],
                          x[5,[2,2,3,3]],
                          x[5,[1,2,4,1,1,1]],
                          x[5,[1,1,2,3,3]]]):
SpherePi(16, 6) := Group([x[6,[4,3,3]],
                          x[6,[2,2,3,3]],
                          x[6,[1,2,4,1,1,1]],
                          x[6,[1,1,2,3,3]]]):
SpherePi(17, 7) := Group([x[7,[4,3,3]],
                          x[7,[2,2,3,3]],
                          x[7,[1,2,4,1,1,1]],
                          x[7,[1,1,2,3,3]]]):
SpherePi(18, 8) := Group([x[8,[7,3]],
                          x[8,[7,2,1]],
                          x[8,[7,1,1,1]],
                          x[8,[4,3,3]],
                          x[8,[2,2,3,3]],
                          x[8,[1,2,4,1,1,1]],
                          x[8,[1,1,2,3,3]]]):
SpherePi(19, 9) := Group([x[9,[7,3]],
                          x[9,[7,2,1]],
                          x[9,[7,1,1,1]],
                          x[9,[1,2,4,1,1,1]]]):
SpherePi(20,10) := Group([x[10,[7,3]],
                          x[10,[7,2,1]],
                          x[10,[1,2,4,1,1,1]]]):
SpherePi(21,11) := Group([x[11,[7,3]],
                          x[11,[1,2,4,1,1,1]]]):

StableSpherePi(10) := Group([x[infinity,[1,2,4,1,1,1]]]):

# 11-stem

SpherePi(13, 2) := Group([x[2,[1,2,2,3,3]],
                          x[2,[1,1,1,2,3,3]],
                          x[2,[1,1,2,4,1,1,1]]]):
SpherePi(14, 3) := Group([x[3,[2,3,3,3]],
                          x[3,[2,2,4,1,1,1]],
                          x[3,[2,1,2,3,3]],
                          x[3,[1,1,2,4,1,1,1]]]):
SpherePi(15, 4) := Group([x[4,[3,6,1,1]],
                          x[4,[3,5,3]],
                          x[4,[3,2,3,3]],
                          x[4,[2,3,3,3]],
                          x[4,[2,2,4,1,1,1]],
                          x[4,[2,1,2,3,3]],
                          x[4,[1,1,2,4,1,1,1]]]):
SpherePi(16, 5) := Group([x[5,[4,4,1,1,1]],
                          x[5,[3,5,3]],
                          x[5,[3,2,3,3]],
                          x[5,[2,2,4,1,1,1]],
                          x[5,[1,1,2,4,1,1,1]]]):
SpherePi(17, 6) := Group([x[6,[5,3,3]],
                          x[6,[4,4,1,1,1]],
                          x[6,[2,2,4,1,1,1]],
                          x[6,[1,1,2,4,1,1,1]]]):
SpherePi(18, 7) := Group([x[7,[5,3,3]],
                          x[7,[4,4,1,1,1]],
                          x[7,[2,2,4,1,1,1]],
                          x[7,[1,1,2,4,1,1,1]]]):
SpherePi(19, 8) := Group([x[8,[5,3,3]],
                          x[8,[4,4,1,1,1]],
                          x[8,[2,2,4,1,1,1]],
                          x[8,[1,1,2,4,1,1,1]]]):
SpherePi(20, 9) := Group([x[9,[5,3,3]],
                          x[9,[4,4,1,1,1]],
                          x[9,[2,2,4,1,1,1]],
                          x[9,[1,1,2,4,1,1,1]]]):
SpherePi(21,10) := Group([x[10,[4,4,1,1,1]],
                          x[10,[2,2,4,1,1,1]],
                          x[10,[1,1,2,4,1,1,1]]]):
SpherePi(22,11) := Group([x[11,[4,4,1,1,1]],
                          x[11,[2,2,4,1,1,1]],
                          x[11,[1,1,2,4,1,1,1]]]):
SpherePi(23,12) := Group([x[12,[4,4,1,1,1]],
                          x[12,[2,2,4,1,1,1]],
                          x[12,[1,1,2,4,1,1,1]]]):

StableSpherePi(11) := Group([x[infinity,[4,4,1,1,1]],
                             x[infinity,[2,2,4,1,1,1]],
                             x[infinity,[1,1,2,4,1,1,1]]]):

# 12-stem

StableSpherePi(12) := Group([]):

# 13-stem

StableSpherePi(13) := Group([]):

# 14-stem

StableSpherePi(14) := Group([x[infinity,[7,7]],
                             x[infinity,[6,2,3,3]]]):

N := 11:
degrees_above := (k) -> [seq(k+i,i=0..N),infinity];

for n in degrees_above(1) do
 TodaName(x[n,[]]) := iota[n]:
od:

for n in degrees_above(2) do
 TodaName(x[n,[1]]) := eta[n]:
 TodaName(x[n,[1,1]]) := o(eta[n],eta[n+1]):
 TodaName(x[n,[1,2,3,3]]) := o(eta[n],epsilon[n+1]):
 TodaName(x[n,[1,2,4,1,1,1]]) := o(eta[n],mu[n+1]):
od:

for n in degrees_above(3) do
 TodaName(x[n,[2,3,3]]) := epsilon[n]:
 TodaName(x[n,[2,4,1,1,1]]) := mu[n]:
od:

for n in degrees_above(4) do
 TodaName(x[n,[3]]) := nu[n]:
 TodaName(x[n,[3,3,3]]) := o(nu[n],nu[n+3],nu[n+6]):
od:

for n in degrees_above(5) do
 TodaName(x[n,[4,4,1,1,1]]) := zeta[n]:
 TodaName(x[n,[2,2,4,1,1,1]]) := 2 * zeta[n]:
 TodaName(x[n,[1,1,2,4,1,1,1]]) := 4 * zeta[n]:
 TodaName(x[n,[3,3]]) := o(nu[n],nu[n+3]):
 TodaName(x[n,[2,1]]) :=  2 * nu[n]:
 TodaName(x[n,[1,1,1]]) :=  4 * nu[n]:
od:

for n in degrees_above(6) do
 TodaName(x[n,[5,3]]) := nubar[n]:
od:

for n in degrees_above(8) do
 TodaName(x[n,[7]]) := sigma[n]:
od:

for n in degrees_above(9) do
 TodaName(x[n,[6,1]]) := 2*sigma[n]:
 TodaName(x[n,[5,1,1]]) := 4*sigma[n]:
 TodaName(x[n,[4,1,1,1]]) := 8*sigma[n]:
od:

TodaName(x[2,[1,1,1,1]]) := - o(eta[2],nuprime):
TodaName(x[8,[7]]) := sigma[8]:
TodaName(x[2,[1,2,2,3,3]]) := 3 * o(eta[2],epsilonprime):
TodaName(x[2,[1,2,2,4,1,1,1]]) := 3 * o(eta[2],muprime):
TodaName(x[2,[1,1,1]]) := o(eta[2],eta[3],eta[4]):
TodaName(x[3,[1,1,1]]) := 2 * nuprime:
TodaName(x[3,[2,1]]) := nuprime:
TodaName(x[4,[1,1,1]]) := 2 * E(nuprime):
TodaName(x[4,[2,1]]) := E(nuprime):
TodaName(x[2,[1,2,1]]) := 2 * o(eta[2],nuprime):
TodaName(x[3,[2,1,1]]) := o(nuprime,eta[6]):
TodaName(x[4,[2,1,1]]) := o(E(nuprime),eta[7]):
TodaName(x[4,[3,1]]) := o(nu[4],eta[7]):
TodaName(x[5,[3,1]]) := o(nu[5],eta[8]):
TodaName(x[2,[1,2,1,1]]) := o(eta[2],nuprime,eta[6]):
TodaName(x[3,[2,1,1,1]]) := o(nuprime,eta[6],eta[7]):
TodaName(x[4,[3,1,1]]) := o(nu[4],eta[7],eta[8]):
TodaName(x[4,[2,1,1,1]]) := o(E(nuprime),eta[7],eta[8]):
TodaName(x[5,[3,1,1]]) := o(nu[5],eta[8],eta[9]):
TodaName(x[6,[5,0]]) := w[6]:
TodaName(x[2,[1,2,1,1,1]]) := o(eta[2],nuprime,eta[6],eta[7]):
TodaName(x[4,[3,3]]) := o(nu[4],nu[7]):
TodaName(x[4,[3,2,1]]) := 2*o(nu[4],nu[7]):
TodaName(x[4,[3,1,1,1]]) := 4*o(nu[4],nu[7]):
TodaName(x[5,[4,1,1,1]]) := sigmathird:
TodaName(x[6,[5,1,1]]) := sigmasecond:
TodaName(x[6,[4,1,1,1]]) := 2*sigmasecond:
TodaName(x[7,[6,1]]) := sigmaprime:
TodaName(x[7,[5,1,1]]) := 2*sigmaprime:
TodaName(x[7,[4,1,1,1]]) := 4*sigmaprime:
TodaName(x[8,[6,1]]) := E(sigmaprime):
TodaName(x[8,[5,1,1]]) := 2*E(sigmaprime):
TodaName(x[8,[4,1,1,1]]) := 4*E(sigmaprime):
TodaName(x[6,[5,2,1]]) := 2*nubar[6]:
TodaName(x[6,[5,1,1,1]]) := 4*nubar[6]:
TodaName(x[7,[6,1,1]]) := o(sigmaprime,eta[14]):
TodaName(x[8,[6,1,1]]) := o(E(sigmaprime),eta[15]):
TodaName(x[8,[7,1]]) := o(sigma[8],eta[15]):
TodaName(x[9,[7,1]]) := o(sigma[9],eta[16]):
TodaName(x[7,[6,1,1,1]]) := o(sigmaprime,eta[14],eta[15]):
TodaName(x[8,[6,1,1,1]]) := o(E(sigmaprime),eta[15],eta[16]):
TodaName(x[8,[7,1,1]]) := o(sigma[8],eta[15],eta[16]):
TodaName(x[9,[7,1,1]]) := o(sigma[9],eta[16],eta[17]):
TodaName(x[2,[1,1,2,3,3]]) := o(eta[2],eta[3],epsilon[4]):
TodaName(x[3,[2,2,3,3]]) := epsilonprime:
TodaName(x[3,[1,1,2,3,3]]) := 2*epsilonprime:
TodaName(x[4,[2,2,3,3]]) := E(epsilonprime):
TodaName(x[4,[1,1,2,3,3]]) := 2*E(epsilonprime):
TodaName(x[4,[3,6,1]]) := o(nu[4],sigmaprime):
TodaName(x[4,[3,5,1,1]]) := 2*o(nu[4],sigmaprime):
TodaName(x[4,[3,4,1,1,1]]) := 4*o(nu[4],sigmaprime):
TodaName(x[5,[4,3,3]]) := o(nu[5],sigma[8]):
TodaName(x[5,[2,2,3,3]]) := 2*o(nu[5],sigma[8]):
TodaName(x[5,[1,1,2,3,3]]) := 4*o(nu[5],sigma[8]):
TodaName(x[6,[4,3,3]]) := o(nu[6],sigma[9]):
TodaName(x[6,[2,2,3,3]]) := 2*o(nu[6],sigma[9]):
TodaName(x[6,[1,1,2,3,3]]) := 4*o(nu[6],sigma[9]):
TodaName(x[7,[4,3,3]]) := o(nu[7],sigma[10]):
TodaName(x[7,[2,2,3,3]]) := 2*o(nu[7],sigma[10]):
TodaName(x[7,[1,1,2,3,3]]) := 4*o(nu[7],sigma[10]):
TodaName(x[8,[4,3,3]]) := o(nu[8],sigma[11]):
TodaName(x[8,[2,2,3,3]]) := 2*o(nu[8],sigma[11]):
TodaName(x[8,[1,1,2,3,3]]) := 4*o(nu[8],sigma[11]):
TodaName(x[8,[7,3]]) := o(sigma[8],nu[15]):
TodaName(x[8,[7,2,1]]) := 2*o(sigma[8],nu[15]):
TodaName(x[8,[7,1,1,1]]) := 4*o(sigma[8],nu[15]):
TodaName(x[9,[7,3]]) := o(sigma[9],nu[16]):
TodaName(x[9,[7,2,1]]) := 2*o(sigma[9],nu[16]):
TodaName(x[9,[7,1,1,1]]) := 4*o(sigma[9],nu[16]):
TodaName(x[10,[9,0]]) := w[10]:
TodaName(x[10,[7,3]]) := o(sigma[10],nu[17]):
TodaName(x[10,[7,2,1]]) := 2*o(sigma[10],nu[17]):
TodaName(x[11,[7,3]]) := o(sigma[11],nu[18]):
TodaName(x[2,[1,1,1,2,3,3]]) := 2*o(eta[2],epsilonprime):
TodaName(x[2,[1,1,2,4,1,1,1]]) := o(eta[2],eta[3],mu[4]):
TodaName(x[3,[2,2,4,1,1,1]]) := muprime:
TodaName(x[3,[1,1,2,4,1,1,1]]) := 2*muprime:
TodaName(x[3,[2,3,3,3]]) := o(epsilon[3],nu[11]):
TodaName(x[3,[2,1,2,3,3]]) := o(nuprime,epsilon[6]):
TodaName(x[4,[2,2,4,1,1,1]]) := E(muprime):
TodaName(x[4,[1,1,2,4,1,1,1]]) := 2*E(muprime):
TodaName(x[4,[2,3,3,3]]) := o(epsilon[4],nu[12]):
TodaName(x[4,[2,1,2,3,3]]) := o(E(nuprime),epsilon[7]):
TodaName(x[4,[3,6,1,1]]) := o(nu[4],sigmaprime,eta[14]):
TodaName(x[4,[3,5,3]]) := o(nu[4],nubar[7]):
TodaName(x[4,[3,2,3,3]]) := o(nu[4],epsilon[7]):
TodaName(x[5,[3,5,3]]) := o(nu[5],nubar[8]):
TodaName(x[5,[3,2,3,3]]) := o(nu[5],epsilon[8]):
TodaName(x[6,[5,3,3]]) := o(nubar[6],nu[14]):
TodaName(x[6,[3,2,3,3]]) := 2*o(nubar[6],nu[14]):
TodaName(x[7,[5,3,3]]) := o(nubar[7],nu[15]):
TodaName(x[8,[5,3,3]]) := o(nubar[8],nu[16]):
TodaName(x[9,[5,3,3]]) := o(nubar[9],nu[17]):

generators  :=  proc(G)
 map(op,[op(G)]):
end:

for i from 0 to N do
 for j from 1 to i+2 do
  G  :=  SpherePi(i+j,j):
  for a in generators(G) do
   if not(Source(a)=i+j and
          Target(a)=j and
          IsAdmissible(a)) then
    print([i+j,j,a]):
   fi:
  od:
 od:
od:

all_gens  :=  [seq(seq(op(generators(SpherePi(i,j))),i=1..j+N),j=1..N+2)]:

for a in all_gens do
 GN(TodaName(a)) := a:
od:

for a in all_gens do
 m := Source(a):
 n := Target(a):
 b := two(a):
 if type(b,specfunc(anything,two)) then
  two(a) := 0:
 fi:
 b := E(a):
 if type(b,specfunc(anything,E)) then
  E(a) := x[op(1,a)+1,op(2,a)]:
 fi:
 b := H(a):
 if type(b,specfunc(anything,H)) then
  if (2*m-1>n or n=m) then
   H(a) := 0:
  else
   J := op(2,a):
   if J[1] > n-1 then
    H(a) := 0:
   else
    H(a) := x[2*n-1,J[2..-1]]:
   fi:
  fi:
 fi:

 o(a,x[m,[]]) := a;
 o(x[n,[]],a) := a;
od:

for n in degrees_above(5) do
 two(x[n,[3]]) := x[n,[2,1]]:
 two(x[n,[2,1]]) := x[n,[1,1,1]]:
 two(x[n,[4,4,1,1,1]]) := x[n,[2,2,4,1,1,1]]:
 two(x[n,[2,2,4,1,1,1]]) := x[n,[1,1,2,4,1,1,1]]:
od:

for n in degrees_above(6) do
 two(x[n,[5,1,1]])       := x[n,[4,1,1,1]]:
od:

for n in degrees_above(9) do
 two(x[n,[7]]) := x[n,[6,1]]:
 two(x[n,[6,1]]) := x[n,[5,1,1]]:
 two(x[n,[5,1,1]]) := x[n,[4,1,1,1]]:
od:

two(x[2,[1]])           := x[2,[1,0]]:
two(x[2,[1,1,1,1]])     := x[2,[1,2,1]]:
two(x[2,[1,1,1,1]])     := x[2,[1,2,1]]:
two(x[2,[1,2,2,3,3]])   := x[2,[1,1,1,2,3,3]]:
two(x[3,[2,1]])         := x[3,[1,1,1]]:
two(x[4,[3]])           := x[4,[3,0]]:
two(x[4,[3,2,1]])       := x[4,[3,1,1,1]]:
two(x[4,[3,3]])         := x[4,[3,2,1]]:
two(x[4,[3,6,1]])       := x[4,[3,5,1,1]]:
two(x[5,[2,2,3,3]])     := x[5,[1,1,2,3,3]]:
two(x[5,[3,5,1,1]])     := x[5,[3,4,1,1,1]]:
two(x[5,[4,3,3]])       := x[5,[2,2,3,3]]:
two(x[6,[2,2,3,3]])     := x[6,[1,1,2,3,3]]:
two(x[6,[4,3,3]])       := x[6,[2,2,3,3]]:
two(x[6,[5,1,1]])       := x[6,[4,1,1,1]]:
two(x[6,[5,2,1]])       := x[6,[5,1,1,1]]:
two(x[6,[5,3,3]])       := x[6,[3,2,3,3]]:
two(x[6,[5,3]])         := x[6,[5,2,1]]:
two(x[7,[2,2,3,3]])     := x[7,[1,1,2,3,3]]:
two(x[7,[4,3,3]])       := x[7,[2,2,3,3]]:
two(x[7,[5,1,1,1]])     := x[7,[4,1,1,1,1]]:
two(x[7,[6,1]])         := x[7,[5,1,1]]:
two(x[8,[2,2,3,3]])     := x[8,[1,1,2,3,3]]:
two(x[8,[4,3,3]])       := x[8,[2,2,3,3]]:
two(x[8,[5,1,1,1]])     := x[8,[4,1,1,1,1]]:
two(x[8,[6,1]])         := x[8,[5,1,1]]:
two(x[8,[7]])           := x[8,[7,0]]:
two(x[8,[7,2,1]])       := x[8,[7,1,1,1]]:
two(x[8,[7,3]])         := x[8,[7,2,1]]:
two(x[9,[7,2,1]])       := x[9,[7,1,1,1]]:
two(x[9,[7,3]])         := x[9,[7,2,1]]:
two(x[10,[7,3]])        := x[10,[7,2,1]]:

for n in degrees_above(2) do
 o(x[n,[1]],x[n+1,[1]]) := x[n,[1,1]]:
 o(x[n,[1]],x[n+1,[1,1]]) := x[n,[1,1,1]]:
 o(x[n,[1,1]],x[n+2,[1]]) := x[n,[1,1,1]]:
 o(x[n,[1]],x[n+1,[2,3,3]]) := x[n,[1,2,3,3]]:
 o(x[n,[1]],x[n+1,[2,4,1,1,1]]) := x[n,[1,2,4,1,1,1]]:
od:

for n in degrees_above(4) do
 o(x[n,[3]],x[n+3,[3]]) := x[n,[3,3]]:
 o(x[n,[3]],x[n+3,[3,3]]) := x[n,[3,3,3]]:
 o(x[n,[3,3]],x[n+6,[3]]) := x[n,[3,3,3]]:
od:

# Predictable ternary+ composites
o(x[2,[1]],    x[3,[2,1]],   x[6,[1]],   x[7,[1]]) := x[2,[1,2,1,1,1]]:
o(x[3,[2,1]],  x[6,[1]],     x[7,[1]])             := x[3,[2,1,1,1]]:
o(x[4,[2,1]],  x[7,[1]],     x[8,[1]])             := x[4,[2,1,1,1]]:
o(x[4,[3]],    x[7,[1]],     x[8,[1]])             := x[4,[3,1,1]]:
o(x[4,[3]],    x[7,[6,1]],   x[14,[1]])            := x[4,[3,6,1,1]]:
o(x[4,[3]],    x[7,[3]],     x[10,[3]])            := x[4,[3,3,3]]:
o(x[5,[3]],    x[8,[1]],     x[9,[1]])             := x[5,[3,1,1]]:
o(x[7,[6,1]],  x[14,[1]],    x[15,[1]])            := x[7,[6,1,1,1]]:
o(x[8,[6,1]],  x[15,[1]],    x[16,[1]])            := x[8,[6,1,1,1]]:
o(x[8,[7]],    x[15,[1]],    x[16,[1]])            := x[8,[7,1,1]]:
o(x[9,[7]],    x[16,[1]],    x[17,[1]])            := x[9,[7,1,1]]:

# Predictable composites
o(x[2,[1]],    x[3,[1,2,3,3]])     := x[2,[1,1,2,3,3]]:
o(x[2,[1]],    x[3,[1,1,2,3,3]])   := x[2,[1,1,1,2,3,3]]:
o(x[2,[1]],    x[3,[1,2,4,1,1,1]]) := x[2,[1,1,2,4,1,1,1]]:
o(x[2,[1]],    x[3,[2,1]])         := x[2,[1,2,1]]:
o(x[2,[1]],    x[3,[2,1,1]])       := x[2,[1,2,1,1]]:
o(x[2,[1]],    x[3,[2,1,1,1]])     := x[2,[1,2,1,1,1]]:
o(x[2,[1]],    x[3,[1,1,1]])       := x[2,[1,1,1,1]]:
o(x[2,[1,1]],  x[4,[2,1]])         := 0:
o(x[2,[1,1]],  x[4,[1,1]])         := x[2,[1,1,1,1]]: #?
o(x[2,[1,1,1]],x[5,[1]])           := x[2,[1,1,1,1]]:
o(x[2,[1]],    x[3,[2,1]])         := x[2,[1,2,1]]:
o(x[2,[1,2,1]],x[6,1])             := x[2,[1,2,1,1]]:
o(x[3,[1]],    x[4,[2,1]])         := 0:
o(x[3,[1]],    x[4,[2,1,1]])       := 0:
o(x[3,[1]],    x[4,[2,4,1,1,1]])   := x[3,[1,2,4,1,1,1]]:
o(x[3,[2,1]],  x[6,[1]])           := x[3,[2,1,1]]:
o(x[3,[2,1]],  x[6,[1,1]])         := x[3,[2,1,1,1]]:
o(x[3,[2,1,1]],x[7,[1]])           := x[3,[2,1,1,1]]:
o(x[3,[2,1]],  x[6,[2,3,3]])       := x[3,[2,1,2,3,3]]:
o(x[3,[2,3,3]],x[11,[3]])          := x[3,[2,3,3,3]]:
o(x[4,[2,1]],  x[7,[1]])           := x[4,[2,1,1]]:
o(x[4,[2,1]],  x[7,[2,3,3]])       := x[4,[2,1,2,3,3]]:
o(x[4,[2,3,3]],x[12,[3]])          := x[4,[2,3,3,3]]:
o(x[4,[3]],    x[7,[1]])           := x[4,[3,1]]:
o(x[4,[3]],    x[7,[2,3,3]])       := x[4,[3,2,3,3]]:
o(x[4,[3]],    x[7,[3]])           := x[4,[3,3]]:
o(x[4,[3]],    x[7,[5,3]])         := x[4,[3,5,3]]:
o(x[4,[3]],    x[7,[6,1]])         := x[4,[3,6,1]]:
o(x[5,[3]],    x[8,[1]])           := x[5,[3,1]]:
o(x[5,[3]],    x[8,[2,3,3]])       := x[5,[3,2,3,3]]:
o(x[5,[3]],    x[8,[5,3]])         := x[5,[3,5,3]]:
o(x[6,[5,3]],  x[14,[3]])          := x[6,[5,3,3]]:
o(x[7,[5,3]],  x[15,[3]])          := x[7,[5,3,3]]:
o(x[7,[6,1]],  x[14,[1]])          := x[7,[6,1,1]]:
o(x[8,[5,3]],  x[16,[3]])          := x[8,[5,3,3]]:
o(x[8,[6,1]],  x[15,[1]])          := x[8,[6,1,1]]:
o(x[8,[7]],    x[15,[1]])          := x[8,[7,1]]:
o(x[8,[7]],    x[15,[3]])          := x[8,[7,3]]:
o(x[9,[5,3]],  x[17,[3]])          := x[9,[5,3,3]]:
o(x[9,[7]],    x[16,[1]])          := x[9,[7,1]]:
o(x[9,[7]],    x[16,[3]])          := x[9,[7,3]]:
o(x[10,[7]],   x[17,[3]])          := x[10,[7,3]]:
o(x[11,[7]],   x[18,[3]])          := x[11,[7,3]]:
o(x[2,[1,1]],  x[4,[1]])           := x[2,[1,1,1]]:
o(x[2,[1,1]],  x[4,[2,3,3]])       := x[2,[1,1,2,3,3]]:

o(x[2, [1, 1]], x[4, [2, 4, 1, 1, 1]]) := x[2, [1, 1, 2, 4, 1, 1, 1]]:
o(x[2, [1, 1]], x[4, [2, 1, 1]]) := 0:
o(x[2, [1, 2, 1, 1]], x[7, [1]]) := x[2, [1, 2, 1, 1, 1]]:

# Unpredictable composites
o(x[2,[1]],    x[3,[2,1]])   := x[2,[1,1,1,1]] + x[2,[1,2,1]]:
o(x[2,[1]],    x[3,[2,2,3,3]]) := x[2,[1,2,2,3,3]]+x[2,[1,1,1,2,3,3]]:
o(x[5,[3]],    x[8,[7]])     := x[5,[4,3,3]]:
o(x[6,[3]],    x[9,[7]])     := x[6,[4,3,3]]:
o(x[7,[3]],    x[10,[7]])    := x[7,[4,3,3]]:
o(x[8,[3]],    x[11,[7]])    := x[8,[4,3,3]]:

# Suspensions
E(x[2,[1,1,1,1]]) := 0:
E(x[2,[1,2,1]])   := 0:

# (************************************************************************)
# (* Suspensions                                                          *)

# TodaName(x[6,[5,0]])               := w[6]:
# TodaName(x[6,[5,1,1]])             := sigmasecond:
# TodaName(x[7,[6,1]])               := sigmaprime:
# TodaName(x[8,[6,1]])               := E(sigmaprime):
# TodaName(x[10,[9,0]])              := w[10]:

# TodaName(x[2,[1,1,1,2,3,3]])       := 2*o(x[2,[1]],x[3,[2,2,3,3]]):
# TodaName(x[2,[1,2,1]])             := 2*o(x[2,[1]],x[3,[2,1]]):
# TodaName(x[3,[1,1,1]])             := 2*x[3,[2,1]]:
# TodaName(x[3,[1,1,2,3,3]])         := 2*x[3,[2,2,3,3]]:
# TodaName(x[3,[1,1,2,4,1,1,1]])     := 2*x[3,[2,2,4,1,1,1]]:
# TodaName(x[4,[1,1,1]])             := 2*x[4,[2,1]]:
# TodaName(x[4,[1,1,2,3,3]])         := 2*x[4,[2,2,3,3]]:
# TodaName(x[4,[1,1,2,4,1,1,1]])     := 2*x[4,[2,2,4,1,1,1]]:
# TodaName(x[4,[3,2,1]])             := 2*o(x[4,[3]],x[7,[3]]):
# TodaName(x[4,[3,5,1,1]])           := 2*o(x[4,[3]],x[7,[6,1]]):
# TodaName(x[5,[2,2,3,3]])           := 2*o(x[5,[3]],x[8,[7]]):
# TodaName(x[6,[2,2,3,3]])           := 2*o(x[6,[3]],x[9,[7]]):
# TodaName(x[6,[3,2,3,3]])           := 2*o([6,[5,3]],x[14,[3]]):
# TodaName(x[6,[4,1,1,1]])           := 2*x[6,[5,1,1]]:
# TodaName(x[6,[5,2,1]])             := 2*[6,[5,3]]:
# TodaName(x[7,[2,2,3,3]])           := 2*o(x[7,[3]],x[10,[7]]):
# TodaName(x[7,[5,1,1]])             := 2*x[7,[6,1]]:
# TodaName(x[8,[2,2,3,3]])           := 2*o(x[8,[3]],x[11,[7]]):
# TodaName(x[8,[5,1,1]])             := 2*x[8,[6,1]]:
# TodaName(x[8,[7,2,1]])             := 2*o(x[8,[7]],x[15,[3]]):
# TodaName(x[9,[7,2,1]])             := 2*o(x[9,[7]],x[16,[3]]):
# TodaName(x[10,[7,2,1]])            := 2*o(x[10,[7]],x[17,[3]]):

# TodaName(x[4,[3,1,1,1]])           := 4*o(x[4,[3]],x[7,[3]]):
# TodaName(x[4,[3,4,1,1,1]])         := 4*o(x[4,[3]],x[7,[6,1]]):
# TodaName(x[5,[1,1,2,3,3]])         := 4*o(x[5,[3]],x[8,[7]]):
# TodaName(x[6,[1,1,2,3,3]])         := 4*o(x[6,[3]],x[9,[7]]):
# TodaName(x[6,[5,1,1,1]])           := 4*[6,[5,3]]:
# TodaName(x[7,[1,1,2,3,3]])         := 4*o(x[7,[3]],x[10,[7]]):
# TodaName(x[7,[4,1,1,1]])           := 4*x[7,[6,1]]:
# TodaName(x[8,[1,1,2,3,3]])         := 4*o(x[8,[3]],x[11,[7]]):
# TodaName(x[8,[4,1,1,1]])           := 4*x[8,[6,1]]:
# TodaName(x[8,[7,1,1,1]])           := 4*o(x[8,[7]],x[15,[3]]):
# TodaName(x[9,[7,1,1,1]])           := 4*o(x[9,[7]],x[16,[3]]):

# TodaName(x[2,[1,1,1,1]])           := - o(x[2,[1]],x[3,[2,1]]):
# TodaName(x[2,[1,2,2,3,3]])         := 3 * o(x[2,[1]],x[3,[2,2,3,3]]):
# TodaName(x[2,[1,2,2,4,1,1,1]])     := 3 * o(x[2,[1]],x[3,[2,2,4,1,1,1]]):

# TodaName(x[2,[1,1,2,3,3]])         := o(x[2,[1]],x[3,[1]],x[4,[2,3,3]]):
# TodaName(x[2,[1,1,2,4,1,1,1]])     := o(x[2,[1]],x[3,[1]],x[4,[2,4,1,1,1]]):
# TodaName(x[2,[1,2,1,1,1]])         := o(x[2,[1]],x[3,[2,1]],x[6,[1]],x[7,[1]]):
# TodaName(x[2,[1,2,1,1]])           := o(x[2,[1]],x[3,[2,1]],x[6,[1]]):
# TodaName(x[3,[2,1,1,1]])           := o(x[3,[2,1]],x[6,[1]],x[7,[1]]):
# TodaName(x[4,[2,1,1,1]])           := o(x[4,[2,1]],x[7,[1]],x[8,[1]]):
# TodaName(x[4,[3,1,1]])             := o(x[4,[3]],x[7,[1]],x[8,[1]]):
# TodaName(x[4,[3,6,1,1]])           := o(x[4,[3]],x[7,[6,1]],x[14,[1]]):
# TodaName(x[7,[6,1,1,1]])           := o(x[7,[6,1]],x[14,[1]],x[15,[1]]):
# TodaName(x[8,[6,1,1,1]])           := o(x[8,[6,1]],x[15,[1]],x[16,[1]]):
# TodaName(x[8,[7,1,1]])             := o(x[8,[7]],x[15,[1]],x[16,[1]]):
# TodaName(x[9,[7,1,1]])             := o(x[9,[7]],x[16,[1]],x[17,[1]]):
# TodaName(x[5,[3,1,1]])             := o(x[5,[3]],x[8,[1]],x[9,[1]]):


(*
 Copyright (C) 2017 M.A.L. Marques

 This Source Code Form is subject to the terms of the Mozilla Public
 License, v. 2.0. If a copy of the MPL was not distributed with this
 file, You can obtain one at http://mozilla.org/MPL/2.0/.
*)

op_a1 := 1.5214:
op_a2 := 0.5764:
op_b1 := 1.1284:
op_b2 := 0.3183:

op_beta := (rs, z, xs0, xs1) ->
  op_qab/b88_zab(1, op_f, rs, z, xs0, xs1):

f_op := (rs, z, xt, xs0, xs1) ->
  - (1 - z^2)*n_total(rs)/4.0
  * (op_a1*op_beta(rs, z, xs0, xs1) + op_a2)
  / (op_beta(rs, z, xs0, xs1)^4 + op_b1*op_beta(rs, z, xs0, xs1)^3 + op_b2*op_beta(rs, z, xs0, xs1)^2):

f := (rs, z, xt, xs0, xs1) ->
  f_op(rs, z, xt, xs0, xs1):


######################################################################

`is_element/tree_height_functions` := (A::set) -> (TT) -> proc(h)
 local P,U,V,a,u,is_minimal;
 global reason;

 if not(type(h,table)) then
  reason := [convert(procname,string),"h is not a table",h];
  return false;
 fi;

 if map(op,{indices(h)}) <> TT then
  reason := [convert(procname,string),"h is not indexed by TT",h,TT];
  return false;
 fi;

 for a in A do if h[{a}] <> 0 then
  reason := [convert(procname,string),"h({a}) <> 0",a,h[{a}]];
  return false;
 fi; od;

 for V in TT do
  u := h[V];
  if not (`is_element/RR`(u) and u >= 0 and u <= 1) then
   reason := [convert(procname,string),"h(V) is not in the unit interval",V,u];
   return false;
  fi;

  is_minimal := true;
  for U in TT do
   if U <> V and U minus V = {} then
    is_minimal := false;
    if h[U] > h[V] then return false; fi;
   fi;
  od;
  if is_minimal and h[V] <> 0 then
   reason := [convert(procname,string),"V is minimal in TT but h(V) <> 0",V,TT,h[V]];
   return false;
  fi;
 od;

 return true;
end;

######################################################################

`is_equal/tree_height_functions` := (A::set) -> (TT) -> proc(h1,h2)
 local T;
 global reason;

 for T in TT do
  if h1[T] <> h2[T] then
   reason := [convert(procname,string),"h1[T] <>  h2[T]",T,h1[T],h2[T]];
   return false;
  fi;
 od;

 return true;
end;

######################################################################

`is_leq/tree_height_functions` := NULL;

######################################################################

`random_element/tree_height_functions` := (A::set) -> (TT) -> proc(d::posint := 12)
 local e,TS,T,h,parent,children;

 TS := sort([op(TT)],(U,V) -> nops(U) > nops(V));
 h := table();

 parent := parent_map(A)(TT);
 children := children_map(A)(TT);

 for T in TS do
  if children[T] = {} then
   h[T] := 0;
  elif parent[T] = FAIL then
   h[T] := rand(0..d)()/d;
  else
   e := h[parent[T]] * d;
   h[T] := rand(0..e)()/d;
  fi;
 od;

 return eval(h);
end;

######################################################################

`list_elements/tree_height_functions` := NULL;
`count_elements/tree_height_functions` := NULL;

######################################################################

`is_singular/tree_height_functions` := (A::set) -> (TT) -> proc(h)
 local TS,n,i,j;

 TS := sort([op(TT)],(U,V) -> nops(U) < nops(V));
 n := nops(TS);
 for i from 1 to n do
  if h[TS[i]] = 1 then return true; fi;
  for j from i+1 to n do
   if TS[i] minus TS[j] = {} and h[TS[i]] = h[TS[j]] then
    return true;
   fi;
  od;
 od;

 return false;
end;

######################################################################

`extend/tree_height_functions` := (A::set) -> (TT) -> proc(h)
 local he,TS,P,T,U;

 he := table;
 TS := sort([op(TT)],(U,V) -> nops(U) < nops(V));

 P := `list_elements/nonempty_subsets`(A);
 for T in P do
  he[T] := 1;
  for U in TS do
   if T minus U = {} then
    he[T] := h[U];
    break;
   fi;
  od;
 od;

 return eval(he);
end;


# JACOBI
#
# A package for the computation of the Jacobi property for Poisson brackets
#

#
# See https://gdeq.org/Weakly_nonlocal_Poisson_brackets for further details
#
# Authors: M. Casati, P. Lorenzoni, D. Valeri, R. Vitolo (2021)
#
#  L i c e n s e
#
# JACOBI is a free software distributed under the terms of the GNU General
# Public License <http://www.gnu.org/copyleft/gpl.html> as published by
# the Free Software Foundation.
#
# In particular, JACOBI comes with ABSOLUTELY NO WARRANTY.
#
# Version history
#
# Version 1.0, 15 January 2021

print(`JACOBI 1.0 for Maple 2020`);
print(`Authors: M. Casati, P. Lorenzoni, D. Valeri, R. Vitolo`);
print(`Web site: https://gdeq.org/Weakly_nonlocal_Poisson_brackets`);

Schouten_bracket:= proc(P,Q,T,N,M)
  description "Calculate the Schouten bracket [P,Q]",
              "N: number of components of the operators P,Q;",
              "M: order of derivatives in P,Q",
	      "T: the three-vector T=[P,Q]";

  local P_xy,P_yx,P_xz,P_zx,P_zy,P_yz,Q_xy,Q_yx,Q_xz,Q_zx,Q_yz,Q_zy,
  i,j,k,l,r,s,t,T0,T1,T2,cfnl_xyxz,cfnl_zxzy,cfnl_yzyx,cfl_xyxz:
  global delta:

  print("Step 0: calculating Dubrovin-Zhang formula");

# Calculate the total derivatives of the operator P
  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to M do
        P[i,j,k]:=add(
	  add(
	    diff(P[i,j,k-1],u[q,x,s])*u[q,x,s+1],
	    s=0..M-1),
	  q=1..N)
	  + add(
	      diff(P[i,j,k-1],delta[x-y,s])*delta[x-y,s+1],
	    s=-1..M-1)
      end do
    end do
  end do:

#Generate the operators P in all variables needed in Dubrovin-Zhang formula
  P_xy:=P:
  P_yx:=subs({x=y,y=x},P_xy):
  P_xz:=subs(y=z,P_xy):
  P_zx:=subs(y=z,P_yx):
  P_yz:=subs(x=y,P_xz):
  P_zy:=subs(x=z,P_xy):

# Calculate the total derivatives of the operator Q
  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to M do
        Q[i,j,k]:=add(
	  add(
	    diff(Q[i,j,k-1],u[q,x,s])*u[q,x,s+1],
	    s=0..M-1),
	  q=1..N)
	  + add(
	      diff(Q[i,j,k-1],delta[x-y,s])*delta[x-y,s+1],
	    s=-1..M-1)
      end do
    end do
  end do:

#Generate the operators Q in all variables needed in Dubrovin-Zhang formula
  Q_xy:=Q:
  Q_yx:=subs({x=y,y=x},Q_xy):
  Q_xz:=subs(y=z,Q_xy):
  Q_zx:=subs(y=z,Q_yx):
  Q_yz:=subs(x=y,Q_xz):
  Q_zy:=subs(x=z,Q_xy):

# The three-vector T0 from Dubrovin-Zhang formula
T0:=Array(1..N,1..N,1..N):

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        T0[i,j,k]:=
	add(add(diff(P_xy[i,j,0],u[l,x,s])*Q_xz[l,k,s],s=0..M)
	+ subs(delta[x-y,-1]=-delta[y-x,-1],
	    add(diff(P_xy[i,j,0],u[l,y,s])*Q_yz[l,k,s],s=0..M))
	+ add(diff(P_zx[k,i,0],u[l,z,s])*Q_zy[l,j,s],s=0..M)
	+ subs(delta[z-x,-1]=-delta[x-z,-1],
	    add(diff(P_zx[k,i,0],u[l,x,s])*Q_xy[l,j,s],s=0..M))
	+ add(diff(P_yz[j,k,0],u[l,y,s])*Q_yx[l,i,s],s=0..M)
	+ subs(delta[y-z,-1]=-delta[z-y,-1],
	    add(diff(P_yz[j,k,0],u[l,z,s])*Q_zx[l,i,s],s=0..M))
	+ add(diff(Q_xy[i,j,0],u[l,x,s])*P_xz[l,k,s],s=0..M)
	+ subs(delta[x-y,-1]=-delta[y-x,-1],
	    add(diff(Q_xy[i,j,0],u[l,y,s])*P_yz[l,k,s],s=0..M))
	+ add(diff(Q_zx[k,i,0],u[l,z,s])*P_zy[l,j,s],s=0..M)
	+ subs(delta[z-x,-1]=-delta[x-z,-1],
	    add(diff(Q_zx[k,i,0],u[l,x,s])*P_xy[l,j,s],s=0..M))
	+ add(diff(Q_yz[j,k,0],u[l,y,s])*P_yx[l,i,s],s=0..M)
	+ subs(delta[y-z,-1]=-delta[z-y,-1],
	    add(diff(Q_yz[j,k,0],u[l,z,s])*P_zx[l,i,s],s=0..M))
	    ,l=1..N)
      end do
    end do
  end do:

# Here we calculate the step 1 of the algorithm
# enhanced by a first application of the step 3
# in order to reconstruct a new three-vector T1
# which is equivalent to T0 up to total derivatives.

print("Step 1 of the algorithm");

# Replacing nu(z-y)*delta(z-x)
  delta[z-y,-1,z-x,0]:=delta[x-y,-1]*delta[x-z,0]:
  for i from 1 to M-1 do
    delta[z-y,-1,z-x,i]:= - add(diff(delta[z-y,-1,z-x,i-1],
      delta[x-y,k])*delta[x-y,k+1],k=-1..M)
       - add(diff(delta[z-y,-1,z-x,i-1],
         delta[x-z,k])*delta[x-z,k+1],k=-1..M)
  end do:

# Replacing nu(y-x)*delta(y-z)
  delta[y-x,-1,y-z,0]:=delta[z-x,-1]*delta[z-y,0]:
  for i from 1 to M-1 do
    delta[y-x,-1,y-z,i]:= - add(diff(delta[y-x,-1,y-z,i-1],
      delta[z-x,k])*delta[z-x,k+1],k=-1..M)
       - add(diff(delta[y-x,-1,y-z,i-1],
         delta[z-y,k])*delta[z-y,k+1],k=-1..M)
  end do:

# Replacing nu(x-z)*delta(x-y)
  delta[x-z,-1,x-y,0]:=delta[y-z,-1]*delta[y-x,0]:
  for i from 1 to M-1 do
  delta[x-z,-1,x-y,i]:= - add(diff(delta[x-z,-1,x-y,i-1],
    delta[y-z,k])*delta[y-z,k+1],k=-1..M)
     - add(diff(delta[x-z,-1,x-y,i-1],
       delta[y-x,k])*delta[y-x,k+1],k=-1..M)
  end do:

# Replacing all products of delta's to products of the form
# delta^(m)(x-y)*delta^(n)(x-z)
  for l from 0 to M do
    delta[x-y,0,y-z,l]:=delta[x-y,0]*delta[x-z,l]
  end do:

  for k from 1 to M do
    for l from 0 to M do
      delta[x-y,k,y-z,l]:=add(diff(delta[x-y,k-1,y-z,l],delta[x-y,m])
        *delta[x-y,m+1],m=-1..M)
        +add(diff(delta[x-y,k-1,y-z,l],delta[x-z,m])*delta[x-z,m+1],m=-1..M)
    end do
  end do:

  for l from 0 to M do
    delta[z-x,0,z-y,l]:=delta[x-y,l]*delta[x-z,0]
  end do:

  for k from 1 to M do
    for l from 0 to M do
      delta[z-x,k,z-y,l]:=-add(diff(delta[z-x,k-1,z-y,l],delta[x-y,m])
        *delta[x-y,m+1],m=-1..M)
	 - add(diff(delta[z-x,k-1,z-y,l],delta[x-z,m])
        *delta[x-z,m+1],m=-1..M)
    end do
  end do:

  for k from 0 to M do
    for l from 0 to M do
      delta[z-x,k,x-y,l]:=(-1)^k*delta[x-y,l]*delta[x-z,k]
    end do
  end do:

  for k from 0 to M do
    delta[y-z,k,y-x,0]:=delta[x-y,0]*delta[x-z,k]
  end do:

  for l from 1 to M do
    for k from 0 to M do
      delta[y-z,k,y-x,l]:=-add(diff(delta[y-z,k,y-x,l-1],delta[x-y,m])
        *delta[x-y,m+1],m=-1..M)
	-add(diff(delta[y-z,k,y-x,l-1],delta[x-z,m])
	*delta[x-z,m+1],m=-1..M)
    end do
  end do:

  for k from 0 to M do
    delta[y-z,k,z-x,0]:=(-1)^k*delta[x-y,k]*delta[x-z,0]
  end do:

  for l from 1 to M do
    for k from 0 to M do
      delta[y-z,k,z-x,l]:=-add(diff(delta[y-z,k,z-x,l-1],delta[x-y,m])
        *delta[x-y,m+1],m=-1..M)
	-add(diff(delta[y-z,k,z-x,l-1],delta[x-z,m])
	*delta[x-z,m+1],m=-1..M)
    end do
  end do:

# The three-vector T1
T1:=Array(1..N,1..N,1..N):

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        T1[i,j,k]:=
	  coeff(coeff(T0[i,j,k],delta[x-y,-1]),delta[x-z,-1])
	  *delta[x-y,-1]*delta[x-z,-1]
	  + coeff(coeff(T0[i,j,k],delta[y-x,-1]),delta[y-z,-1])
	  *delta[y-x,-1]*delta[y-z,-1]
	  + coeff(coeff(T0[i,j,k],delta[z-x,-1]),delta[z-y,-1])
	  *delta[z-x,-1]*delta[z-y,-1]
	  + add(coeff(coeff(T0[i,j,k],delta[z-y,-1]),delta[z-x,m])
	  *delta[z-y,-1,z-x,m],m=0..M)
	  + add(coeff(coeff(T0[i,j,k],delta[x-y,-1]),delta[x-z,m])
	  *delta[x-y,-1]*delta[x-z,m],m=0..M)
	  + add(coeff(coeff(T0[i,j,k],delta[y-x,-1]),delta[y-z,m])
	  *delta[y-x,-1,y-z,m],m=0..M)
	  + add(coeff(coeff(T0[i,j,k],delta[z-x,-1]),delta[z-y,m])
	  *delta[z-x,-1]*delta[z-y,m],m=0..M)
	  + add(coeff(coeff(T0[i,j,k],delta[x-z,-1]),delta[x-y,m])
	  *delta[x-z,-1,x-y,m],m=0..M)
	  + add(coeff(coeff(T0[i,j,k],delta[y-z,-1]),delta[y-x,m])
	  *delta[y-z,-1]*delta[y-x,m],m=0..M)
	  + add(add(coeff(coeff(T0[i,j,k],delta[x-y,l]),delta[x-z,m])
	  *delta[x-y,l]*delta[x-z,m],l=0..M),m=0..M)
	  + add(add(coeff(coeff(T0[i,j,k],delta[x-y,l]),delta[y-z,m])
	  *delta[x-y,l,y-z,m],l=0..M),m=0..M)
	  + add(add(coeff(coeff(T0[i,j,k],delta[z-x,l]),delta[z-y,m])
	  *delta[z-x,l,z-y,m],l=0..M),m=0..M)
	  + add(add(coeff(coeff(T0[i,j,k],delta[z-x,l]),delta[x-y,m])
	  *delta[z-x,l,x-y,m],l=0..M),m=0..M)
	  + add(add(coeff(coeff(T0[i,j,k],delta[y-z,l]),delta[y-x,m])
	  *delta[y-z,l,y-x,m],l=0..M),m=0..M)
	  + add(add(coeff(coeff(T0[i,j,k],delta[y-z,l]),delta[z-x,m])
	  *delta[y-z,l,z-x,m],l=0..M),m=0..M)
      end do
    end do
  end do:

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        T1[i,j,k]:=coeff(coeff(T1[i,j,k],delta[x-y,-1]),delta[x-z,-1])
	*delta[x-y,-1]*delta[x-z,-1]
	+ coeff(coeff(T1[i,j,k],delta[y-x,-1]),delta[y-z,-1])
	*delta[y-x,-1]*delta[y-z,-1]
	+ coeff(coeff(T1[i,j,k],delta[z-x,-1]),delta[z-y,-1])
	*delta[z-x,-1]*delta[z-y,-1]
	+ add(coeff(coeff(T1[i,j,k],delta[z-y,-1]),delta[z-x,m])
	*delta[z-y,-1,z-x,m],m=0..M)
	+ add(coeff(coeff(T1[i,j,k],delta[x-y,-1]),delta[x-z,m])
	*delta[x-y,-1]*delta[x-z,m],m=0..M)
	+ add(coeff(coeff(T1[i,j,k],delta[y-x,-1]),delta[y-z,m])
	*delta[y-x,-1,y-z,m],m=0..M)
	+ add(coeff(coeff(T1[i,j,k],delta[z-x,-1]),delta[z-y,m])
	*delta[z-x,-1]*delta[z-y,m],m=0..M)
	+ add(coeff(coeff(T1[i,j,k],delta[x-z,-1]),delta[x-y,m])
	*delta[x-z,-1,x-y,m],m=0..M)
	+ add(coeff(coeff(T1[i,j,k],delta[y-z,-1]),delta[y-x,m])
	*delta[y-z,-1]*delta[y-x,m],m=0..M)
	+ add(add(coeff(coeff(T1[i,j,k],delta[x-y,l]),delta[x-z,m])
	*delta[x-y,l]*delta[x-z,m],l=0..M),m=0..M)
	+ add(add(coeff(coeff(T1[i,j,k],delta[x-y,l]),delta[y-z,m])
	*delta[x-y,l,y-z,m],l=0..M),m=0..M)
	+ add(add(coeff(coeff(T1[i,j,k],delta[z-x,l]),delta[z-y,m])
	*delta[z-x,l,z-y,m],l=0..M),m=0..M)
	+ add(add(coeff(coeff(T1[i,j,k],delta[z-x,l]),delta[x-y,m])
	*delta[z-x,l,x-y,m],l=0..M),m=0..M)
	+ add(add(coeff(coeff(T1[i,j,k],delta[y-z,l]),delta[y-x,m])
	*delta[y-z,l,y-x,m],l=0..M),m=0..M)
	+ add(add(coeff(coeff(T1[i,j,k],delta[y-z,l]),delta[z-x,m])
	*delta[y-z,l,z-x,m],l=0..M),m=0..M)
      end do
    end do
  end do:

# Here we calculate the step 2 of the algorithm

print("Step 2 of the algorithm");

# The three-vector T2
T2:=Array(1..N,1..N,1..N):

# Array for coefficients
cfnl_xyxz:=Array(1..N,1..N,1..N,0..M,0..M):
cfnl_zxzy:=Array(1..N,1..N,1..N,0..M,0..M):
cfnl_yzyx:=Array(1..N,1..N,1..N,0..M,0..M):
cfl_xyxz:=Array(1..N,1..N,1..N,0..M,0..M,0..M):

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        for r from 0 to M do
	  cfnl_xyxz[i,j,k,r,0]:=
	  coeff(coeff(T1[i,j,k],delta[x-y,-1]),delta[x-z,r])
	end do
      end do
    end do
  end do:

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        for r from 0 to M do
	  for s from 1 to M do
	    cfnl_xyxz[i,j,k,r,s]:=
	    add(add(diff(cfnl_xyxz[i,j,k,r,s-1],u[l,z,t])
	    *u[l,z,t+1],t=0..M),l=1..N)
	  end do
	end do
      end do
    end do
  end do:

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        for r from 0 to M do
	  cfnl_zxzy[i,j,k,r,0]:=
	  coeff(coeff(T1[i,j,k],delta[z-x,-1]),delta[z-y,r])
        end do
      end do
    end do
  end do:

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        for r from 0 to M do
	  for s from 1 to M do
	    cfnl_zxzy[i,j,k,r,s]:=
	    add(add(diff(cfnl_zxzy[i,j,k,r,s-1],u[l,y,t])
	    *u[l,y,t+1],t=0..M),l=1..N)
	  end do
	end do
      end do
    end do
  end do:

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        for r from 0 to M do
	  cfnl_yzyx[i,j,k,r,0]:=
	  coeff(coeff(T1[i,j,k],delta[y-z,-1]),delta[y-x,r])
	end do
      end do
    end do
  end do:

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        for r from 0 to M do
	  for s from 1 to M do
	    cfnl_yzyx[i,j,k,r,s]:=add(add(diff(cfnl_yzyx[i,j,k,r,s-1],u[l,x,t])
	    *u[l,x,t+1],t=0..M),l=1..N)
	  end do
	end do
      end do
    end do
  end do:

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        for r from 0 to M do
	  for s from 0 to M do
	    cfl_xyxz[i,j,k,r,s,0]:=
	    coeff(coeff(T1[i,j,k],delta[x-y,r]),delta[x-z,s])
	  end do
	end do
      end do
    end do
  end do:

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        for r from 0 to M do
	  for s from 0 to M do
	    for t from 1 to M do
	      cfl_xyxz[i,j,k,r,s,t]:=
	      add(add(diff(cfl_xyxz[i,j,k,r,s,t-1],u[l,y,p])
	      *u[l,y,p+1],p=0..M),l=1..N)
	    end do
	  end do
	end do
      end do
    end do
  end do:

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        T2[i,j,k]:=coeff(coeff(T1[i,j,k],delta[x-y,-1]),delta[x-z,-1])
	*delta[x-y,-1]*delta[x-z,-1]
	+ coeff(coeff(T1[i,j,k],delta[y-x,-1]),delta[y-z,-1])
	*delta[y-x,-1]*delta[y-z,-1]
	+ coeff(coeff(T1[i,j,k],delta[z-x,-1]),delta[z-y,-1])
	*delta[z-x,-1]*delta[z-y,-1]
	+ delta[x-y,-1]*add(add(binomial(m,s)*subs(z=x,cfnl_xyxz[i,j,k,m,s])
	*delta[x-z,m-s],s=0..m),m=0..M)
	+ delta[z-x,-1]*add(add(binomial(m,s)*subs(y=z,cfnl_zxzy[i,j,k,m,s])
	*delta[z-y,m-s],s=0..m),m=0..M)
	+ delta[y-z,-1]*add(add(binomial(m,s)*subs(x=y,cfnl_yzyx[i,j,k,m,s])
	*delta[y-x,m-s],s=0..m),m=0..M)
	+ add(add(add(binomial(l,s)*subs(y=x,cfl_xyxz[i,j,k,l,m,s])
	*delta[x-y,l-s],s=0..l)*delta[x-z,m],l=0..M),m=0..M)
      end do
    end do
  end do:

# Here we calculate the step 3 of the algorithm

# The three-vector T is set equal to the result
# of the third step of the algorithm

print("Step 3 of the algorithm");

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        for r from 0 to M do
	  for s from 0 to M do
	    cfl_xyxz[i,j,k,r,s,0]:=coeff(coeff(T2[i,j,k],delta[x-y,r]),
	    delta[x-z,s])
	  end do
	end do
      end do
    end do
  end do:

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        for r from 0 to M do
	  for s from 0 to M do
	    for t from 1 to M do
	      cfl_xyxz[i,j,k,r,s,t]:=
	      add(add(diff(cfl_xyxz[i,j,k,r,s,t-1],u[l,z,p])
	      *u[l,z,p+1],p=0..M),l=1..N)
	    end do
	  end do
	end do
      end do
    end do
  end do:

  for i from 1 to N do
    for j from 1 to N do
      for k from 1 to N do
        T[i,j,k]:=simplify(coeff(coeff(T2[i,j,k],delta[x-y,-1]),delta[x-z,-1])
	*delta[x-y,-1]*delta[x-z,-1]
	+ coeff(coeff(T2[i,j,k],delta[y-x,-1]),delta[y-z,-1])
	*delta[y-x,-1]*delta[y-z,-1]
	+ coeff(coeff(T2[i,j,k],delta[z-x,-1]),delta[z-y,-1])
	*delta[z-x,-1]*delta[z-y,-1]
	+ add(coeff(coeff(T2[i,j,k],delta[x-y,-1]),delta[x-z,m])
	*delta[x-y,-1]*delta[x-z,m],m=0..M)
	+ add(coeff(coeff(T2[i,j,k],delta[z-x,-1]),delta[z-y,m])
	*delta[z-x,-1]*delta[z-y,m],m=0..M)
	+ add(coeff(coeff(T2[i,j,k],delta[y-z,-1]),delta[y-x,m])
	*delta[y-z,-1]*delta[y-x,m],m=0..M)
	+ add(add(add(binomial(m,s)*subs(z=x,cfl_xyxz[i,j,k,l,m,s])
	*delta[x-z,m-s],s=0..m)*delta[x-y,l],m=0..M),l=0..M))
      end do
    end do
  end do:

end proc:


input := FileTools:-Text:-ReadFile("AoC-2021-20-input.txt"):
with(StringTools):

split:=Split(Trim(input), "\n"):
code := split[1]; length(code);

bin2dec := proc(s)
     if length(s) <> 9 then error "length of %1 is not 9, it is %2", s, length(s); end if;
     local l := Explode(s);
     add(ifelse(l[i]=".", 0, ifelse(l[i]="#", 1, X))*2^(9-i), i=1..9);
end proc:

bin2dec("...#...#.") = 34; code[34+1];

image := split[3..-1]: {Explode(Join(image,""))[]};

iwidth := length(image[1]);
ilength := nops(image);
ipad := 2;
p := code[bin2dec(cat(code[1]$9))+1];

image := [ cat(p$(iwidth+2*ipad))$ipad,
    seq(cat(p$ipad,image[i],p$ipad), i=1..iwidth),
    cat(p$(iwidth+2*ipad))$ipad
    ]:

{map(length, image)[]};

viewimage := proc(image)
  for local line in image do
     printf(cat(line,"\n"));
  end do;
end proc:

viewimage(image);
# walk the image
nimage := image:

for gen to 50 do
    nwidth := length(nimage[1]);
    nlength := nops(nimage);
    nbuf := StringBuffer():
    for i from 2 to nlength-1 do
        for j from 2 to nwidth-1 do
            nbhd := cat( seq(nimage[i+k][j-1..j+1], k=-1..1));
            pxidx := bin2dec(nbhd);
            nbuf:-append(code[pxidx+1]);
        end do;
    end do;
    tmp :=  nbuf:-value();
    nimage := [ seq(tmp[(i-1)*(nwidth-2)+1..i*(nwidth-2)], i=1..nlength-2) ];
    nwidth := length(nimage[1]);
    nlength := nops(nimage);
    ipad := 2;
    p := ifelse(gen mod 2 = 1, code[1], code[bin2dec(cat(code[1]$9))+1]);
    nimage := [ cat(p$(nwidth+2*ipad))$ipad, seq(cat(p$ipad,nimage[i],p$ipad), i=1..nwidth), cat(p$(nwidth+2*ipad))$ipad ]:
end do:

viewimage(nimage);

answer2 := add(CountCharacterOccurrences(nimage[i], "#"), i=1..nops(nimage));


# 4-Achsroboter von KUKA
# Voraussetzung:
# Viergelenkkette muss mit der Toolbox berechnet worden sein (Arbeitsblatt "vgk_kinematic_constraints.mw")
# Autor
# Weipu Shan
# Studienarbeit bei: Moritz Schappler, moritz.schappler@imes.uni-hannover.de, 2018-08
# (C) Institut fuer mechatronische Systeme, Leibniz Universitaet Hannover
# Quellen
# SA Bejaoui: Bejaoui2018_S749; "Modellierung kinematischer Zwangsbedingungen für hybride serielle Roboter mit planaren Parallelmechanismen"
# SA Shan: Shan2019_S828, "Reduktion der Modellkomplexität von seriell-hybriden Palettierrobotern"
#
#
# Initialisierung
# Import (Library)
interface(warnlevel=0): 		# Unterdrücke die folgende Warnung.
restart: 				# Gibt eine Warnung, wenn über Terminal-Maple mit read gestartet wird.
interface(warnlevel=3):
kin_constraints_exist := true: 		# Für Speicherung
;
with(StringTools): 			# Für Zeitausgabe
with(LinearAlgebra):
with(codegen):
with(CodeGeneration):
#with(ListTools):
codegen_act := true:
codegen_opt := 1: # Geringerer Optimierungsgrad. Sonst zu lange.
codegen_debug := 0: # Zur Code-Generierung auch für Nicht-Inert-Ausdrücke
;

# Import (hybriddyn)
read "../helper/proc_MatlabExport": 	# Exportiert einen Term als Matlab-Code in optimierter Form
read "../transformation/proc_rotx":  	# rotation um X
read "../transformation/proc_roty":  	# rotation um Y
read "../transformation/proc_rotz":  	# rotation um Z
;
read "../helper/proc_convert_s_t":   	# zeitabhängige Variable für Ableitung
read "../helper/proc_convert_t_s":   	# konstante Variable
read "../robot_codegen_constraints/proc_subs_kintmp_exp": #substitute für Spalte 1 mit Spalte 2
;
with(RealDomain): 			# Schränkt alle Funktionen auf den reellen Bereich ein. Muss nach Definition von MatlabExport kommen. Sonst geht dieses nicht.
;
read "../robot_codegen_definitions/robot_env":			#aktuelle Roboter, MDH-Tabelle
;
read sprintf("../codeexport/%s/tmp/tree_floatb_definitions",robot_name):	#von Fourbar
;

# Variable Initialisierung
# Variable mit Winkeln der Nebenstruktur nur in Abhängigkeit der verallgemeinerten Koordinaten
# Ergebnisse von Trigonometrischer Elimination lesen
read sprintf("../codeexport/palh3m1TE/tmp/kinematic_constraints_maple_inert.m"):	# von aktuellem Roboter
;
kin_constraints_exist := kin_constraints_exist:
kintmp_qs := kintmp_qs:
kintmp_qt := kintmp_qt:
kintmp_subsexp := kintmp_subsexp:
# Variable entfernen
kintmp_subsexp:= Matrix(2*RowDimension(kintmp_s),2):
# Export
kintmp_qt := convert_s_t(kintmp_qs):
save kintmp_subsexp, sprintf("../codeexport/%s/tmp/kinematic_constraints_kintmp_subsexp_maple", robot_name):
save kintmp_subsexp, sprintf("../codeexport/%s/tmp/kinematic_constraints_kintmp_subsexp_maple.m", robot_name):
#printf("Ausdrücke für kintmp_subsexp gespeichert (Maple). %s. CPU-Zeit bis hier: %1.2fs.\n", FormatTime("%Y-%m-%d %H:%M:%S"), time()-st):
for i from 1 to RowDimension(kintmp_s) do
  tmp := kintmp_qs(i):
  save tmp, sprintf("../codeexport/%s/tmp/kinematic_constraints_maple_inert_kintmpq_%d",robot_name, i):
  save tmp, sprintf("../codeexport/%s/tmp/kinematic_constraints_maple_inert_kintmpq_%d.m", robot_name, i):
end do:
save kin_constraints_exist, kintmp_qs, kintmp_qt,kintmp_subsexp, sprintf("../codeexport/%s/tmp/kinematic_constraints_maple_inert" ,robot_name):
save kin_constraints_exist, kintmp_qs, kintmp_qt, kintmp_subsexp, sprintf("../codeexport/%s/tmp/kinematic_constraints_maple_inert.m", robot_name):
save kintmp_qs, sprintf("../codeexport/%s/tmp/kinematic_constraints_kintmp_qs_maple_inert", robot_name):
#printf("Ausdrücke mit Inert-Arctan exportiert (Matlab). %s. CPU-Zeit bis hier: %1.2fs.\n", FormatTime("%Y-%m-%d %H:%M:%S"), time()-st):
# Liste mit abhängigen konstanten Kinematikparametern erstellen (wichtig für Matlab-Funktionsgenerierung)
read "../helper/proc_list_constant_expressions";
kc_symbols := Matrix(list_constant_expressions( kintmp_qs ));
#kc_symbols :=Transpose(kc_symbols);
save kc_symbols, sprintf("../codeexport/%s/tmp/kinematic_constraints_symbols_list_maple", robot_name):
MatlabExport(kc_symbols, sprintf("../codeexport/%s/tmp/kinematic_constraints_symbols_list_matlab.m",robot_name),2);

#printf("Fertig. %s. CPU-Zeit bis hier: %1.2fs.\n", FormatTime("%Y-%m-%d %H:%M:%S"), time()-st):
kintmp_qs(1,1):
kc_symbols(1,1):
kintmp_qs(2,1):


#@ Not autoload

with(LinearAlgebra):

p := 2;
chromatic_n_max := 4;  # NB degree(v[4]) = 30, degree(v[5]) = 62
chromatic_s_max := 20;

unprotect('v','m','t');
unassign('v','m','t');

v[0] := p;
m[0] := 1;
t[0] := 1;

protect('v','m','t');

# On BP_* we use a lexicographic ordering with v[1] >> v[2] >> v[3] >> ... >> 1.
# This seems to be the best order except that we really want to treat v[0]
# as a variable with v[0] >> v[1], so any monomial multiplied by p comes
# after all the bare monomials.  Then the terms p^t * monomial in any
# given degree have order type omega, and the terms after any given term
# span an invariant ideal.

BP_vars   := plex(seq(v[i],i=1..chromatic_n_max));

# On the other hand, it might be better to use some kind of order that treats
# the powers v[n]^(p^m) in a special way.  This might import more information
# from the chromatic spectral sequence into the ordering.  One option would be
# like
# .. v[1]^(p^2) >> v[2]^(p^2) >> .. >> v[1]^p >> v[2]^p >> .. v[1] >> v[2] >> ...

# On BP_*BP we use a lexicographic ordering with
# v[1] >> v[2] >> .... >> t[1] >> t[2] >> ... >> 1
# This privileges the ideal J = (t[1],...,t[k]); note that BP_*BP/J is
# the Hopf algebroid whose Ext calculates \pi_*(T(k)).

# Again, it might be better to use some kind of order that treats
# the powers t[n]^(p^m) in a special way.  This might import more information
# from the May spectral sequence into the ordering.

BPBP_vars := plex(seq(v[i],i=1..chromatic_n_max),seq(t[i],i=1..chromatic_n_max));

# The cobar complex involves variables t[n,s] corresponding to the copy of
# t[n] in the s'th tensor factor.  We use the ordering with
# v[1] >> v[2] >> ... >> t[1,1] >> t[2,1] >> ... >> t[1,2] >> t[2,2] >> ...
# so the variables from each tensor factor dominate those from the next tensor
# factor.  It is not clear whether this is the best choice.
BP_cobar_vars :=
 plex(op(BPBP_vars),seq(seq(t[i,j],i=1..chromatic_n_max),j=1..chromatic_s_max));

BP_cmp   := (a,b) -> TestOrder(a,b,BP_vars):
BPBP_cmp := (a,b) -> TestOrder(a,b,BPBP_vars):
BP_cobar_cmp := (a,b) -> TestOrder(a,b,BP_cobar_vars):

BP_degree := (u) -> degree(subs(BP_degree_rule,u),e);

# Basis for Z[v[i] : i >= n] in degree d
BP_basis := proc(d::integer,n::posint := 1)
 option remember;
 local m,r,i;
 m := 2*p^n-2;
 r := floor(d/m);
 if d < 0 or modp(d,2*p-2) <> 0 then
  return [];
 elif d = 0 then
  return [1];
 elif r = 0 then
  return [];
 else
  map(op,[seq(v[n]^i *~ BP_basis(d-m*i,n+1),i=0..r)]);
 fi;
end:

# Basis for Z[m[i] : i >= n] in degree d
HBP_basis := proc(d::integer,n::posint := 1)
 eval(subs(v = m,BP_basis(d,n)));
end:

# Basis for Z[t[i] : i >= n] in degree d
T_basis := proc(d::integer,n::posint := 1)
 eval(subs(v = t,BP_basis(d,n)));
end:

# Basis for Z[v[i] : i >= n] in degree <= d
BP_lower_basis := proc(d::integer,n::posint := 1)
 option remember;
 local m,r,i;
 m := 2*p^n-2;
 r := floor(d/m);
 if d < 0 or modp(d,2*p-2) <> 0 then
  return [];
 elif r = 0 then
  return [1];
 else
  map(op,[seq(v[n]^i *~ BP_lower_basis(d-m*i,n+1),i=0..r)]);
 fi;
end:

# Basis for Z[m[i] : i >= n] in degree d
HBP_lower_basis := proc(d::integer,n::posint := 1)
 eval(subs(v = m,BP_lower_basis(d,n)));
end:

# Basis for Z[t[i] : i >= n] in degree d
T_lower_basis := proc(d::integer,n::posint := 1)
 eval(subs(v = t,BP_lower_basis(d,n)));
end:

# Basis for BP_*BP in degree d
BPBP_basis := proc(d::integer)
 local B,m,u,v;
 B := NULL;
 for u in BP_lower_basis(d) do
  m := d - BP_degree(u);
  for v in T_basis(m) do
   B := B,(u*v);
  od;
 od;
 return [B];
end:

# Basis for the s-fold tensor power of Z[t_1,t_2,...] in degree d
# The copy of t[i] in the j'th tensor factor is represented by t[i,j]
T_power_basis := proc(s::nonnegint,d::integer)
 local B,m,R1,R2,u,v;
 if s = 0 then return `if`(d = 0,[1],[]); fi;

 R1 := {seq(t[n] = t[n,1],n=1..chromatic_n_max)};
 R2 := {seq(seq(t[n,i] = t[n,i+1],i=1..s-1),n=1..chromatic_n_max)};
 B := NULL;

 for u in subs(R1,T_lower_basis(d)) do
  m := d - BP_degree(u);
  for v in subs(R2,T_power_basis(s-1,m)) do
   B := B,(u*v);
  od;
 od;
 return [B];
end:

# Basis for the s-fold tensor power of the augmentation ideal in
# Z[t_1,t_2,...] in degree d
T_reduced_power_basis := proc(s::nonnegint,d::integer)
 local B,m,R1,R2,u,v;
 if s = 0 then return `if`(d = 0,[1],[]); fi;

 R1 := {seq(t[n] = t[n,1],n=1..chromatic_n_max)};
 R2 := {seq(seq(t[n,i] = t[n,i+1],i=1..s-1),n=1..chromatic_n_max)};
 B := NULL;

 for u in subs(R1,T_lower_basis(d)) do
  if u <> 1 then
   m := d - BP_degree(u);
   for v in subs(R2,T_reduced_power_basis(s-1,m)) do
    B := B,(u*v);
   od;
  fi;
 od;
 return [B];
end:

BP_cobar_basis := (s,d) ->
 [seq(seq(seq(a*b,a in BP_basis(i)),b in T_reduced_power_basis(s,d-i)),i=0..d)];

# Hazewinkel generators in terms of log coefficients
vm := proc(n::nonnegint)
 option remember;
 if n = 0 then
  return p;
 else
  return expand(p*m[n] - add(m[k]*vm(n-k)^(p^k),k=1..n-1));
 fi;
end:

# Log coefficients in terms of Hazewinkel generators
# This is inefficient; should use Ravenel's formulae instead
mv := proc(n::nonnegint)
 local err;
 option remember;

 if n = 0 then return 1; fi;

 err := vm(n) - v[n];
 err := expand(subs({seq(m[i] = mv(i),i=1..n-1)},err));

 return rhs(solve(err=0,{m[n]})[1]);
end:

# Right unit map on the log coefficients
eta_m := (k) -> add(m[i] * t[k-i]^(p^i),i=0..k);

# Right unit map on the Hazewinkel generators
eta_v := proc(k::posint,s::nonnegint)
 option remember;
 local u,R;

 if nargs = 1 then
  u := expand(subs({seq(m[i] = eta_m(i),i=1..k)},vm(k)));
  u := expand(subs({seq(m[i] = mv(i),i=1..k)},u));
  return u;
 else
  if s = 0 then
   return v[k];
  elif s = 1 then
   u := expand(subs({seq(m[i] = eta_m(i),i=1..k)},vm(k)));
   u := expand(subs({seq(m[i] = mv(i),i=1..k)},u));
   u := subs({seq(t[i] = t[i,1],i=1..chromatic_n_max)},u);
   return u;
  else
   u := eta_v(k,s-1);
   R := { seq(seq(t[i,j] = t[i,j+1],i=1..chromatic_n_max),j=1..s-1),
          seq(v[i] = eta_v(i,1),i=1..chromatic_n_max) };
   u := subs(R,u);
   return u;
  fi;
 fi;
end:

# Hopf algebroid coproduct on the generators t[n]
psi_t := proc(n)
 local a,b;
 option remember;
 if n = 0 then return 1; fi;

 a := add(add(mv(i)*t[j,1]^(p^i)*t[n-i-j,2]^(p^(i+j)),j=0..n-i),i=0..n);
 b := add(mv(i)*psi_t(n-i)^(p^i),i=1..n);
 a := subs({t[0,1]=1,t[0,2]=1},a);
 b := subs({t[0,1]=1,t[0,2]=1},b);
 return expand(a - b);
end:

d_BP_cobar_rule := proc(s,i)
 local R0,R1,R2,R3;
 if i = 0 then
  R0 := {seq(t[j]=t[j,1],j=1..chromatic_n_max)};
  R1 := {seq(t[j]=t[j,2],j=1..chromatic_n_max)};
  R2 := {seq(seq(t[j,k]=t[j,k+1],k=1..s),j=1..chromatic_n_max)};
  return
   {seq(v[j] = expand(subs(R0,eta_v(j))),j=1..chromatic_n_max),op(R1),op(R2)};
 else
  R0 := {seq(t[j,1]=t[j,i],j=1..chromatic_n_max),
         seq(t[j,2]=t[j,i+1],j=1..chromatic_n_max),
	 seq(v[j] = eta_v(j,i-1),j=1..chromatic_n_max)};
  R1 := {seq(seq(t[j,k]=t[j,k+1],k=i+1..s),j=1..chromatic_n_max)};
  R2 := {seq(t[j,i] = subs(R0,psi_t(j)),j=1..chromatic_n_max)};
  if i = 1 then
   R3 := {seq(t[j] = expand(subs(R0,psi_t(j))),j=1..chromatic_n_max)};
  else
   R3 := {seq(t[j] = t[j,1],j=1..chromatic_n_max)};
  fi;
  return {op(R1),op(R2),op(R3)};
 fi;
end:

d_BP_cobar := (s) -> (u) ->
 expand(add((-1)^i * subs(d_BP_cobar_rule(s,i),u),i=0..s+1));

d_BP_cobar_matrix := proc(s,d)
 local B1,B2,cf;
 B1 := BP_cobar_basis(s,d);
 B2 := BP_cobar_basis(s+1,d);
 cf := proc(u)
  local sol;
  sol := solve({coeffs(u - add(c[i]*B2[i],i=1..nops(B2)),indets(B2))});
  subs(sol,[seq(c[i],i=1..nops(B2))]);
 end;
 Transpose(Matrix(map(cf,map(d_BP_cobar(s),B1))));
end:

BP_cobar_cycles := proc(s,d)
 local M;
 M := d_BP_cobar_matrix(s,d);
 map(u -> Transpose(Vector(BP_cobar_basis(s,d))) . u,NullSpace(M));
end:

mu_BP_cobar := (s1,s2) -> proc(a,b)
 local i,b0;
 b0 := b;
 for i from 0 to s1-1 do
  b0 := expand(subs(d_BP_cobar_rule(s2+i,0),b0));
 od:
 return expand(a * b0);
end:

analyse_BP := proc(p_,n_)
 global p,chromatic_n_max;

 if nargs > 0 then p := p_; fi;
 if nargs > 1 then chromatic_n_max := n_; fi;

 vm(chromatic_n_max);
 mv(chromatic_n_max);
 eta_v(chromatic_n_max);
 psi_t(chromatic_n_max);
 NULL;
end:

analyse_BP_cobar := proc(s::nonnegint,d::integer)
 local i,R,R0,B1,B2,n1,n2,M,L0,P0,x,x1,L,P,Q,nx,LB2,y,HB,HE,T,U,L1,K,Ki;
 global BP_cobar_data;

 if d + s >= 2*(p^(chromatic_n_max + 1) - 1) then
  error("chromatic_n_max is too small");
 fi;

 if s > chromatic_s_max then
  error("chromatic_s_max is too small");
 fi;

 R := table():

 if s = 0 then
  if d = 0 then
   R["chain_basis"]     := [1];
   R["chain_rank"]      := 1;
   R["cycle_basis"]     := [1];
   R["cycle_rank"]      := 1;
   R["boundary_basis"]  := [];
   R["boundary_rank"]   := 0;
   R["pivot_data"]      := [[1,infinity]];
   R["non_cycle_basis"] := [];
   R["homology_basis"]  := [1];
   R["homology_exponents"] := [infinity];
  else
   R["chain_basis"]     := BP_cobar_basis(0,d);
   R["chain_rank"]      := nops(R["chain_basis"]);
   R["cycle_basis"]     := [];
   R["cycle_rank"]      := 0;
   R["boundary_basis"]  := [];
   R["boundary_rank"]   := 0;
   R["pivot_data"]      := [];
   R["non_cycle_basis"] := R["chain_basis"];
   R["homology_basis"]  := [];
   R["homology_exponents"] := [];
  fi;

  BP_cobar_data[s,d] := eval(R);
  return eval(R);
 fi;

 if type(BP_cobar_data[s-1,d+1],table) then
  R0 := BP_cobar_data[s-1,d+1];
  B1 := R0["non_cycle_basis"];
 else
  B1 := BP_cobar_basis(s-1,s+d):
 fi;

 B2 := BP_cobar_basis(s,s+d):
 n1 := nops(B1);
 n2 := nops(B2);
 R["chain_basis"] := B2;
 R["chain_rank"]  := n2;

 if n2 = 0 then
  R["cycle_basis"]     := [];
  R["cycle_rank"]      := 0;
  R["boundary_basis"]  := [];
  R["boundary_rank"]   := 0;
  R["pivot_data"]      := [];
  R["non_cycle_basis"] := [];
  R["homology_basis"]  := [];
  R["homology_exponents"] := [];
  BP_cobar_data[s,d] := eval(R);
  return eval(R);
 fi;

 M := Transpose(Matrix(map(coeff_list,map(d_BP_cobar(s-1),B1),B2)));
 L0,P0,x := op(Zpl_reduce(Transpose(M),p)):
 L := Transpose(L0):
 P := Transpose(P0):
 nx := nops(x):
 R["cycle_rank"] := nx;

 LB2 := convert(L0.Vector(B2),list):
 R["boundary_basis"] := [seq(LB2[i],i=1..nx)];
 R["cycle_basis"]    := [seq(LB2[i]/p^x[i][2],i=1..nx)];
 R["pivot_data"]     := x;

 y := sort([op({seq(i,i=1..n2)} minus {seq(x[i][1],i=1..nx)})]);
 R["non_cycle_basis"] := [seq(B2[i],i in y)];

 HB := [];
 HE := [];

 for i from 1 to nx do
  if x[i][2] > 0 then
   HB := [op(HB),R["cycle_basis"][i]];
   HE := [op(HE),p^x[i][2]];
  fi;
 od;

 R["homology_basis"] := HB;
 R["homology_exponents"] := HE;

 T := <IdentityMatrix(nx)|Matrix(nx,n1-nx)>;
 U := Matrix(nx,n2):
 for i from 1 to nx do U[i,x[i][1]] := 1; od:
 L1 := U.L.Transpose(T);
 Q := P.Transpose(T).(1/L1).U;
 K := <SubMatrix(L,1..n2,1..nx)|Matrix(n2,n2-nx)>;
 y := sort([op({seq(i,i=1..n2)} minus {seq(x[i][1],i=1..nx)})]);
 for i from 1 to n2 - nx do
  K[y[i],nx+i] := 1;
 od:
 Ki := 1/K;

 BP_cobar_data[s,d] := eval(R);
 return eval(R);
end:

BP_set_p := proc(p_)
 global p,v,BP_degree_rule,BP_basis,BP_lower_basis,vm,mv,eta_v,psi_t;

 p := p_;
 unprotect('v');
 v[0] := p;
 protect('v');

 BP_degree_rule := {
  seq(v[n] = e^(2*(p^n-1)) * v[n],n=1..chromatic_n_max),
  seq(t[n] = e^(2*(p^n-1)) * t[n],n=1..chromatic_n_max),
  seq(seq(t[n,i] = e^(2*(p^n-1)) * t[n,i],n=1..chromatic_n_max),i=1..chromatic_s_max)
 }:

 forget(BP_basis);
 forget(BP_lower_basis);
 forget(vm);
 forget(mv);
 forget(eta_v);
 forget(psi_t);
 NULL;
end:

save_BP_data := proc()
 local file;
 file := sprintf("%s/BP_%d.m",data_dir,p);
 save(p,chromatic_n_max,chromatic_s_max,vm,mv,eta_v,psi_t,BP_basis,BP_lower_basis,file);
end:

load_BP_data := proc(p)
 local file;
 file := sprintf("%s/BP_%d.m",data_dir,p);
 load(file);
end:

save_BP_cobar_data := proc()
 local file;
 file := sprintf("%s/BP_cobar_data_%d.m",data_dir,p);
 save(BP_cobar_data,file);
end:

load_BP_cobar_data := proc(p)
 local file;
 file := sprintf("%s/BP_cobar_data_%d.m",data_dir,p);
 load(file);
end:


IRATH:=module()
    option  package;
    export  findTanhSolutions;
    local   nomalizeEqn,
            getODE,
            simplifyEqn,
            findDiffOrder,
            findElemOrder,
            findItemOrder,
            findOrders,
            findInflexion,
            solveAllOrder,
            solveForOrder,
            selectSolutions,
            printSolutions,
            solveForPS,
            transSolution,
            subsIeq,
            subsSol,
            checkSolution,
            isEquationOf;

    (*
     * 求解函数
     *)
    findTanhSolutions:=proc(eqi)
        local eq,ms,params,oeq,st;
        st:=time();

        printf("输入的方程为");
        eq:=nomalizeEqn(eqi);
        oeq:=eq;
        print(eq);

        # printf("方程中的参数为");
        params:=indets(eq,name) minus {t,x};
        # print(params);

        # printf("行波变换后的方程为");
        eq:=getODE(eq);
        # print(eq);

        # printf("方程各项阶数为");
        ms:=findOrders(eq);
        # print(ms);

        # printf("拐点为");
        ms:=findInflexion(ms);
        # print(ms);

        if evalb(ms={0}) then
            printf("无解\n");
            printf("时间已过 %f 秒\n",time()-st);
            return;
        end if;

        # printf("开始求解\n");
        solveAllOrder(eq,ms,params,oeq);

        printf("时间已过 %f 秒\n",time()-st);
    end proc:

    (*
     * 标准化方程
     * 方程变量是u(x,t)
    *)
    nomalizeEqn:=proc(ee)
        local e;
        e:=expand(numer(ee));
        return e;
    end proc:

    (*
     * 进行行波变换，将偏微分方程转化为常微分方程
     * 要求函数为u(x,t),替换为u(xi),
     * xi=k*(x-ct)
    *)
    getODE:=proc(eqi)
        local eq;
        eq:=subs(u(x,t)=u(x,t,xi),eqi);
        eq:=PDETools[dsubs](diff(u(x,t,xi),t)=-c*k*diff(u(x,t,xi),xi),
        diff(u(x,t,xi),x)=k*diff(u(x,t,xi),xi),
        eq);
        eq:=eval(subs(u(x,t,xi)=u(xi),eq));
        return simplifyEqn(eq);
    end proc:

    (*
     * 化简方程
    *)
    simplifyEqn:=proc(ee)
        local e,v,p;
        e:=numer(ee);
        e:=factor(e);
        if type(e,`*`) then
            p:=1;
            for v in e do
                if type(v,`+`) then
                    p:=p*v;
                 elif type(v,`^`) and type(expand(op(1,v)),`+`) then
                    p:=p*(simplifyEqn(op(1,v))^op(2,v));
                end if;
            end do;
            p:=expand(p);
        else
            p:=expand(e);
        end if;
        return p;
    end proc:

    (*
     * 计算导数项阶数
    *)
    findDiffOrder:=proc(ee)
        local e;
        e:=convert(ee,'D');
        e:=op(0,op(0,e));
        if evalb(op(0,e)=`@@`) then
            op(2,e);
        else
            1;
        end if;
    end proc:

    (*
     * 计算元素的阶数
    *)
    findElemOrder:=proc(ee)
        local e;
        if evalb(op(0,ee)='u') then
            e:=[1,0];
        elif evalb(op(0,ee)='diff') then
            e:=[1,findDiffOrder(ee)];
        elif type(ee,`^`) then
            e:=findElemOrder(op(1,ee))*op(2,ee);
        else
            e:=[0,0];
        end if;
        return e;
    end proc:

    (*
     * 计算方程某一项的阶数
    *)
    findItemOrder:=proc(ee)
        local e,p;
        if type(ee,`*`) then
            p:=[0,0];
            for e in ee do
                p:=p+findElemOrder(e);
            end do;
        else
            p:=findElemOrder(ee);
        end if;
        return p;
    end proc:

    (*
     * 计算方程每一项的阶数
     * 假设至少有两项
     * 假设指数上不含参数
    *)
    findOrders:=proc(ee)
        findItemOrder~([op(ee)]);
    end proc:

    (*
     * 计算拐点
    *)
    findInflexion:=proc(mss::list(list(integer)))
        local ms,i,j,n,mm,m,fun;
        fun:=(x,m)->x[1]*m+x[2];
        mm:={};
        ms:={op(mss)};
        n:=numelems(ms);
        for i from 1 to n-1 do
            for j from i+1 to n do
                if evalb(ms[i][1]<>ms[j][1]) then
                    m:=-(ms[i][2]-ms[j][2])/(ms[i][1]-ms[j][1]);
                    if evalb(fun(ms[i],m)=max(map(fun,ms,m))) then
                        mm:=mm union {m};
                    end if;
                end if;
            end do;
        end do;
        return mm;
    end proc:

    (*
     * 对所有阶数进行求解
    *)
    solveAllOrder:=proc(eqi,mms::set(rational),params::set(name),oeq)
        local trans,tr,eq,ms,m;
        # 计算全部变换
        trans:=map(x->sign(x)/denom(x),mms);
        for tr in trans do
            eq:=eval(subs(u(xi)=u(xi)^tr,eqi));
            eq:=simplifyEqn(eq);
            ms:=findOrders(eq);
            m:=select(type,findInflexion(ms),posint);
            m:=max(m);
            printf("m=%a,方程为:",tr*m);
            print(eq);
            if not type(ms,list(list(integer))) then
                printf("方程不是多项式，无解\n");
                next;
            end if;
            solveForOrder(eq,m,params,tr,oeq);
        end do;
    end proc:

    (*
     * 对特定阶数进行求解
    *)
    solveForOrder:=proc(eqi,m::posint,params::set(name),tr::rational,oeq)
        local eq,f,PS,vars,sols;
        f:=add(seq(a[i]*tanh(xi)^i,i=0..m));
        vars:=[seq(a[i],i=0..m)];
        eq:=eval(subs(u(xi)=f,eqi));
        eq:=subs(tanh(xi)=T,eq);
        eq:=collect(eq,T);
        PS:=PolynomialTools[CoefficientList](eq,T,termorder=reverse);
        sols:=solveForPS(PS,m,params,vars);
        printSolutions(sols,m,tr);
    end proc:

    (*
     * 筛选解
     * 删去k,c=0的解
     * 删除参数为0的解
     * 删除a[1]..a[m]都为0的解
    *)
    selectSolutions:=proc(solss::{set,list},
                         params::set(name),m::posint)
        local zs,ps,sols,as;
        as:={seq(a[i],i=1..m)};
        sols:=convert(solss,set);
        sols:=select(type,sols,equation);
        ps:=params union {k,c};
        zs:=lhs~(select(_x->type(_x,`=`(name,0)),sols));
        if evalb( (zs intersect ps) <> {} ) then
            return false;
        else
            return not evalb(as subset zs);
        end if;
    end proc:

    (*
     * 输出解
    *)
    printSolutions:=proc(sols::set({list,set}),
                        m::posint,tr::rational)
        local sol;
        if evalb(sols={}) then
            printf("无解\n");
            return;
        end if;
        printf("共有%d个解",numelems(sols));
        print(u(xi)=add(seq(a[i]*tanh(xi)^i,i=0..m))^tr,xi=k*(x-ct)+xi[0]);
        printf("其中");
        for sol in sols do
            print(expand(simplify(sol)));
        end do;
    end proc:

    (*
     * 求解PS
     * 基于csolve的版本
     * 只有剩余方程不能用csolve求解时，才使用solve求解
    *)
    solveForPS:=proc(PS,m::posint,params::set(name),vars::list(name))
        local pa,pp,sola,sol,vs,res,np,nsol,ssol,nres,sssol;
        res:={};# 所有解
        pa:=PS[1..(m+1)];
        pp:=PS[(m+1)..-1];
        sola:=[csolve(pa,{vars[],k,c})];# 求解前m+1个方程
        sola:=select(selectSolutions,sola,params,m);# 除去平凡的解
        for sol in sola do
            # 代入化简
            np:=simplify(subs(op(sol),pp));
            np:=simplifyEqn~(np);# 化简方程，去除非零项
            np:=remove(type,np,0);

            # 如果剩余的方程全0，则不需要继续求解
            if evalb(np=[]) then
                res:=res union {sol};
                next;
            end if;

            # 求解剩余方程
            try
                nsol:=[csolve(np,indets(np,name))];
            catch:
                nsol:=[RealDomain[solve](np,indets(np,name))];
            end try;

            nsol:=select(selectSolutions,nsol,params,m);

            for ssol in nsol do
                # 合并解，因为前面的解，在后面已经被带入
                # 所以，后面的解不会包含前面已有的符号
                # 因此，直接合并即可
                try # 有可能出现分母为0的情况
                    sssol:=simplify(subs(op(ssol),sol));
                    res:=res union {sssol union ssol};
                catch:
                    next;
                end try;
            end do;
        end do;

        res:=select(selectSolutions,res,params,m);

        # printf("未转换的解");
        # print~(res);

        nres:={};
        map(transSolution,res,'nres',params,vars);
        res:=select(selectSolutions,nres,params,m);

        return res;
    end proc:

    (*
     * 转化csolve的结果
    *)
    transSolution:=proc(res::set(equation),nres::evaln(set),
                       params::set(name),vars::list(name))
        local r,rv,rp,np,rrv,rrp,sp,newSol;
        # 先求解a[0]..a[m],k,c
        sp:=select(isEquationOf,res,{vars[],k,c});
        sp:=map(_x->simplifyEqn(lhs(_x)-rhs(_x)),sp);# 化简方程，去除非零项
        rv:=RealDomain[solve](sp,[vars[],k,c]);

        # 如果求解失败则直接原样返回
        if evalb(rv=[]) then
            nres:=eval(nres) union {[res[]]};
            WARNING("solve求解失败");
            return;
        end if;

        # 再求解参数
        for rrv in rv do
            try
                np:=simplify(subs(op(rrv),res));
            catch:
                next;
            end try;
            np:=map(_x->simplifyEqn(lhs(_x)-rhs(_x)),np);# 化简方程，去除非零项
            np:=select(isEquationOf,np,params);
            rp:=RealDomain[solve](np,[params[]]);
            for rrp in rp do
                rrp:=subsIeq~(rrp);
                try
                    newSol:=[op(subsSol(rrv,rrp)),rrp[]];
                    newSol:=simplify(rationalize(newSol));
                    nres:=eval(nres) union {newSol};
                catch:
                    next;
                end try;
            end do;
        end do;
        return;
    end proc:

    (*
     * 消去不等式范围约束
    *)
    subsIeq:=proc(ee)
        local v;
        if type(ee,equation) then
            return ee;
        else
            v:=indets(ee);
            if evalb(nops(v)=1) then
                v:=v[1];
                return (v=v);
            else
                return ee;
            end if;
        end if;
    end proc:

    (*
     * 解集带入
     * sol2代入sol1
    *)
    subsSol:=proc(sol1,sol2)
        local sol;
        sol:=select(type,sol2,equation);
        expand(subs(op(sol),sol1));
    end proc:

    (*
     * 代回原方程进行验证
    *)
    checkSolution:=proc(ssol,oeq,m,tr)
        local uxi,sol,r;
        sol:=select(type,ssol,equation);
        r:=subs(u(x,t)=add(seq(a[i]*tanh(xi)^i,i=0..m))^tr,oeq);
        r:=subs(xi=k*(x-c*t),r);
        r:=subs(op(sol),r);
        r:=simplify(r);
        evalb(r=0);
    end proc:

    (*
     * 选择关于给定参数的方程
    *)
    isEquationOf:=proc(eq,vars::set)
        local vs;
        vs:=indets(eq,name);
        evalb( (vs intersect vars) <> {} );
    end proc:

end module:


# Vierachsroboter KUKA KR700PA implizit
# Initialisierung
# Import (Library)
interface(warnlevel=0): 		# Unterdrücke die folgende Warnung.
restart: 				# Gibt eine Warnung, wenn über Terminal-Maple mit read gestartet wird.
interface(warnlevel=3):
kin_constraints_exist := true:		# Für Speicherung
;
with(StringTools): 			# Für Zeitausgabe
with(LinearAlgebra):
with(codegen):
with(CodeGeneration):
codegen_act := true:
codegen_opt := 1: 			# Geringerer Optimierungsgrad. Sonst zu lange.
codegen_debug := 0:		        # Zur Code-Generierung auch für Nicht-Inert-Ausdrücke
;
# Import (Hybriddyn)
read "../helper/proc_MatlabExport":
read "../transformation/proc_rotx":
read "../transformation/proc_roty":
read "../transformation/proc_rotz":
read "../transformation/proc_trotz":
read "../transformation/proc_transl":
read "../helper/proc_convert_s_t":
read "../helper/proc_convert_t_s":
read "../robot_codegen_constraints/proc_subs_kintmp_exp":
read "../helper/proc_intersect_circle":
with(RealDomain): # Schränkt alle Funktionen auf den reellen Bereich ein. Muss nach Definition von MatlabExport kommen. Sonst geht dieses nicht.
;
read "../robot_codegen_definitions/robot_env_IC":			#aktuelle Roboter, MDH-Tabelle
;
read sprintf("../codeexport/%s/tmp/tree_floatb_definitions", robot_name_OL):
# Ergebnisse der Kinematik laden
read sprintf("../codeexport/%s/tmp/kinematics_floatb_%s_rotmat_maple.m", robot_name_OL, base_method_name);
read "../robot_codegen_definitions/robot_env_IC":
Trf := Trf:
Trf_c := Trf_c:
Trf:
# VGK Gelb 1-6-11-9-7-2-1
# Schleife (1-6)-(6-11)
T_1_11 := combine( Matrix(Trf(1..4,1..4, 6)) . Matrix(Trf(1..4,1..4,11))):
# Schleife (1-2)(2-7)(7-9)
T_1_9 := combine(Matrix(Trf(1..4,1..4, 2)) . Matrix(Trf(1..4,1..4,7)) . Matrix(Trf(1..4, 1..4, 9))):
h1t := T_1_11(1..3,4) - T_1_9(1..3,4);
tmp := Transpose( Matrix(T_1_11(1..3,1..3)) ) . Matrix(T_1_9(1..3,1..3)): #nur anzeigen lassen für h1r
;
combine(tmp);# nur anzeigen lassen für h1r
;
h1r := -(-qJ6(t)+qJ2(t)+qJ7(t)+phi79+qJ9(t)) + Pi;
# VGK GRÜN 2-3-4-10-12-8-7-2
# Schleife (2-3)-(3-4)-(4-10)
T_2_10 := combine( Matrix(Trf(1..4,1..4, 3)) . Matrix(Trf(1..4,1..4,4)) . Matrix(Trf(1..4,1..4,10))):
# Schleife (2-7)-(7-8)-(8-12)
T_2_12:= combine( Matrix(Trf(1..4,1..4, 7)) . Matrix(Trf(1..4,1..4,8)).Matrix(Trf(1..4,1..4,12)) ):
h2t := T_2_10(1..3,4) - T_2_12(1..3,4);
tmp := Transpose( Matrix(T_2_10(1..3,1..3)) )  .  Matrix(T_2_12(1..3,1..3)):  #nur anzeigen lassen für h2r
;
combine(tmp);  #nur anzeigen lassen für h2r
;
h2r := (qJ3(t)+qJ4(t)+phi410+qJ10(t)-qJ7(t)+phi78-qJ8(t))+Pi;
# Zusammenstellen aller Zwangsbedingungen
implconstr_t := <h1t([1, 3],1);h2t([1, 2],1); h1r; h2r>; # TODO: In h1r, h2r muss das richtige drinstehen.
implconstr_s := convert_t_s(implconstr_t);
# Exportiere Code für folgende Skripte
kin_constraints_exist:=true:
save implconstr_t, implconstr_s, kin_constraints_exist, sprintf("../codeexport/%s/tmp/kinematic_constraints_implicit_maple.m", robot_name):
# Exportieren des vollständigen Ausdruckes
if codegen_act then
  MatlabExport(implconstr_s, sprintf("../codeexport/%s/tmp/kinconstr_impl_matlab.m", robot_name), 2):
end if:
# Liste mit abhängigen konstanten Kinematikparametern erstellen (wichtig für Matlab-Funktionsgenerierung)
read "../helper/proc_list_constant_expressions";
kc_symbols := Matrix(list_constant_expressions( implconstr_s )):
save kc_symbols, sprintf("../codeexport/%s/tmp/kinematic_implicit_constraints_symbols_list_maple", robot_name):
MatlabExport(Transpose(kc_symbols), sprintf("../codeexport/%s/tmp/kinematic_implicit_constraints_symbols_list_matlab.m", robot_name), 2):