#sample
tinput := "5483143223
2745854711
5264556173
6141336146
6357385478
4167524645
2176841721
6882881134
4846848554
5283751526";

#toy
tinput := "11111
19991
19191
19991
11111";

input := FileTools:-Text:-ReadFile("AoC-2021-11-input.txt" ):

ogrid := map((parse~),StringTools:-Explode~(StringTools:-Split(input)));
gridw := nops(ogrid[1]); gridl := nops(ogrid);

neighbors := proc(pt) # include diagonals
local x, y, out;
global gridw, gridl;
    out := NULL;
    (x,y) := pt[];
    if x > 1 then
        out := out, [x-1, y];
        if y > 1 then
            out := out, [x-1, y-1];
        end if;
    end if;
    if y > 1 then
        out := out, [x, y-1];
        if x< gridw then
           out := out, [x+1, y-1];
        end if;
     end if;
    if x < gridw then
        out := out, [x+1, y];
        if y < gridl then
           out := out, [x+1, y+1];
        end if;
    end if;
    if y < gridl then
        out := out, [x, y+1];
        if x > 1 then
           out := out, [x-1, y+1];
        end if;
     end if;
    return [out];
end proc:

flash := proc(x,y)
local n, nb := neighbors([x,y]);
global grid, flashed;
    if flashed[x,y] <> 0 then
    # flashed is a table to track that we flashed only once
        return;
    end if;
    flashed[x,y] := 1;
    for n in nb do
    # increment neighbors and maybe trigger their flashes
        grid[n[]] += 1;
        if grid[n[]] > 9 then
            flash(n[]);
        end if;
     end do;
end proc: # flash
totalflashes := 0;
grid := Array(ogrid);

for dd from 1 to 1000 while add(grid) <> 0 do
    grid := grid +~ 1; # increment grid
    flashed := table(sparse=0); # clear flash tracking table
    # do the flashes - flash may trigger flashes earlier too
    for i from 1 to gridw do
        for j from 1 to gridl do
            if grid[i,j] > 9 then
                flash(i,j);
            end if;
        end do;
    end do;
    # count and reset flashed
    for i from 1 to gridw do
        for j from 1 to gridl do
            if grid[i,j] > 9 then
                grid[i,j] := 0;
                if i <= 100 then
                    totalflashes+=1;
                end if;
            end if;
        end do;
    end do;

end do: # days

answer1 := totalflashes;
answer2 := (dd-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/.
*)

(* type: mgga_exc *)

$include "mgga_c_scan.mpl"

(* Override definition of beta *)
mbeta := (rs, t) -> 0.066725:

rmggac_gamma1 := 0.08:
rmggac_gamma2 := 0.3:
rmggac_g := (alpha, s) ->
  (1 + rmggac_gamma1)*alpha/(rmggac_gamma1 + alpha + rmggac_gamma2*s^2):

rmggac_f2 := (alpha, s) ->
  3*rmggac_g(alpha, s)^3/(1 + rmggac_g(alpha, s)^3 + rmggac_g(alpha, s)^6):
rmggac_f1 := (alpha, s) ->
  1 - rmggac_f2(alpha, s):

rmggac_gamma := 0.031091:
(* from mmga_c_r2scan *)
rmggac_w1 := (rs, z) -> exp(-f_pw(rs, z)/(rmggac_gamma*mphi(z)^3)) - 1:
rmggac_H1 := (rs, z, t) -> rmggac_gamma*mphi(z)^3*log(1 + rmggac_w1(rs, z) * (1 - scan_e0_g(rs, z, t))):

rmggac_eps1 := (rs, z, t) ->
  (f_pw(rs, z) +  rmggac_H1(rs, z, t)):

rmggac_alpha := (z, xt, ts0, ts1) ->
  (t_total(z, ts0, ts1) - xt^2/4)/(2**(1/3)*K_FACTOR_C):

rmggac_f := (rs, z, xt, xs0, xs1, ts0, ts1) ->
  + scan_e0(rs, z, X2S*2^(1/3)*xt)
      * rmggac_f1(rmggac_alpha(z, xt, ts0, ts1), X2S*2^(1/3)*xt)
  + rmggac_eps1(rs, z, tp(rs, z, xt))
      * rmggac_f2(rmggac_alpha(z, xt, ts0, ts1), X2S*2^(1/3)*xt):

(* the functional is written for the other convention for tau *)
f := (rs, z, xt, xs0, xs1, us0, us1, ts0, ts1) ->
  rmggac_f(rs, z, xt, xs0, xs1, 2*ts0, 2*ts1):


#@ Not autoload

# This file relates to the cubic with equation x[1]^3 + x[2]^3 + x[3]^3 = nu * x[1] * x[2] * x[3]

om := exp( 2*Pi*I/3);
ob := exp(-2*Pi*I/3);
R := [1,om,ob];

# The group G acts on affine 3-space, preserving the above cubic.
# The quotient G/Z acts on the projective plane, preserving our cubic curve

id := IdentityMatrix(3);
rho := <<0|0|1>,<1|0|0>,<0|1|0>>:
zeta := DiagonalMatrix([1,om,ob]):

Z := [id,om * id, ob * id];
T := [seq(seq(DiagonalMatrix(rationalize(expand([om^i,om^j,om^(-i-j)]))),j=0..2),i=0..2)]:
S := map(perm_matrix,combinat[permute](3)):
G := [seq(seq(t.s,t in T),s in S)]:

# rho and zeta commute in G/Z
for i from -1 to 1 do
 for j from -1 to 1 do
  g[i,j] := map(rationalize,rho^i . zeta^j);
 od;
od:

# We now define matrices U[i,j] = <e[i,j] | u[i,j] | v[i,j]>
# Each e[i,j] generates a 1-dimensional summand in affine 3-space
# On the complement of the locus where nu = 3 = 0, each pair
U[0,0] := <<1|1|nu>,<-1|-nu-1|3>,<0|3|nu>>;
for i from -1 to 1 do
 for j from -1 to 1 do
  U[i,j] := map(expand,g[i,j] . U[0,0]);
  e[i,j] := convert(Column(U[i,j],1),list);
  u[i,j] := convert(Column(U[i,j],2),list);
  v[i,j] := convert(Column(U[i,j],3),list);
 od:
od:


restart:
Digits := 100:
with (numapprox):with(orthopoly):
read "common-procedures.mpl";
mkdir("TEMPATAN");

#First, quick phase
#Approach for the first function:
#atan(x) = atan(b(i)) + atan ( (x-bi) / (1+x*b(i) ) )
#We try to have 64 correct bits

#Constants

#if (x >= xmax) : return arctan(x)/2)=neareast(Pi/2)

log[2](evalf(min(solve(arctan(x)=nearest(Pi/2),x)))):
xmax:=2^54:

#halfPi=Pi/2 (remark that maxvalue < Pi/2 so that atan(x) < Pi/2

halfPi:=nearest(Pi/2):
halfPi_to_plus_infinity:=nearest(nearest(Pi/2)*(1+2^(-53))):

# invPi, for the atanpi function

invpih,invpil := hi_lo(1/Pi);

# if (xmin<xmin) : return arctan(x)=x

xmin=2^(-27);

ieeehexa(halfPi); ieeehexa( halfPi_to_plus_infinity ); ieeehexa(2^(-27));ieeehexa(2^(54));ieeehexa(2^(-10));

#Interval parameters
#Some constants :
e:=2^(-6.3):
marge := 2^(-30):

#The intervals are (a[i],a[i+1]). the "middle" is b(i) :
maxx := bi -> simplify( solve( (x-bi) / (1+x*bi) = e ,x) ):
minx := bi -> simplify(solve( (x-bi) /(1+x*bi)=-e ,x)):

nextbi := proc (x) evalf( max(solve( minx(bi) = x ,bi) )*(1-marge)); end:

allbi := proc (n)
  local xi,nbi,x,i,j;
  global b,a, nb_of_ai, nb_of_bi, value_for_dicho;
  x := e;
  nbi := 0;
  i := 0;
  while(i<n and nbi < 1/e and nbi >= 0) do
     nbi := nearest ( nextbi(x) );
     b[i] := evalf( nbi );
     a[i] := x;
     x   := evalf(maxx(nbi));
     i:=i+1;
  od;
  j:=0;
  while ( 2^j < i ) do j:=j+1 od:
  nb_of_ai := i;
  nb_of_bi := i;
  b[i-1] := nearest(1/e+4):
  value_for_dicho := 2^j;
  return i,b[0],b[i-1];
end:

allbi(100);

#The polynome and its size ( 4 because 4 terms : x^2/3, ...)

Q9:= poly_exact(x-1/3*x^3+1/5*x^5 -1/7*x^7+1/9*x^9):
deg_poly := 4:
coef_poly[0]:=nearest (-1/3):
coef_poly[1]:=nearest (1/5):
coef_poly[2]:=nearest (-1/7):
coef_poly[3]:=nearest (1/9):

Q := x^2 * coef_poly[0] + x^4*coef_poly[1] + x^6*coef_poly[2] + x^8 * coef_poly[3]:

Qprime := poly_exact( x * coef_poly[0] + x^2*coef_poly[1] + x^3*coef_poly[2] + x^4 * coef_poly[3]):

log[2] (infnorm( (arctan(x)-x*(1+Q) )/x,x=2^(-53)..e));
# we can note that arctan(x) = sum((-1)^i*x^(2*i+1)/(2*i+1), i = (0 .. infinity))
# so ( arctan(x) - Q9(x) ) / x = sum((-1)^i*x^(2*i)/(2*i+1), i = (5 .. infinity))
# so abs ( (arctan(x) -Q9(x) )/x )  <= x^10 * sum((-1)^(i+1)*x^(2*i)/(2*i+1+10), i = (0 .. infinity))
#                                   <= x^10 * 1/11
#                                   <= 2^(-66) if x<2^(-6.3)

#Conputation of the RN constant

#Epsilon = relative error
#Delta = absolute error
#1st : Error about reduction:

EpsilonXminusBi := 2^(-105):

# 1 + x*b[i] :
Epsilon1A22xbi :=  2^(-104):

# Xred = (x-b[i]) / ( 1 + x*b[i] )

EpsilonXred := EpsilonXminusBi+Epsilon1A22xbi + 2^(-105):

DeltaXred := EpsilonXred * e:

log2(EpsilonXred);

#Polynomial evaluation :
#atan ~= x - x^3/3 + x^5/5 - x^7/7 + x^9/9
#        ~= x * ( 1 + Q(x^2) )
#    = (xhi+xlo) * ( 1 + Q)
#        ~= xhi + (xhi*Q + xlo)

#  Warning : the approx about x !!

#calc of Q:

EpsilonXred2 := (1+2^(-53) + 2^(-105) )^2 * (1+2^(-53)) -1 :

log2(EpsilonXred2);

errlist:=errlist_quickphase_horner( degree( x^4 ),0,0,EpsilonXred2, 2**(-53)):

rounding_error1:= compute_horner_rounding_error(Qprime,x,e,errlist,true):

EpsilonQ := rounding_error1[1]:
log2(EpsilonQ);

# Since q will be multiplied in x(1+q), its absolute error term is :

Qmax:=infnorm(Qprime,x=-e^2..e^2):

DeltaQ := e*Qmax*EpsilonQ;
log2(DeltaQ);

# calc of xi*Q + xlo + atan(b[i])lo

#First the truncation of xredlo*q : at most half an ulp of xredhi*q
DeltaTruncXredloQ :=  2^(-53) * e * Qmax:
log2(DeltaTruncXredloQ);
#then the sum of atanbilo and xredlo : the largest term is atanbilo
DeltaAdd1  := 0.5*ulp(2^(-53)*(Pi/2 + e)):
log2(DeltaAdd1);

#then compute xredhi*q
DeltaXredhiQ := 0.5*ulp(e*Qmax):
log2(DeltaXredhiQ);

# and the second addition
DeltaAdd2 :=  0.5*ulp(e*Qmax +  2^(-53)*(Pi/2 + e) ):
log2(DeltaAdd2);

DeltaAtanlolo := DeltaTruncXredloQ + DeltaAdd1 + DeltaXredhiQ + DeltaAdd2:
log2(DeltaAtanlolo);

# In the second reconstruction there is one more FP add which is
# aligned to the previous:
DeltaReconst := DeltaAtanlolo + DeltaAdd2 :
log2(DeltaReconst);

# error due to the approx of atan by P : < e^11/11
Deltaapprox := infnorm( (arctan(x)-x*(1+Q)), x=0..e):

log[2](Deltaapprox);

DeltaTotal := Deltaapprox + DeltaQ + DeltaReconst :
log2(DeltaTotal);
EpsilonTotal := evalf( DeltaTotal / arctan(xx) ):

EpsilonFinal := infnorm( EpsilonTotal,xx=2^(-6.3)..1,'xmaxmax'):
EpsilonFinal_i_10 := infnorm( EpsilonTotal,xx=a[10]..2^60,'xmaxmax'):
log2( EpsilonFinal );
log2( EpsilonFinal_i_10 );

# Computation of e and e_i_30 (which is e when i>30 (ie x>1)
E := evalf(compute_rn_constant(EpsilonFinal));
E_i_10 := evalf(compute_rn_constant(EpsilonFinal_i_10));

#An other Constant : when there is no reduction.
#We compute the polynom and then atan(x) = x + x.Q

Epsilonx2 := 2^(-53):
errlist:=errlist_quickphase_horner( degree( Qprime ),0,0,Epsilonx2, 2**(-53)):
rounding_error:= compute_horner_rounding_error(Qprime,x,e,errlist,true):

epsilon_Q := rounding_error[1]:
log[2](epsilon_Q);

epsilon_x_Q := 2^(-52):

delta_final := 2^(-105)*x + epsilon_Q*x^3 + epsilon_x_Q*x^3 - arctan(x) + x*(1+Q):
epsilon_final := infnorm(delta_final/x,x=2^(-10)..e):
epsilon_final_m10 := infnorm(delta_final/x,x=2^(-24)..2^(-10)):

log[2](epsilon_final);
E_no_reduction := evalf(compute_rn_constant(epsilon_final));
E_no_reduction_m10 := evalf(compute_rn_constant(epsilon_final_m10));

# Output

#test
filename:="TEMPATAN/atan_fast.h":

fd:=fopen(filename, WRITE, TEXT):
fprintf(fd, "\n/*File generated by maple/atan.mpl */\n"):

fprintf(fd, "#ifndef _ATAN_FAST_H\n#define _ATAN_FAST_H\n\n");

fprintf(fd, "#include \"crlibm.h\"\n#include \"crlibm_private.h\"\n"):

fprintf(fd,"#ifdef WORDS_BIGENDIAN\n"):
fprintf(fd, "static const db_number HALFPI = {{0x3FF921FB,0x54442D18}};"):
fprintf(fd, "static const db_number HALFPI_TO_PLUS_INFINITY = {{0x3FF921FB,0x54442D19}};"):
fprintf(fd,"\n#else\n"):
fprintf(fd, "static const db_number HALFPI = {{0x54442D18,0x3FF921FB}};"):
fprintf(fd, "static const db_number HALFPI_TO_PLUS_INFINITY = {{0x54442D19,0x3FF921FB}};"):
fprintf(fd,"\n"):
fprintf(fd,"#endif\n"):

fprintf(fd, "#define MIN_REDUCTION_NEEDED %1.50f\n",e):

fprintf(fd, "#define INVPIH %1.50f\n", invpih):
fprintf(fd, "#define INVPIL %1.50f\n", invpil):

fprintf(fd,"#define nb_of_ai %d\n",nb_of_ai):
fprintf(fd,"#define nb_of_bi %d\n",nb_of_bi):

# we multiply by 2^(-20) in order to prevent from rounding
fprintf(fd, "static const double rncst[4] ={\n"):
fprintf(fd, "%1.50f , /* i<10 */ \n",E*(1+2^(-20))) :
fprintf(fd, "%1.50f , /* i>10 */ \n",E_i_10*(1+2^(-20))) :
fprintf(fd, "%1.50f , /* e > 2^-10 */ \n",E_no_reduction*(1+2^(-20))) :
fprintf(fd, "%1.50f , /* e < 2^-10 */ \n };\n",E_no_reduction_m10*(1+2^(-20))) :

fprintf(fd, "static const double epsilon[4] ={\n"):
fprintf(fd, "%1.50e ,\n",EpsilonFinal *(1+2^(-20))) :
fprintf(fd, "%1.50e ,\n",EpsilonFinal_i_10*(1+2^(-20))) :
fprintf(fd, "%1.50e ,\n",epsilon_final*(1+2^(-20))) :
fprintf(fd, "%1.50e ,\n };\n",epsilon_final_m10*(1+2^(-20))) :

fprintf(fd, "#define DEGREE %d\n", deg_poly):
fprintf(fd, "static double const coef_poly[%d] = \n{\n",deg_poly):

for i from deg_poly-1 to 0 by -1 do
    fprintf(fd, "/* coef for degree %d */ %1.50f, \n" , 2*i+3, coef_poly[i]):
od:
fprintf(fd," }; \n");

fprintf(fd,"#define A 0\n"):
fprintf(fd,"#define B 1\n"):
fprintf(fd,"#define ATAN_BHI 2\n"):
fprintf(fd,"#define ATAN_BLO 3\n"):

fprintf(fd,"\n#ifdef WORDS_BIGENDIAN\n "):

for isbig from 1 to 0 by -1 do

    if(isbig=0) then
        fprintf(fd,"#else\n");
    fi:

    if(not (nb_of_ai = nb_of_bi)) then
        printf("Warning : nb_of_ai != nb_of_bi, this should not work");
    fi:

    fprintf(fd,"\n/* limits of the intervals [a[i],b[i]] */\n");
    fprintf(fd, "static db_number const arctan_table[%d][4] = \n{\n" , nb_of_ai );

   for i from 0 to nb_of_ai - 1 do
        fprintf(fd, "{\n/*a[%d]     */ ",i);
        printendian(fd,a[i],isbig);
        fprintf(fd," ,\n/*b[%d] :   */ ",i):
        printendian(fd,b[i],isbig):
        fprintf(fd," ,\n/*atan_b[%d]*/ ",i):
        printendian(fd, arctan(b[i]) ,isbig):
        fprintf(fd,",");
        printendian(fd, arctan(b[i])-nearest(arctan(b[i])) ,isbig);
        fprintf(fd," ,\n}\n,");
    od;
    fprintf(fd,"\n};\n");
od:

fprintf(fd,"\n#endif\n\n"):

fprintf(fd, "#endif /* def _ATAN_FAST_H */\n");

fclose(fd);

# Scs phase

#Now we want a precision of 130 bits in order to have correct rounding in all cases.
evalf(log[2](e^21/21));
#Test about Rounding :
#error on the polynom :
P_scs := convert(series(arctan(x),x=0,21),polynom);
evalf(log[2](e^21/21));
#Intervals parameters
#We choose the same e and the same intervals as in the quick phase.

#We have the same b[i]s and a[i]s but we save atan[b[i]] on 4 doubles

# Output
filename:="TEMPATAN/atan_accurate.h":
fd1:=fopen(filename, WRITE, TEXT):

fprintf(fd1, "#include \"crlibm.h\"\n#include \"crlibm_private.h\" \n#include \"atan_fast.h\"\n"):
fprintf(fd1, "\n/*File generated by maple/atan.mpl */\n"):

Write_SCS_poly(fd1, "constant_poly", P_scs);

fprintf(fd1,"#define constant_poly_ptr (scs_ptr)&constant_poly\n");

# The 1/Pi SCS constant
  fprintf(fd, "static const scs InvPiSCS=\n"):
  WriteSCS(fd, evalf(1/Pi)):
  fprintf(fd, ";\n#define InvPiSCS_ptr  (scs_ptr)(& InvPiSCS)\n\n"):

fprintf(fd1,"#ifdef WORDS_BIGENDIAN\n\n"):
for isbig from 1 to 0 by -1 do
   if isbig = 0 then
      fprintf(fd1, "\n#else\n"):
   fi:

   fprintf(fd1,"static const db_number atan_blolo[%d] = {\n",nb_of_ai);
   for i from 0 to nb_of_ai-1 do
      fprintf(fd1,"/* %d */  ",i):
      temp0 := nearest(arctan(b[i]));
      temp := nearest( arctan(b[i]) - nearest(arctan(b[i])));
      temp1 := nearest( arctan(b[i]) - temp -temp0);
      printendian(fd1,temp1,isbig):
      fprintf(fd1,", \n");
   od:

   fprintf(fd1,"};\n"):

od:
fprintf(fd1,"\n#endif  /* WORDS_BIGENDIAN */ \n");

fclose(fd1);


with(Algebraic):

findElementaryIntegral := proc(maxint, maxdeg, raddeg, radexpt, x, ngoal)

	local ngiveup, nsincelast, totaltime, nfound, ntrials, nrepeats, num, den, rad, integrand, integral, radsqf, fac, r;

	Seed := randomize();

	ngiveup := 2500;

	randinrange := rand(-maxint..maxint);
	negrandinrange := rand(-maxint..-1);
	posrandinrange := rand(1..maxint);
	randf := rand(0.0..1.0);

	interface(prettyprint=0);

	found := [];
	nfound := 0;
	ntrials := 0;
	nrepeats := 0;
	nsincelast := 0;
	while (nfound < ngoal) do

		num := [seq(randinrange()*x^k, k=0..maxdeg)];
		num := convert(num, `+`);
		den := [seq(randinrange()*x^k, k=0..maxdeg)];
		den := convert(den, `+`);
		rad := [seq(randinrange()*x^k, k=1..raddeg-1)];
		rad := convert(rad, `+`);
		if randf() < 0.5 then
			rad := x^raddeg + negrandinrange() + rad;
		else
			rad := x^raddeg + posrandinrange() + rad;
		end if;

		if num*den*rad = 0 then next end if;

		radsqf := Squarefree(rad)[2];
		m := 1/radexpt;

		if nops(radsqf) = 1 then
			if degree(radsqf[1][1],x) = 1 then next end if;
		end if;

		bad := false;
		for fac in radsqf do
			r := fac[2] mod m;
			if r = 0 then
				bad := true;
			end if;
		end do;

		if bad then next end if;

		integrand := normal(num/den)/(rad)^radexpt;

		if evalb(integrand in found) then
			nrepeats += 1;
			if nrepeats > 4 then
				break
			end if;
			next
		end if;

		ntrials += 1;
#		print ("integrand = ", integrand);
		t0 := Now(ProcessClock);
		integral := int(convert(integrand, RootOf), x);
		t1 := Now(ProcessClock);
		totaltime := totaltime + t1 - t0;
#		print("integral = ", integral);

		if not has(integral,[int,EllipticPi,EllipticE,EllipticF])  then
			nfound += 1;
			nsincelast := 0;
			found := [op(found), integrand];
			print("integrand = ", integrand);
			print("integral  = ", convert(integral, radical));
		else
			nsincelast += 1;
		end if;

		if nsincelast > ngiveup then break end if;

		if ntrials mod 100 = 0 then
		   print("ntrials = ", ntrials, ", nfound = ", nfound, ", % elementary = ", evalf(100.0*nfound/ntrials));
		end if;
	end;

	print("FINISHED! params = ", maxint, maxdeg, raddeg, radexpt, x, ngoal, " ntrials = ", ntrials, ", nfound = ", nfound, ", % elementary = ", evalf(100.0*nfound/ntrials), ", mean time = ", evalf(totaltime/ntrials));
end proc;


# Base Parameter Energy Regressor for Robot based on MDH frames
# Einleitung
# Erstellung einer parameterlinearen und -minimalen Regressorform
#
# Dateiname:
# robot -> Berechnung für allgemeinen Roboter
# chain -> Berechnung für eine serielle Struktur (nicht: Baumstruktur)
# fixb -> fixed base. Kein Floating base Modell. Dort ist diese Form der Minimalparameterform nicht möglich.
# energy -> Berechnung bezogen auf Energie
# regressor -> Regressorform (parameterlinear)
# linearsolve -> Nicht geometrischer Ansatz nach Khalil, sondern symbolischer Ansatz mit LinearSolve
# Authors
# Jonas Diekmeyer (Studienarbeit bei Elias Knöchelmann)
# Moritz Schappler, moritz.schappler@imes.uni-hannover.de, 2020-06
#
# (C) Institut fuer Mechatronische Systeme, Leibniz Universitaet Hannover
# Quellen
# [Diekmeyer2018_S678] Identifikation der inversen Dynamik eines seriellen Roboters im geschlossenen Regelkreis, Studienarbeit, imes, LUH, 2018
# 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=100): # Zur Anzeige von größeren Vektoren
;
with(LinearAlgebra):
with(ArrayTools):
with(codegen):
with(CodeGeneration):
with(StringTools):
codegen_act := true:
codegen_opt := 2:
read "../helper/proc_convert_s_t":
read "../helper/proc_convert_t_s":
read "../helper/proc_MatlabExport":
read "../helper/proc_simplify2":
read "../robot_codegen_definitions/robot_env":
read sprintf("../codeexport/%s/tmp/tree_floatb_definitions", robot_name, base_method_name):
read sprintf("../codeexport/%s/tmp/kinematic_constraints_maple_inert.m", robot_name):
kin_constraints_exist := kin_constraints_exist: # nur zum Abschätzen der Komplexität
;
# Prüfe, ob die symbolische Berechnung der Parameterminimierung berechnet werden sollte
abort_this_worksheet := false:
# Bestimme, ob es eine Baumstruktur ist. Wenn ja, funktioniert der andere Algorithmus nicht und dieser wird genommen.
tree:=false:
for i from 1 to NJ do
  if not v(i) = i-1 then
    tree := true: break:
  end if:
end do:

if not (assigned(user_CoM) or assigned(user_M) or assigned(user_inertia) \
  or kin_constraints_exist or tree) then
  # Es gibt keinen Sonderfall, diese Berechnung der Minimalparameter ist nicht notwendig.
  printf("Keine analytische Berechnung der Minimalparameter notwendig.\n"):
  abort_this_worksheet := true:
end if:

if assigned(dynpar_minimization_linsolve) and not dynpar_minimization_linsolve then
  printf("Analytische Berechnung der Minimalparameter manuell deaktiviert.\n"):
  abort_this_worksheet := true:
end if:

if assigned(dynpar_minimization_linsolve) and dynpar_minimization_linsolve then
  printf("Analytische Berechnung der Minimalparameter durch Option dynpar_minimization_linsolve verlangt.\n"):
  abort_this_worksheet := false:
end if:

if abort_this_worksheet then
  quit: # Funktioniert in GUI nicht richtig...
  robot_name := "": # ...Daher auch Löschung des Roboternamens.
end if:
printf("%s. Generiere Minimalparameterregressor der Energie für %s (symbolischer Ansatz)\n", \
  FormatTime("%Y-%m-%d %H:%M:%S"), robot_name, codegen_dynpar):
# Term-Vereinfachungen einstellen
if not assigned(simplify_options) or simplify_options(7)=-1 then # Standard-Einstellungen:
  if not kin_constraints_exist then # normale serielle Ketten und Baumstrukturen
    use_simplify := 0: # Standardmäßig aus
  else # mit kinematischen Zwangsbedingungen
    use_simplify := 1: # standardmäßig simplify-Befehle anwenden
  end if:
else # Benutzer-Einstellungen:
  use_simplify := simplify_options(7): # siebter Eintrag ist für Energie-Regressor
end if:

# Ergebnisse der Energie laden (aus robot_chain_fixb_rotmat_energy_regressor.mw)
read sprintf("../codeexport/%s/tmp/energy_kinetic_fixb_regressor_maple.m", robot_name):
t_ges := t_ges:
read sprintf("../codeexport/%s/tmp/energy_potential_fixb_regressor_maple.m", robot_name):
u_ges := u_ges:
# Parameterminimierung
# Siehe auch [Diekmeyer2018_S678] S. 19f. und 32ff.
# Funktionen definieren

splitSummands := proc(input_expr)
# Gibt eine Liste aller Summanden zurücachezurück
  local expr, sub_expr:

  expr := expand(input_expr):

  if type(expr,'`+`') then
    sub_expr := op(expr):
    return sub_expr:
  else
    return expr:
  end if:

end proc:

splitFactors := proc(input_expr)
# Gibt eine Liste aller Faktoren zurück
  local sub_expr:

  if type(input_expr,'`*`') then
    sub_expr := op(input_expr):
    return sub_expr:
  else
    return input_expr:
  end if:

end proc:

removeEmptyRows := proc(h,G)
  local mh, mG, i, j, flag:

  flag := Vector[column](Size(G,1)):
  for i from 1 to Size(G,1) do
    flag(i) := 0:
    for j from 1 to Size(G,2) do
      if G(i,j) <> 0 then
        flag(i) := 1:
      end if:
    end do:
  end do:

  mh := Vector[column](Norm(flag,1)):
  mG := Matrix(Norm(flag,1),Size(G,2)):

  j := 1:
  for i from 1 to Size(G,1) do
    if flag(i) = 1 then
      mG(j,..) := G(i,..):
      mh(j) := h(i):
      j := j + 1:
    end if:
  end do:

  return mh, mG:
end proc:

permuteEmptyRows := proc(G)
  local Pb, Pd, i, j, k, flag:

  flag := Vector[column](Size(G,1)):
  for i from 1 to Size(G,1) do
    flag(i) := 0:
    for j from 1 to Size(G,2) do
      if G(i,j) <> 0 then
        flag(i) := 1:
      end if:
    end do:
  end do:

  Pb := Matrix(Norm(flag,1),Size(G,1)):
  Pd := Matrix(Size(G,1)-Norm(flag,1),Size(G,1)):

  j := 0:
  k := 0:
  for i from 1 to Size(G,1) do
    if flag(i) = 1 then
      j := j + 1:
      Pb(j,i) := 1:
    elif flag(i) = 0 then
      k := k + 1:
      Pd(k,i) := 1:
    end if:
  end do:

  return Pb, Pd:
end proc:

hasElement := proc(v, expr)
# Gibt den Index des Vektorelements von "v" wieder, das dem Ausdruck "expr" entspricht.
# Ist der Ausdruck nicht enthalten wird der höchste Index um eins erhöht wiedergegeben.
  local i:

  for i from 1 to NumElems(v) do
    if verify(v(i),expr) then
      return i:
    end if:
  end do:

  return NumElems(v)+1:
end proc:

tmp_tt1 := time(): tmp_timelastmessage := tmp_tt1:
# Kinematikparameter, die als Argument von Sinus und Cosinus stehen ersetzen.
# Ansonsten werden sie durch die Umwandlung in die Exponentialform mit ersetzt. Das ist aber nicht hilfreich.
read sprintf("../codeexport/%s/tmp/parameter_kin", robot_name):
pkin := pkin:

lagrange := Vector[column](t_ges[1,..] - u_ges[1,..]):
(*
# TODO: Das scheint die Rechenzeit von LinearSolve in manchen Fällen stark zu verlängern
for j from 1 to RowDimension(pkin) do
  lagrange := subs(parse(sprintf("sin(%s)", pkin(j,1)))=parse(sprintf("sin_%s", pkin(j,1))), lagrange):
  lagrange := subs(parse(sprintf("cos(%s)", pkin(j,1)))=parse(sprintf("cos_%s", pkin(j,1))), lagrange):
end do:
*)

# Parameter gruppieren. Siehe [Diekmeyer2018_S678] Gl. 3.27
# Erstelle eine Matrix V, die die einzelnen Terme des Energie-Regressors gruppiert
# Komponentenmatrix für jeden Eintrag des Lagrange-Regressors.
# Initialisierung mit voller Dimension (notwendig für geschlossene kinematische Ketten;
# in dem Fall sind die Einträge der letzten Parameter Null/konstant. Bei rein seriellen Ketten nicht der Fall).
V := Matrix(NumElems(lagrange),1):
w := Vector[column](): # Hilfsvariable
for i from 1 to NumElems(lagrange) do # Parameter-Einträge durchgehen
  if i=1 or time()-tmp_timelastmessage > 10.0 then # min. alle 10s Status ausgeben.
    printf("%s. Erstelle Komponentenmatrix für Lagrange-Regressor-Eintrag %d/%d\n", FormatTime("%Y-%m-%d %H:%M:%S"), i, NumElems(lagrange)):
    tmp_timelastmessage := time():
  end if:
  lagrange_term := simplify(expand(lagrange(i))):
  # Umrechnung der Trigonometrische Funktion in Exponent-Darstellung.
  # Funktioniert nicht ganz wie erwartet, falls Parameter in sin/cos stehen. Dann treten Imaginärteile auf.
  # Diese werden weiter unten wieder entfernt
  # Durch diesen Befehl wird die Spalten-Dimension der Matrix stark reduziert (ca. auf ein Drittel)
  lagrange_term := convert(lagrange_term,exp):
  lagrange_term := simplify(expand(lagrange_term),size):
  lagrange_summand := [splitSummands(lagrange_term)]:
# print(lagrange_summand):
  for j from 1 to nops(lagrange_summand) do
#   printf("j=%d\n", j):
    # Konstante Ausdrücke werden nicht berücksichtigt!
    if not has(lagrange_summand[j],t) then
      next:
    end if:
    lagrange_factor := [splitFactors(lagrange_summand[j])]:
    lagrange_timeVar := 1:
    lagrange_constant := 1:
    for k from 1 to nops(lagrange_factor) do
#     printf("k=%d\n", k):
      if has(lagrange_factor[k],t) then
        lagrange_timeVar := lagrange_timeVar * lagrange_factor[k]:
      else
        lagrange_constant := lagrange_constant * lagrange_factor[k]:
      end if
    end do:
    lagrange_timeVar := simplify(expand(lagrange_timeVar)):
    index_timeVar := hasElement(w,lagrange_timeVar):
    if index_timeVar > NumElems(w) then
      w(index_timeVar) := lagrange_timeVar:
      V(i,index_timeVar) := lagrange_constant:
    elif i > Size(V,1) then
      V(i,index_timeVar) := lagrange_constant:
    else
      V(i,index_timeVar) := V(i,index_timeVar) + lagrange_constant:
    end if:
  end do:
end do:
# Substitutierte sinus/cosinus-Terme der Kinematikparameter wieder zurückersetzen

(* Nicht notwendig, wenn oben auskommentiert.
for j from 1 to RowDimension(pkin) do
  V := subs(parse(sprintf("sin_%s", pkin(j,1)))=parse(sprintf("sin(%s)", pkin(j,1))), V):
  V := subs(parse(sprintf("cos_%s", pkin(j,1)))=parse(sprintf("cos(%s)", pkin(j,1))), V):
end do:
*)
#
tmp_tt2 := time():
printf("%s. Komponenten-Matrix des Energie-Regressors berechnet (%dx%d). Rechenzeit: %1.1fs\n", \
  FormatTime("%Y-%m-%d %H:%M:%S"), RowDimension(V), ColumnDimension(V), tmp_tt2-tmp_tt1):
save V, sprintf("../codeexport/%s/tmp/minimal_parameter_calculation_fixb_maple_linsolve_debug1.m", robot_name):
# Rang der Matrix prüfen für Dimension des Parametervektors
tmp_t1 := time():
RankV := Rank(V):
tmp_t2 := time():
printf("%s. Die Komponenten-Matrix des Energie-Regressors hat Rang %d. Rechenzeit: %1.1fs\n", \
  FormatTime("%Y-%m-%d %H:%M:%S"), RankV, tmp_t2-tmp_t1):
# [Diekmeyer2018_S678] Gl. 3.27
tmp_t1 := time():
U := LinearSolve(Transpose(V),Transpose(V)):
tmp_t2 := time():
printf("%s. Basis der Komponenten-Matrix mit LinearSolve gelöst. Resultat ist %dx%d. Rechenzeit: %1.1fs\n", \
  FormatTime("%Y-%m-%d %H:%M:%S"), RowDimension(U), ColumnDimension(U), tmp_t2-tmp_t1):
# Freie Variablen ("_t") entfernen
for i from 1 to Size(V,1) - RankV do
  for j from 1 to Size(V,1) do
    # printf("subs %d,%d\n", i,j):
    U := subs([_t[i, j]=0],U):
  end do:
end do:
# [Diekmeyer2018_S678] Gl. 3.29
Pb, Pd :=permuteEmptyRows(U):
P := Matrix([[Pb],[Pd]]):
save P, Pb, Pd, U, V, RankV, sprintf("../codeexport/%s/tmp/minimal_parameter_calculation_fixb_maple_linsolve_debug2.m", robot_name):
read sprintf("../codeexport/%s/tmp/minimal_parameter_calculation_fixb_maple_linsolve_debug2.m", robot_name):
# [Diekmeyer2018_S678] Gl. 3.31 (links)
Paramvec2 := Pb.U.PV2_vec(11..,..):
# Nachverarbeitung: Prüfe ob Imaginärteile aus Substitutionsalgorithmus vorhanden sind
tmp_t1 := time():
# Diese Prüfung ist nur notwendig, wenn oben die Lagrange-Terme in Exponent-Form gebracht wurden
# Dann ist es möglich, dass imaginäre Ausdrücke im Parametervektor stehen.
imagpart:=false:
for i from 1 to RowDimension(Paramvec2) do
  # Umrechnung der Exponentialform in trigonometrische Form
  Paramvec2(i,1) := simplify(convert(expand(Paramvec2(i,1)), trig));

  if not evalc(Im(Paramvec2[i,1])) = 0 then # müssen eckige Klammern sein, damit evalc funktioniert.
    imagpart := true: # Imaginärteil erkannt. Annahme: Auch nachfolgende Vereinfachung kann daran nichts ändern.
    break:
  end if:
  if has(Paramvec2(i,1), I) then # Prüfe auf Imaginärteil durch Existenz der imaginären Einheit
    Paramvec2(i,1) := evalc(Re(Paramvec2[i,1])): # da Im() oben Null war, muss Re() den vollen Term enthalten.
  end if:
end do:
if imagpart then
  printf("Der Parametervektor hat trotz versuchter Substitution immer noch Imaginärteile aus dem Algorithmus. Verwerfe Lösung und Abbruch.\n"):
  quit: # Funktioniert in GUI nicht richtig...
  robot_name := "": # ...Daher auch Löschung des Roboternamens.
end if:
tmp_t2 := time():
Paramvec2 := simplify2(Paramvec2): # nochmal vereinfachen
;
printf("%s. Parameter-Vektor nachverarbeitet. Rechenzeit: %1.1fs\n", \
  FormatTime("%Y-%m-%d %H:%M:%S"), tmp_t2-tmp_t1):
# Debug: Fertigen Parameter von anderem Durchlauf laden
# read sprintf("../codeexport/%s/tmp/minimal_parameter_vector_fixb_maple_linsolve", robot_name):
printf("%s. Dimension des Minimalparametervektors: %dx%d\n", \
  FormatTime("%Y-%m-%d %H:%M:%S"), RowDimension(Paramvec2), ColumnDimension(Paramvec2)):
Paramvec2;
# [Diekmeyer2018_S678] Gl. 3.31 (rechts)
t_ges_minpar:=Transpose(Pb.Transpose(t_ges)):
u_ges_minpar:=Transpose(Pb.Transpose(u_ges)):
printf("%s. Dimension der Regressormatrix: %dx%d\n", \
  FormatTime("%Y-%m-%d %H:%M:%S"), RowDimension(t_ges_minpar), ColumnDimension(t_ges_minpar)):
# Symbolischer Test des Erfolgs der Parameterminimierung: Ist konstant bzw. Null.
# test_u := simplify2(u_ges_minpar.Paramvec2 - u_ges.PV2_vec(11..,..)):
# test_t := simplify2(t_ges_minpar.Paramvec2 - t_ges.PV2_vec(11..,..)):
# Code exportieren
save Paramvec2, sprintf("../codeexport/%s/tmp/minimal_parameter_vector_fixb_maple", robot_name):
save Paramvec2, sprintf("../codeexport/%s/tmp/minimal_parameter_vector_fixb_maple_linsolve", robot_name): # zum Testen gegen andere Implementierung
if codegen_act then
   MatlabExport(Paramvec2, sprintf("../codeexport/%s/tmp/minimal_parameter_vector_fixb_matlab.m", robot_name), codegen_opt):
end if;
save t_ges_minpar, sprintf("../codeexport/%s/tmp/energy_kinetic_fixb_regressor_minpar_maple.m", robot_name):
save u_ges_minpar, sprintf("../codeexport/%s/tmp/energy_potential_fixb_regressor_minpar_maple.m", robot_name):
if codegen_act then
  MatlabExport(convert_t_s(t_ges_minpar), sprintf("../codeexport/%s/tmp/energy_kinetic_fixb_regressor_minpar_matlab.m", robot_name), codegen_opt):
end if:
if codegen_act then
  MatlabExport(convert_t_s(u_ges_minpar), sprintf("../codeexport/%s/tmp/energy_potential_fixb_regressor_minpar_matlab.m", robot_name), codegen_opt):
end if:


da1 :=

[
    [   #(1) boon ((1)-(43) are from http://homepages.math.uic.edu/~jan/demo.html)
        [s1**2+g1**2 - 1,
         s2**2+g2**2 - 1,
         C1*g1**3+C2*g2**3 - 6/5,
         C1*s1**3+C2*s2**3 - 6/5,
         C1*g1**2*s1+C2*g2**2*s2 - 7/10,
         C1*g1*s1**2+C2*g2*s2**2 - 7/10
        ],
        [s1,s2,g1,g2,C1,C2]
    ],
    [   #(2) eco6
        [(x1 + x1*x2 + x2*x3 + x3*x4 + x4*x5)*x6 - 1,
        (x2 + x1*x3 + x2*x4 + x3*x5)*x6 - 2,
        (x3 + x1*x4 + x2*x5)*x6 - 3,
        (x4 + x1*x5)*x6 - 4,
        x5*x6 - 5,
        x1 + x2 + x3 + x4 + x5 + 1
        ],
        [x1,x2,x3,x4,x5,x6]
    ],
    [   #(3) mickey
        [ x**2 + 4*y**2 - 4,
        2*y**2 - x
        ],
        [x, y]
    ],
    [   #(4) s9_1
        [ -d2*g - 2*d1*h1,
 9*d2 + 4*b,
 -4*c*h1 - 2*d2*f - 3*d1*g,
 -7*c + 9*a - 8*f,
 -4*d1*f - 5*c*g - 6*h1 - 3*d2,
 -5*d1 - 6*c*f - 7*g + 9*b,
 9*d1 + 6*a - 5*b,
 9*c - 7*a + 8
        ],
        [a,b,c,d1,d2,f,g,h1]
    ],
    [   #(5) conform1
        [-9 - t2**2 - t3**2 - 3*t2**2*t3**2 + 8*t2*t3,
 -9 - t3**2 - t1**2 - 3*t3**2*t1**2 + 8*t3*t1,
 -9 - t1**2 - t2**2 - 3*t1**2*t2**2 + 8*t1*t2
        ],
        [t1, t2, t3]
    ],
    [   #(6) eco7
        [ (x1 + x1*x2 + x2*x3 + x3*x4 + x4*x5 + x5*x6)*x7 - 1,
 (x2 + x1*x3 + x2*x4 + x3*x5 + x4*x6)*x7 - 2,
 (x3 + x1*x4 + x2*x5 + x3*x6)*x7 - 3,
 (x4 + x1*x5 + x2*x6)*x7 - 4,
 (x5 + x1*x6)*x7 - 5,
 x6*x7 - 6,
 x1 + x2 + x3 + x4 + x5 + x6 + 1
        ],
        [x1,x2,x3,x4,x5,x6,x7]
    ],
    [   #(7) geneig
        [-10*x1*x6^2+ 2*x2*x6^2-x3*x6^2+x4*x6^2+ 3*x5*x6^2+x1*x6+ 2*x2*x6+x3*x6+ 2*x4*
x6+x5*x6+ 10*x1+ 2*x2-x3+ 2*x4-2*x5,
 2*x1*x6^2-11*x2*x6^2+ 2*x3*x6^2-2*x4*x6^2+x5*x6^2+ 2*x1*x6+x2*x6+ 2*x3*x6+x4*
x6+ 3*x5*x6+ 2*x1+ 9*x2+ 3*x3-x4-2*x5,
-x1*x6^2+ 2*x2*x6^2-12*x3*x6^2-x4*x6^2+x5*x6^2+x1*x6+ 2*x2*x6-2*x4*x6-2*x5*x6-
x1+ 3*x2+ 10*x3+ 2*x4-x5,
x1*x6^2-2*x2*x6^2-x3*x6^2-10*x4*x6^2+ 2*x5*x6^2+ 2*x1*x6+x2*x6-2*x3*x6+ 2*x4*
x6+ 3*x5*x6+ 2*x1-x2+ 2*x3+ 12*x4+x5,
 3*x1*x6^2+x2*x6^2+x3*x6^2+ 2*x4*x6^2-11*x5*x6^2+x1*x6+ 3*x2*x6-2*x3*x6+ 3*x4*
x6+ 3*x5*x6-2*x1-2*x2-x3+x4+ 10*x5,
x1+x2+x3+x4+x5-1
        ],
        [x1, x2, x3, x4, x5, x6]
    ],
    [   #(8) noon3
        [x1*x2^2 + x1*x3^2 - 11/10*x1 + 1,
x2*x1^2 + x2*x3^2 - 11/10*x2 + 1,
x3*x1^2 + x3*x2^2 - 11/10*x3 + 1
        ],
        [x1, x2, x3]
    ],
    [   #(9) redcyc5
        [ 1 + y1 + y2 + y3 + y4,
 y1 + y1*y2 + y2*y3 + y3*y4 + y4,
 y1*y2 + y1*y2*y3 + y2*y3*y4 + y3*y4 + y4*y1,
 y1*y2*y3 + y1*y2*y3*y4 + y2*y3*y4 + y3*y4*y1 + y4*y1*y2,
  z0**5*y1*y2*y3*y4  - 1
        ],
        [y1,y2,y3,y4,z0]
    ],
    [   #(10) sendra
        [ -270*x**4*y**3 - 314*x*y**4 - 689*x*y**3 + 1428,
36*x**7 + 417*x**6*y - 422*x**5*y**2 - 270*x**4*y**3 + 1428*x**3*y**4
- 1475*x**2*y**5 + 510*x*y**6 - 200*x**6 - 174*x**5*y - 966*x**4*y**2
+ 529*x**3*y**3 + 269*x**2*y**4 + 49*x*y**5 - 267*y**6 + 529*x**4*y
+ 1303*x**2*y**3 - 314*x*y**4 + 262*y**5 + 36*x**4 - 788*x**2*y**2
- 689*x*y**3 + 177*y**4
        ],
        [x,y]
    ],
    [   #(11) cpdm5
        [4*x1^3+ 3*x1^2*x2+ 3*x1^2*x3+ 3*x1^2*x4+ 3*x1^2*x5+ 3*x1*x2^2+ 3*x1*x3^2+ 3*
x1*x4^2+ 3*x1*x5^2+x2^3+x3^3+x4^3+x5^3+ 2*x1^2+ 3*x1*x2+ 3*x1*x3+ 3*x1*x4+ 3*
x1*x5-x2^2-x3^2-x4^2-x5^2-6*x1,
x1^3+ 3*x1^2*x2+ 3*x1*x2^2+ 4*x2^3+ 3*x2^2*x3+ 3*x2^2*x4+ 3*x2^2*x5+ 3*x2*
x3^2+ 3*x2*x4^2+ 3*x2*x5^2+x3^3+x4^3+x5^3-x1^2+ 3*x1*x2+ 2*x2^2+ 3*x2*x3+ 3*
x2*x4+ 3*x2*x5-x3^2-x4^2-x5^2-6*x2,
x1^3+ 3*x1^2*x3+ 3*x1*x3^2+x2^3+ 3*x2^2*x3+ 3*x2*x3^2+ 4*x3^3+ 3*x3^2*x4+ 3*
x3^2*x5+ 3*x3*x4^2+ 3*x3*x5^2+x4^3+x5^3-x1^2+ 3*x1*x3-x2^2+ 3*x2*x3+ 2*x3^2+
 3*x3*x4+ 3*x3*x5-x4^2-x5^2-6*x3,
x1^3+ 3*x1^2*x4+ 3*x1*x4^2+x2^3+ 3*x2^2*x4+ 3*x2*x4^2+x3^3+ 3*x3^2*x4+ 3*x3*
x4^2+ 4*x4^3+ 3*x4^2*x5+ 3*x4*x5^2+x5^3-x1^2+ 3*x1*x4-x2^2+ 3*x2*x4-x3^2+ 3*
x3*x4+ 2*x4^2+ 3*x4*x5-x5^2-6*x4,
x1^3+ 3*x1^2*x5+ 3*x1*x5^2+x2^3+ 3*x2^2*x5+ 3*x2*x5^2+x3^3+ 3*x3^2*x5+ 3*x3*
x5^2+x4^3+ 3*x4^2*x5+ 3*x4*x5^2+ 4*x5^3-x1^2+ 3*x1*x5-x2^2+ 3*x2*x5-x3^2+ 3*
x3*x5-x4^2+ 3*x4*x5+ 2*x5^2-6*x5
        ],
        [x1, x2, x3, x4, x5]
    ],
    [   #(12) eco8
        [ (x1 + x1*x2 + x2*x3 + x3*x4 + x4*x5 + x5*x6 + x6*x7)*x8 - 1,
         (x2 + x1*x3 + x2*x4 + x3*x5 + x4*x6 + x5*x7)*x8 - 2,
        (x3 + x1*x4 + x2*x5 + x3*x6 + x4*x7)*x8 - 3,
        (x4 + x1*x5 + x2*x6 + x3*x7)*x8 - 4,
        (x5 + x1*x6 + x2*x7)*x8 - 5,
        (x6 + x1*x7)*x8 - 6,
        x7*x8 - 7,
        x1 + x2 + x3 + x4 + x5 + x6 + x7 + 1
        ],
        [x1,x2,x3,x4,x5,x6,x7,x8]
    ],
    [   #(13) noon4
        [x1*x2^2 + x1*x3^2 + x1*x4^2 - 11/10*x1 + 1,
x2*x1^2 + x2*x3^2 + x2*x4^2 - 11/10*x2 + 1,
x3*x1^2 + x3*x2^2 + x3*x4^2 - 11/10*x3 + 1,
x4*x1^2 + x4*x2^2 + x4*x3^2 - 11/10*x4 + 1
        ],
        [x1,x2,x3,x4]
    ],
    [   #(14) redcyc6
        [1 + y1 + y2 + y3 + y4 + y5,
 y1 + y1*y2 + y2*y3 + y3*y4 + y4*y5 + y5,
 y1*y2 + y1*y2*y3 + y2*y3*y4 + y3*y4*y5 + y4*y5 + y5*y1,
 y1*y2*y3 + y1*y2*y3*y4 + y2*y3*y4*y5 + y3*y4*y5 + y4*y5*y1 + y5*y1*y2,
 y1*y2*y3*y4 + y1*y2*y3*y4*y5 + y2*y3*y4*y5 + y3*y4*y5*y1
 + y4*y5*y1*y2 + y5*y1*y2*y3,
 z0**6*y1*y2*y3*y4*y5 - 1
        ],
        [y1,y2,y3,y4,y5,z0]
    ],
    [   #(15) solotarev
        [ 3*x**2-2*x-a,
 x**3-x**2-x*a+a-2*b-2,
 3*y**2-2*y-a,
 y**3-y**2-y*a-a+2
        ],
        [x,y,a,b]
    ],
    [   #(16) noon5
        [x1*x2^2 + x1*x3^2 + x1*x4^2 + x1*x5^2 - 11/10*x1 + 1,
x2*x1^2 + x2*x3^2 + x2*x4^2 + x2*x5^2 - 11/10*x2 + 1,
x3*x1^2 + x3*x2^2 + x3*x4^2 + x3*x5^2 - 11/10*x3 + 1,
x4*x1^2 + x4*x2^2 + x4*x3^2 + x4*x5^2 - 11/10*x4 + 1,
x5*x1^2 + x5*x2^2 + x5*x3^2 + x5*x4^2 - 11/10*x5 + 1
        ],
        [x1,x2,x3,x4,x5]
    ],
    [   #(17) redcyc7
        [ 1 + y1 + y2 + y3 + y4 + y5 + y6,
 y1 + y1*y2 + y2*y3 + y3*y4 + y4*y5 + y5*y6 + y6,
 y1*y2 + y1*y2*y3 + y2*y3*y4 + y3*y4*y5 + y4*y5*y6 + y5*y6 + y6*y1,
 y1*y2*y3 + y1*y2*y3*y4 + y2*y3*y4*y5 + y3*y4*y5*y6 + y4*y5*y6
+ y5*y6*y1 + y6*y1*y2,
 y1*y2*y3*y4 + y1*y2*y3*y4*y5 + y2*y3*y4*y5*y6 + y3*y4*y5*y6
+ y4*y5*y6*y1 + y5*y6*y1*y2 + y6*y1*y2*y3,
 y1*y2*y3*y4*y5 + y1*y2*y3*y4*y5*y6 + y2*y3*y4*y5*y6 + y3*y4*y5*y6*y1
+ y4*y5*y6*y1*y2 + y5*y6*y1*y2*y3 + y6*y1*y2*y3*y4,
 z0**7*y1*y2*y3*y4*y5*y6 - 1
        ],
        [y1,y2,y3,y4,y5,y6,z0]
    ],
    [   #(18) sparse5
        [x1**2*x2**2*x3**2*x4**2*x5**2
    + 3*x1**2 + x2**2 + x3**2 + x4**2 + x5**2 + x1*x2*x3*x4*x5 + 5,
 x1**2*x2**2*x3**2*x4**2*x5**2
    + x1**2 + 3*x2**2 + x3**2 + x4**2 + x5**2 + x1*x2*x3*x4*x5 + 5,
 x1**2*x2**2*x3**2*x4**2*x5**2
    + x1**2 + x2**2 + 3*x3**2 + x4**2 + x5**2 + x1*x2*x3*x4*x5 + 5,
 x1**2*x2**2*x3**2*x4**2*x5**2
    + x1**2 + x2**2 + x3**2 + 3*x4**2 + x5**2 + x1*x2*x3*x4*x5 + 5,
 x1**2*x2**2*x3**2*x4**2*x5**2
    + x1**2 + x2**2 + x3**2 + x4**2 + 3*x5**2 + x1*x2*x3*x4*x5 + 5
        ],
        [x1,x2,x3,x4,x5]
    ],
    [   #(19) cyclic6
        [z0 + z1 + z2 + z3 + z4 + z5,
 z0*z1 + z1*z2 + z2*z3 + z3*z4 + z4*z5 + z5*z0,
 z0*z1*z2 + z1*z2*z3 + z2*z3*z4 + z3*z4*z5 + z4*z5*z0 + z5*z0*z1,
 z0*z1*z2*z3 + z1*z2*z3*z4 + z2*z3*z4*z5 + z3*z4*z5*z0 + z4*z5*z0*z1
 + z5*z0*z1*z2,
 z0*z1*z2*z3*z4 + z1*z2*z3*z4*z5 + z2*z3*z4*z5*z0 + z3*z4*z5*z0*z1
 + z4*z5*z0*z1*z2 + z5*z0*z1*z2*z3,
 z0*z1*z2*z3*z4*z5 - 1
        ],
        [z0,z1,z2,z3,z4,z5]
    ],
    [   #(20) extcyc6
        [ z0 + z1 + z2 + z3 + z4 + z5 - 1,
 z0*z1 + z1*z2 + z2*z3 + z3*z4 + z4*z5 + z5*z0 - 1,
 z0*z1*z2 + z1*z2*z3 + z2*z3*z4 + z3*z4*z5 + z4*z5*z0 + z5*z0*z1 - 1,
 z0*z1*z2*z3 + z1*z2*z3*z4 + z2*z3*z4*z5 + z3*z4*z5*z0 + z4*z5*z0*z1
 + z5*z0*z1*z2 - 1,
 z0*z1*z2*z3*z4 + z1*z2*z3*z4*z5 + z2*z3*z4*z5*z0 + z3*z4*z5*z0*z1
 + z4*z5*z0*z1*z2 + z5*z0*z1*z2*z3 - 1 ,
 z0*z1*z2*z3*z4*z5 - 1
        ],
        [z0,z1,z2,z3,z4,z5]
    ],
    [   #(21) cyclic7
        [z0 + z1 + z2 + z3 + z4 + z5 + z6,
 z0*z1 + z1*z2 + z2*z3 + z3*z4 + z4*z5 + z5*z6 + z6*z0,
 z0*z1*z2 + z1*z2*z3 + z2*z3*z4 + z3*z4*z5 + z4*z5*z6 + z5*z6*z0 + z6*z0*z1,
 z0*z1*z2*z3 + z1*z2*z3*z4 + z2*z3*z4*z5 + z3*z4*z5*z6 + z4*z5*z6*z0
+ z5*z6*z0*z1 + z6*z0*z1*z2,
 z0*z1*z2*z3*z4 + z1*z2*z3*z4*z5 + z2*z3*z4*z5*z6 + z3*z4*z5*z6*z0
+ z4*z5*z6*z0*z1 + z5*z6*z0*z1*z2 + z6*z0*z1*z2*z3,
 z0*z1*z2*z3*z4*z5 + z1*z2*z3*z4*z5*z6 + z2*z3*z4*z5*z6*z0 + z3*z4*z5*z6*z0*z1
+ z4*z5*z6*z0*z1*z2 + z5*z6*z0*z1*z2*z3 + z6*z0*z1*z2*z3*z4,
 z0*z1*z2*z3*z4*z5*z6 - 1
        ],
        [z0,z1,z2,z3,z4,z5,z6]
    ],
    [   #(22) puma
        [ x1^2 + x2^2 - 1,
 x3^2 + x4^2 - 1,
 x5^2 + x6^2 - 1,
 x7^2 + x8^2 - 1,
 0004731/1000000*x1*x3 - 03578/10000*x2*x3 - 01238/10000*x1 - 0001637/1000000*x2 - 09338/10000*x4 + x7
- 03571/10000,
 02238/10000*x1*x3 + 07623/10000*x2*x3 + 02638/10000*x1 - 007745/100000*x2 -06734/10000*x4 -06022/10000,
 x6*x8 + 03578/10000*x1 + 0004731/1000000*x2,
 -07623/10000*x1 + 02238/10000*x2 + 03461/10000
        ],
        [x1,x2,x3,x4,x5,x6,x7,x8]
    ],
    [   #(23) redeco5
        [ x1 + x1*x2 + x2*x3 + x3*x4 - u5,
         x2 + x1*x3 + x2*x4 - 2*u5,
         x3 + x1*x4 - 3*u5,
         x4 - 4*u5,
         x1 + x2 + x3 + x4 + 1
        ],
        [x1,x2,x3,x4,u5]
    ],
    [   #(24) trink
        [ 45*y + 35*u - 165*v - 36,
 35*y + 25*z + 40*t - 27*u,
 25*y*u - 165*v**2 + 15*x - 18*z + 30*t,
 15*y*z + 20*t*u - 9*x,
 -11*v**3 + x*y + 2*z*t,
 -11*u*v + 3*v**2 + 99*x
        ],
        [x,y,z,u,v,t]
    ],
    [   #(25) cassou
        [ 15*b**4*c*d1**2 + 6*b**4*c**3 + 21*b**4*c**2*d1 - 144*b**2*c
 - 8*b**2*c**2*d2
 - 28*b**2*c*d1*d2 - 648*b**2*d1 + 36*b**2*d1**2*d2 + 9*b**4*d1**3 - 120,
 30*c**3*b**4*d1 - 32*d1*d2**2*c - 720*d1*b**2*c - 24*c**3*b**2*d2
 - 432*c**2*b**2 + 576*d2*c - 576*d1*d2 + 16*c*b**2*d1**2*d2
 + 16*d1**2*d2**2 + 16*d2**2*c**2 + 9*c**4*b**4 + 5184
 + 39*d1**2*b**4*c**2 + 18*d1**3*b**4*c - 432*d1**2*b**2
 + 24*d1**3*b**2*d2 - 16*c**2*b**2*d1*d2 - 240*c,
 216*d1*b**2*c - 162*d1**2*b**2 - 81*c**2*b**2 + 5184 + 1008*d2*c
 - 1008*d1*d2
 + 15*c**2*b**2*d1*d2 - 15*c**3*b**2*d2 - 80*d1*d2**2*c + 40*d1**2*d2**2
 + 40*d2**2*c**2,
 261 + 4*d1*b**2*c - 3*d1**2*b**2 - 4*c**2*b**2 + 22*d2*c - 22*d1*d2
        ],
        [b,c,d1,d2]
    ],
    [   #(26) katsura5
        [2*x**2+2*y**2+2*z**2+2*t**2+2*u**2+v**2-v,
 x*y+y*z+2*z*t+2*t*u+2*u*v-u,
 2*x*z+2*y*t+2*z*u+u**2+2*t*v-t,
 2*x*t+2*y*u+2*t*u+2*z*v-z,
 t**2+2*x*v+2*y*v+2*z*v-y,
 2*x+2*y+2*z+2*t+2*u+v-1
        ],
        [x,y,z,u,v,t]
    ],
    [   #(27) quadfor2
        [ w1 + w2 - 1,
 w1*x1 + w2*x2,
 w1*x1**2 + w2*x2**2 - 2/3,
 w1*x1**3 + w2*x2**3
        ],
        [w1,w2,x1,x2]
    ],
    [   #(28) redeco6
        [ x1 + x1*x2 + x2*x3 + x3*x4 + x4*x5 -   u6,
        x2 + x1*x3 + x2*x4 + x3*x5 - 2*u6,
        x3 + x1*x4 + x2*x5 - 3*u6,
        x4 + x1*x5 - 4*u6,
        x5 - 5*u6,
        x1 + x2 + x3 + x4 + x5 + 1
        ],
        [x1,x2,x3,x4,x5,u6]
    ],
    [   #(29) virasoro
        [8*x1^2+ 8*x1*x2+ 8*x1*x3+ 2*x1*x4+ 2*x1*x5+ 2*x1*x6+ 2*x1*x7-8*x2*x3-2*x4*x7
-2*x5*x6-x1,
 8*x1*x2-8*x1*x3+ 8*x2^2+ 8*x2*x3+ 2*x2*x4+ 2*x2*x5+ 2*x2*x6+ 2*x2*x7-2*x4*x6
-2*x5*x7-x2,
-8*x1*x2+ 8*x1*x3+ 8*x2*x3+ 8*x3^2+ 2*x3*x4+ 2*x3*x5+ 2*x3*x6+ 2*x3*x7-2*x4*
x5-2*x6*x7-x3,
 2*x1*x4-2*x1*x7+ 2*x2*x4-2*x2*x6+ 2*x3*x4-2*x3*x5+ 8*x4^2+ 8*x4*x5+ 2*x4*x6+
 2*x4*x7+ 6*x4*x8-6*x5*x8-x4,
 2*x1*x5-2*x1*x6+ 2*x2*x5-2*x2*x7-2*x3*x4+ 2*x3*x5+ 8*x4*x5-6*x4*x8+ 8*x5^2+
 2*x5*x6+ 2*x5*x7+ 6*x5*x8-x5,
-2*x1*x5+ 2*x1*x6-2*x2*x4+ 2*x2*x6+ 2*x3*x6-2*x3*x7+ 2*x4*x6+ 2*x5*x6+ 8*x6^2
+ 8*x6*x7+ 6*x6*x8-6*x7*x8-x6,
-2*x1*x4+ 2*x1*x7-2*x2*x5+ 2*x2*x7-2*x3*x6+ 2*x3*x7+ 2*x4*x7+ 2*x5*x7+ 8*x6*
x7-6*x6*x8+ 8*x7^2+ 6*x7*x8-x7,
-6*x4*x5+ 6*x4*x8+ 6*x5*x8-6*x6*x7+ 6*x6*x8+ 6*x7*x8+ 8*x8^2-x8
        ],
        [x1,x2,x3,x4,x5,x6,x7,x8]
    ],
    [   #(30) d1
        [ x1**2  + x2**2 - 1,
 x3**2  + x4**2 - 1,
 x5**2  + x6**2 - 1,
 x7**2  + x8**2 - 1,
 x9**2  + x10**2 - 1,
 x11**2 + x12**2 - 1,
 3*x3 + 2*x5 + x7 - 39701/10000,
 3*x1*x4 + 2*x1*x6 + x1*x8 - 17172/10000,
 3*x2*x4 + 2*x2*x6 + x2*x8 - 40616/10000,
 x3*x9 + x5*x9 + x7*x9 - 19791/10000,
 x2*x4*x9 + x2*x6*x9 + x2*x8*x9 + x1*x10 - 19115/10000,
 - x3*x10*x11 - x5*x10*x11 - x7*x10*x11 + x4*x12 + x6*x12 + x8*x12 - 04077/10000
        ],
        [x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12]
    ],
    [   #(31) kin1
        [ s1**2 + c1**2 - 1,
 s2**2 + c2**2 - 1,
 s3**2 + c3**2 - 1,
 s4**2 + c4**2 - 1,
 s5**2 + c5**2 - 1,
 s6**2 + c6**2 - 1,
 s2*c5*s6 - s3*c5*s6 - s4*c5*s6 + c2*c6 + c3*c6 + c4*c6 - 04077/10000,
 c1*c2*s5 + c1*c3*s5 + c1*c4*s5 + s1*c5 - 19115/10000,
 s2*s5 + s3*s5 + s4*s5 - 19791/10000,
 c1*c2 + c1*c3 + c1*c4 + c1*c2 + c1*c3 + c1*c2 - 40616/10000,
 s1*c2 + s1*c3 + s1*c4 + s1*c2 + s1*c3 + s1*c2 - 17172/10000,
 s2 + s3 + s4 + s2 + s3 + s2 - 39701/10000
        ],
        [s1,c1,s2,c2,s3,c3,s4,c4,s5,c5,s6,c6]
    ],
    [   #(32) redeco7
        [ x1 + x1*x2 + x2*x3 + x3*x4 + x4*x5 + x5*x6 -   u7,
        x2 + x1*x3 + x2*x4 + x3*x5 + x4*x6 - 2*u7,
        x3 + x1*x4 + x2*x5 + x3*x6 - 3*u7,
        x4 + x1*x5 + x2*x6 - 4*u7,
        x5 + x1*x6 - 5*u7,
        x6 - 6*u7,
        x1 + x2 + x3 + x4 + x5 + x6 + 1
        ],
        [x1,x2,x3,x4,x5,x6,u7]
    ],
    [   #(33) des18_3
        [6*a33*a10*a20 + 10*a22*a10*a31 + 8*a32*a10*a21 - 162*a10**2*a21
+ 16*a21*a30 + 14*a31*a20 + 48*a10*a30,
15*a33*a10*a21 - 162*a10**2*a22 - 312*a10*a20 + 24*a10*a30 + 27*a31*a21
+ 24*a32*a20 + 18*a22*a10*a32 + 30*a22*a30 + 84*a31*a10,
-240*a10 + 420*a33 - 64*a22 + 112*a32,
180*a33*a10 - 284*a22*a10 - 162*a10**2 + 60*a22*a32 + 50*a32*a10 + 70*a30
+ 55*a33*a21 + 260*a31 - 112*a20,
66*a33*a10 + 336*a32 + 90*a31 + 78*a22*a33 - 1056*a10 - 90*a21,
136*a33 - 136,
4*a22*a10*a30 + 2*a32*a10*a20 + 6*a20*a30 - 162*a10**2*a20 + 3*a31*a21*a10,
28*a22*a10*a33 + 192*a30 + 128*a32*a10 + 36*a31*a20 + 36*a33*a20 - 300*a10*a21 + 40*a32*a21 - 648*a10**2 + 44*a22*a31
        ],
        [a10,a20,a21,a22,a30,a31,a32,a33]
    ],
    [   #(34) kinema
        [z1**2 + z2**2 + z3**2 - 12*z1 - 68,
 z4**2 + z5**2 + z6**2 - 12*z5 - 68,
 z7**2 + z8**2 + z9**2 - 24*z8 - 12*z9 + 100,
 z1*z4 + z2*z5 + z3*z6 - 6*z1 - 6*z5 - 52,
 z1*z7 + z2*z8 + z3*z9 - 6*z1 - 12*z8 - 6*z9 + 64,
 z4*z7 + z5*z8 + z6*z9 - 6*z5 - 12*z8 - 6*z9 + 32,
 2*z2 + 2*z3 - z4 - z5 - 2*z6 - z7 - z9 + 18,
 z1 + z2 + 2*z3 + 2*z4 + 2*z6 - 2*z7 + z8 - z9 - 38,
 z1 + z3 - 2*z4 + z5 - z6 + 2*z7 - 2*z8 + 8
        ],
        [z1,z2,z3,z4,z5,z6,z7,z8,z9]
    ],
    [   #(35) rabmo
        [x1      + x3      + x5        + 2*x7                  - 1,
 x1*x2   + x3*x4   + 2*x5*x6   + 2*x7*x8   + 2*x7*x9   - 2/3,
 x1*x2^2 + x3*x4^2 + 2*x5*x6^2 + 2*x7*x8^2 + 2*x7*x9^2 - 2/5,
 x1*x2^3 + x3*x4^3 + 2*x5*x6^3 + 2*x7*x8^3 + 2*x7*x9^3 - 2/7,
 x1*x2^4 + x3*x4^4 + 2*x5*x6^4 + 2*x7*x8^4 + 2*x7*x9^4 - 2/9,
 x5*x6^2 + 2*x7*x8*x9     - 1/9,
 x5*x6^4 + 2*x7*x8^2*x9^2 - 1/25,
 x5*x6^3 + x7*x8*x9^2 + x7*x8^2*x9 - 1/15,
 x5*x6^4 + x7*x8*x9^3 + x7*x8^3*x9 - 1/21
        ],
        [x1,x2,x3,x4,x5,x6,x7,x8,x9]
    ],
    [   #(36) redeco8
        [ x1 + x1*x2 + x2*x3 + x3*x4 + x4*x5 + x5*x6 + x6*x7 - 1*u8,
        x2 + x1*x3 + x2*x4 + x3*x5 + x4*x6 + x5*x7 - 2*u8,
        x3 + x1*x4 + x2*x5 + x3*x6 + x4*x7 - 3*u8,
        x4 + x1*x5 + x2*x6 + x3*x7 - 4*u8,
        x5 + x1*x6 + x2*x7 - 5*u8,
        x6 + x1*x7 - 6*u8,
        x7 - 7*u8,
        x1 + x2 + x3 + x4 + x5 + x6 + x7 + 1
        ],
        [x1,x2,x3,x4,x5,x6,x7,u8]
    ],
    [   #(37) wright
        [x1^2-x1+x2+x3+x4+x5-10,
x2^2+x1-x2+x3+x4+x5-10,
x3^2+x1+x2-x3+x4+x5-10,
x4^2+x1+x2+x3-x4+x5-10,
x5^2+x1+x2+x3+x4-x5-10
        ],
        [x1,x2,x3,x4,x5]
    ],
    [   #(38) des22_24
        [ 16*a20*a32 + 18*a21*a31 + 20*a22*a30,
-80*a23 + 180*a34 + 855*a35,
 7*a20*a31 + 8*a21*a30,
 210*a35 - 210,
 40*a20*a34 + 44*a21*a33 + 48*a22*a32 + 52*a23*a31 + 280*a30,
 27*a20*a33 + 30*a21*a32 + 33*a22*a31 + 36*a23*a30,
 55*a20*a35 + 60*a21*a34 + 65*a22*a33 + 70*a23*a32 + 80*a30 + 375*a31,
 78*a21*a35 + 84*a22*a34 + 90*a23*a33 - 170*a20 + 102*a31 + 480*a32,
136*a23*a35 - 114*a22 + 152*a33 + 720*a34,
105*a22*a35 + 112*a23*a34 - 144*a21 + 126*a32 + 595*a33
        ],
        [a20,a21,a22,a23,a30,a31,a32,a33,a34,a35]
    ],
    [   #(39) ku10
        [ 5*x1*x2+ 5*x1+ 3*x2+ 55,
 7*x2*x3+ 9*x2+ 9*x3+ 19,
 3*x3*x4+ 6*x3+ 5*x4-4,
 6*x4*x5+ 6*x4+ 7*x5+ 118,
x5*x6+ 3*x5+ 9*x6+ 27,
 6*x6*x7+ 7*x6+x7+ 72,
 9*x7*x8+ 7*x7+x8+ 35,
 4*x8*x9+ 4*x8+ 6*x9+ 16,
 8*x9*x10+ 4*x9+ 3*x10-51,
 3*x1*x10-6*x1+x10+ 5
        ],
        [x1,x2,x3,x4,x5,x6,x7,x8,x9,x10]
    ],
    [   #(40) lorentz
        [x1*x2-x1*x3-x4+ 1,
x2*x3-x2*x4-x1+ 1,
-x1*x3+x3*x4-x2+ 1,
x1*x4-x2*x4-x3+ 1
        ],
        [x1,x2,x3,x4]
    ],
    [   #(41) rbpl24
        [62500*x1^2 + 62500*y1^2 + 62500*z1^2 -74529,
625*x2^2 + 625*y2^2 + 625*z2^2 -1250*x2 -2624,
12500*x3^2 + 12500*y3^2 + 12500*z3^2 + 2500*x3 -44975*y3 -10982,
400000*x1*x2 + 400000*y1*y2 + 400000*z1*z2 -400000*x2 + 178837,
1000000*x1*x3 + 1000000*y1*y3 + 1000000*z1*z3 + 100000*x3 -1799000*y3 -805427,
2000000*x2*x3 + 2000000*y2*y3 + 2000000*z2*z3 -2000000*x2 + 200000*x3
-3598000*y3 -1403,
 113800000000000*x3*y2*z1
-113800000000000*x2*y3*z1 -113800000000000*x3*y1*z2 +
113800000000000*x1*y3*z2 + 113800000000000*x2*y1*z3
-113800000000000*x1*y2*z3 -206888400000000*x2*y1 +
206888400000000*x3*y1 + 206888400000000*x1*y2 -206888400000000*x3*y2
-206888400000000*x1*y3 + 206888400000000*x2*y3 -2014260000000*x2*z1 +
2014260000000*x3*z1 -61907200000000*y2*z1 + 61907200000000*y3*z1 +
2014260000000*x1*z2 -2014260000000*x3*z2 + 61907200000000*y1*z2
-61907200000000*y3*z2 -2014260000000*x1*z3 + 2014260000000*x2*z3
-61907200000000*y1*z3 + 61907200000000*y2*z3 -362960716800000*x1 +
38025201600000*x2 + 292548849600000*x3 + 11809567440000*y1 +
1475978220000*y2 -825269402280000*y3 -1212982689600000*z1
-151600474800000*z2 + 825859951200000*z3 -19295432410527,
 -777600000000*x3*y2*z1 + 777600000000*x2*y3*z1 +
777600000000*x3*y1*z2 -777600000000*x1*y3*z2 -777600000000*x2*y1*z3 +
777600000000*x1*y2*z3 -1409011200000*x2*y1 + 1409011200000*x3*y1 +
1409011200000*x1*y2 -1409011200000*x3*y2 -1409011200000*x1*y3 +
1409011200000*x2*y3 -1065312000000*x2*z1 + 1065312000000*x3*z1
-805593600000*y2*z1 + 805593600000*y3*z1 + 1065312000000*x1*z2
-1065312000000*x3*z2 + 805593600000*y1*z2 -805593600000*y3*z2
-1065312000000*x1*z3 + 1065312000000*x2*z3 -805593600000*y1*z3 +
805593600000*y2*z3 + 235685027200*x1 + 398417510400*x2 +
158626915200*x3 -311668424000*y1 -268090368000*y2 + 72704002800*y3 +
412221302400*z1 + 354583756800*z2 + 307085438400*z3 + 282499646407,
3200*x2 + 1271
        ],
        [x1,y1,z1,x2,y2,z2,x3,y3,z3]
    ],
    [   #(42) reimer5
        [-1 + 2*x**2 - 2*y**2 + 2*z**2 - 2*t**2 + 2*u**2,
-1 + 2*x**3 - 2*y**3 + 2*z**3 - 2*t**3 + 2*u**3,
-1 + 2*x**4 - 2*y**4 + 2*z**4 - 2*t**4 + 2*u**4,
-1 + 2*x**5 - 2*y**5 + 2*z**5 - 2*t**5 + 2*u**5,
-1 + 2*x**6 - 2*y**6 + 2*z**6 - 2*t**6 + 2*u**6
        ],
        [x,y,z,t,u]
    ],
    [   #(43) eco5
        [ (x1 + x1*x2 + x2*x3 + x3*x4)*x5 - 1,
        (x2 + x1*x3 + x2*x4)*x5 - 2,
        (x3 + x1*x4)*x5 - 3,
        x4*x5 - 4,
        x1 + x2 + x3 + x4 + 1
        ],
        [x1,x2,x3,x4,x5]
    ]
]:


###############################################################################
# Part 1: Algorithms for computation with subfields of rational functions
###############################################################################

with(PolynomialIdeals):
#------------------------------------------------------------------------------

IdealsEq := proc(A, B)
    # Checks whether polynomial ideals are equal
    return evalb((A subset B) and (B subset A)):
end:

#------------------------------------------------------------------------------

FieldToIdeal := proc(gens)
    # Input: generators of a subfield of the field of rational functions
    # Computes the MQS ideal of the field with the new variables of the form x_aux
    # See: https://mediatum.ub.tum.de/doc/685465/document.pdf Definition 2.16
    #      https://doi.org/10.1016/j.jsc.2005.09.010          Lemma 2.1
    local all_vars, subs_dupl, all_dupl, common_denom, polys, f, gb:
    all_vars := indets(gens):
    subs_dupl := map(v -> v = cat(v, _aux), all_vars):
    all_dupl := map(v -> subs(subs_dupl, v), all_vars):
    common_denom := 1:
    polys := []:
    for f in gens do
        common_denom := lcm(common_denom, denom(f)):
        polys := [op(polys), numer(f) * subs(subs_dupl, denom(f)) - subs(subs_dupl, numer(f)) * denom(f)]:
    end do:
    #gb := Groebner[Basis]([op(polys), common_denom * t - 1], plex(t, op(all_dupl))):

    gb := Groebner[Basis]([op(polys), common_denom * t - 1], tdeg(t, op(all_dupl))):
    gb := Groebner[Walk](gb, tdeg(t, op(all_dupl)), lexdeg([t], [op(all_dupl)])):

    gb := select(p -> not (t in indets(p)), gb):
    return PolynomialIdeal(gb, variables=all_dupl):
end proc:

#------------------------------------------------------------------------------

FieldCoefficientRestriction := proc(J, msq_for_subfield)
    # Input: J - a polynomial ideals over a field of rational functions
    #        msq_for_subfield - the MQS ideal for a subfield E of coefficients (see FieldToIdeal)
    # Computes the radical of the restriction of the ideal to the subfield E
    # in the sense of https://doi.org/10.1016/j.jsc.2005.09.010 (MSQ-paper in what follows)
    #
    # NOTE: unlike the algorithm in the MQS-paper, we compute the radical, not the restriction itself
    # one can obtain the algorithm MQS-paper by replacing PrimeDecomposition with PrimaryDecomposition
    # in the code below
    local poly_vars, coeff_vars, subs_aux, coeff_aux, gens, subs_aux_msq, gens_msq, msq_ideal_aux,
    msq_components, J_ext, components, primes_to_keep, P, elim_P, comp, cleaned_ideal:

    poly_vars := IdealInfo[Variables](J):
    coeff_vars := IdealInfo[Parameters](J) union IdealInfo[Parameters](msq_for_subfield):
    subs_aux := map(v -> v = parse(cat(v, _aux_aux)), coeff_vars):
    coeff_aux := subs(subs_aux, coeff_vars):

    # list F of polynomials in the notation of the MSQ-paper, page 375
    gens := map(p -> subs(subs_aux, p * denom(p)), IdealInfo[Generators](J)):

    # Substitution to avoid names clashing between the aux variables in the msq ideal and the variables in J
    subs_aux_msq := map(v -> v = parse(cat(v, _aux)), IdealInfo[Variables](msq_for_subfield)):
    gens_msq := map(p -> subs(subs_aux_msq, p), IdealInfo[Generators](msq_for_subfield)):
    msq_ideal_aux := PolynomialIdeal(gens_msq, variables=map(s -> rhs(s), subs_aux_msq)):
    msq_components := [PrimeDecomposition(msq_ideal_aux)]:

    J_ext := PolynomialIdeal([op(gens), op(gens_msq)], variables=poly_vars union coeff_aux):
    components := [PrimeDecomposition(J_ext)]:

    # Selecting prime components as in Remark on page 377 in MSQ-paper
    primes_to_keep := []:
    for P in components do
        # Going through the prime decomposition of the MSQ-deal mimics the
        # working over the restricted field (which is what has been done in the MSQ-paper)
        elim_P := EliminationIdeal(P, coeff_aux):
        for comp in msq_components do
            if elim_P subset comp then
                primes_to_keep := [op(primes_to_keep), P]:
            end if:
        end do:
    end do:
    if nops(primes_to_keep) > 0 then
        cleaned_ideal := Intersect(op(primes_to_keep)):
    else
        cleaned_ideal := PolynomialIdeal([0], variables = poly_vars):
    end if:

    # Applying Lemma 2.2 from the MSQ-paper
    return EliminationIdeal(cleaned_ideal, poly_vars):
end proc:

#------------------------------------------------------------------------------

FilterGenerators := proc(ideal)
    # Input: ideal over a rational function field
    # Computes a simplified set of generators of the field of definition
    local gb, gens, p, cf, lc, gsorted, result, big_ideal, cur_ideal, g, new_ideal:
    gb := Groebner[Basis](ideal, tdeg(op(IdealInfo[Variables](ideal)))):
    gens := {}:
    for p in gb do
        cf := sort([coeffs(p, IdealInfo[Variables](ideal))], (a, b) -> length(convert(a, string)) < length(convert(b, string))):
        lc := cf[1]:
        cf := map(c -> c / lc, cf):
        gens := {op(gens), op(cf[2..nops(cf)])}:
    end do:
    gsorted := sort([op(gens)], (a, b) -> length(convert(a, string)) < length(convert(b, string)));
    result := {}:
    big_ideal := FieldToIdeal(gens):
    cur_ideal := FieldToIdeal(result):
    for g in gsorted do
        if big_ideal = cur_ideal then
            return result:
        end if:
        new_ideal := FieldToIdeal({op(result), g}):
        if new_ideal <> cur_ideal then
        	  # a dirty hack to transform -1/a to a
            if convert(g, string)[1] = "-" then
                g := -g:
            end:
            if convert(g, string)[1] = "1" then
                g := 1 / g:
            end:
            result := {op(result), g}:
            cur_ideal := new_ideal:
        end if:
    end do:
    return result:
end proc:

#------------------------------------------------------------------------------

FieldIntersection := proc(gens_left, gens_right)
    # Input: gens_left and gens_right - generators of a subfields E and F of a field of rational functions
    # If terminates, resturns an ideal with field of definition being the intersection of generators of E and F
    # Is guaranteed to terminate if at least one of E and F is algebraically closed in rational functions (see REF)
    # Implementation below is a version of Algorithm 2.38 from https://mediatum.ub.tum.de/doc/685465/document.pdf
    local msq_left, msq_right, poly_vars, coeff_vars, Ii, Ji, gb, result, p, cf, lc;

    msq_left := FieldToIdeal(gens_left):
    msq_right := FieldToIdeal(gens_right):
    poly_vars := IdealInfo[Variables](msq_left) union IdealInfo[Variables](msq_right):
    coeff_vars := IdealInfo[Parameters](msq_left) union IdealInfo[Parameters](msq_right):

    Ii := PolynomialIdeal([1], variables=poly_vars):
    Ji := msq_left:

    while not IdealsEq(Ii, Ji) do
        Ii := FieldCoefficientRestriction(Ji, msq_right):
        Ji := FieldCoefficientRestriction(Ii, msq_left):
    end do:

    return Ji:
end proc:

#------------------------------------------------------------------------------

CompareFields := proc(gens_l, gens_r)
    # Checks whether gens_l and gens_r generate the same subfield of rational functions
    return IdealsEq(FieldToIdeal(gens_l), FieldToIdeal(gens_r)):
end proc:

#------------------------------------------------------------------------------

###############################################################################
# Part 2: Algorithm for computing  identifiable functions
###############################################################################

with(DifferentialAlgebra):

#===============================================================================

ExtractDenominator := proc(model)
    # Input: model a list of rational functions
    # returns the function multiplied by their denominators and
    # an inequality corresponding to the LCM of the denominators
    local common_denom, r;
    common_denom := 1:
    for r in model do
        common_denom := lcm(common_denom, denom(r)):
    end do:
    return [op(map(p -> denom(p) * p, model)), common_denom <> 0]:
end proc:

#===============================================================================
CheckReducibilitySet := proc(polys, charset)
    # Input: polys - list of differential polynomials
    #        charset - a characteristic set
    # Returns true iff all the polynomials are reduced to zero wrt to the charset
    local result, e:
    result := true:
    for e in polys do
        if NormalForm(e, charset) <> 0 then
            result := false:
            break:
        end if:
    end do:
    return result:
end proc:
#===============================================================================

GetIOEquations := proc(model, states, inputs, outputs, params, use_brackets, infolevel, target)
    # Input: model - list of differential polynomials defining the model
    #        states, ios, params - list of names of state variables, input-output variables
    #                              and parameter, respectively
    # Computes a list of input-output equations of the model
    local Relim, Rorig, charsets, chset_orig, general_comps, general, c, e, gen_comp, io_eqs:
    Relim := DifferentialRing(blocks = [[op(states)], [op(outputs)], [op(inputs)]], derivations = [t], arbitrary = params):
    if not use_brackets then
        Relim := DifferentialRing(blocks = [[op(states)], op(outputs), [op(inputs)]], derivations = [t], arbitrary = params):
    end if:
    Rorig := DifferentialRing(blocks = [[op(outputs)], [op(states)], [op(inputs)]], derivations = [t], arbitrary = params):
           # DifferentialRing(blocks = [[op(inputs)], [op(outputs)], [op(states)]], derivations = [t], arbitrary = params):
    chset_orig := RosenfeldGroebner(model, Rorig)[1]:

    if infolevel > 0 then
        LogText(sprintf("    Computing the characteristic set (singsol = none)\n"), target):
    end if:
    charsets := RosenfeldGroebner(model, Relim, singsol = none):
    if CheckReducibilitySet(Equations(charsets[1]), chset_orig) then
        gen_comp := charsets[1]:
    else
        if infolevel > 0 then
            LogText(sprintf("    Did not pick the right component. Using singsol = all\n"), target):
        end if:
        charsets := RosenfeldGroebner(model, Relim):
        if infolevel > 0 then
            LogText(sprint("    Selecting the general component\n"), target):
        end if:
        general_comps := []:
        for c in charsets do
            general := true:
            for e in Equations(c) do
                if NormalForm(e, chset_orig) <> 0 then
                    general := false:
                    break:
                end if:
            end do:
            if general then
                general_comps := [op(general_comps), c]:
            end if:
        end do:
        if nops(general_comps) > 1 then
            LogText(sprintf("More than one component is considered general!", general_comps), target):
        end if:
        gen_comp := general_comps[1]:
    end if:
    io_eqs := Equations(gen_comp, leader < parse(cat(states[-1], "(t)"))):
    return io_eqs:
end proc:

#===============================================================================

# Adapted from
# https://www.mapleprimes.com/questions/36772-Extract-Specific-Coefficients-Of-A-Multivariate
# by Kitonum 15364
coefff:=proc(P, t)
    local L, H, i, k:
    L:=[coeffs(P, indets(P), 'h_aux_for_coef')]: H:=[h_aux_for_coef]: k:=0:
    for i from 1 to nops(H) do
        if H[i]=t then k:=L[i] fi:
    end do:
    return k;
end proc:

#===============================================================================

DecomposePolynomial := proc(p, vars_main, vars_coef, infolevel, target)
    # Input: p - polynomial in two groups of variables: vars_main and vars_coef
    # Computes a decomposition of minimal length of p as a linear combination
    # of products A * B, where A is a polynomial in vars_main and B
    # is a polynomial in vars_coef return two lists: list of A's and list of B's
    local cf, monoms, result_cf, result_monom, i, c, m, j, lc, lm, coeff_in_c:
    cf := [coeffs(collect(p, vars_main, 'distributed'), vars_main, 'monoms')]:
    monoms := [monoms]:
    result_cf := []:
    result_monom := Array([]):
    if infolevel > 0 then
        LogText(sprintf("        Number of monomials: %a\n", nops(cf)), target):
    end:
    for i from 1 to nops(cf) do
        c := cf[i]:
        m := monoms[i]:
        for j from 1 to nops(result_cf) do
            lc, lm := Groebner[LeadingTerm](result_cf[j], plex(op(vars_coef))):
            coeff_in_c := coefff(c, lm):
            c := c - coeff_in_c / lc * result_cf[j]:
            result_monom[j] := result_monom[j] + coeff_in_c / lc * m:
        end do:
        if c <> 0 then
            result_cf := [op(result_cf), c]:
            ArrayTools[Append](result_monom, m):
        end if:
    end do:
    if infolevel > 0 then
        LogText(sprintf("        Reduced to: %a\n", nops(result_cf)), target):
    end:
    return [result_cf, convert(result_monom, list)]:
end proc:

#===============================================================================

ConstructWronskian := proc(io_eq, model, states, inputs, outputs, params, state_space, infolevel, target)
    # Input - the same as for GetIOEquations + one IO-equation + flag subs_param
    # Computes the Wronskian for this equation using the representation
    # given by DecomposePolynomial. Return a pair of the Wronskian
    # reduced modulo the original system and a list of coefficients
    # of the compressed io_eq
    local getNormalForm, diff_to_ord, v, vt, h, v_ord, vd, p, decomp, diff_polys, Rorig, chset_orig,
    M, yus, yus_reduced, yus_list, M_sub, roll, params_sub, ios, ps_sol, ps, i:

    diff_to_ord := {}:
    ios := [op(inputs), op(outputs)]:
    for v in ios do
        vt := parse(cat(v, "(t)")):
        diff_to_ord := {op(diff_to_ord), vt = v}:
        for h from 1 to nops(states) + 1 do
            v_ord := parse(cat(v, "_", h)):
            vd := diff(vt, t$h):
            diff_to_ord := {op(diff_to_ord), vd = v_ord}:
        end do:
    end do:
    p := subs(diff_to_ord, io_eq):
    if infolevel > 0 then
        LogText(sprintf("    Combining monomials to reduce the dimension\n"), target):
    end if:
    decomp := DecomposePolynomial(p, map(e -> rhs(e), diff_to_ord), params, infolevel, target):
    diff_polys := map(p -> subs(map(e -> rhs(e) = lhs(e), diff_to_ord), p), decomp[2]):
    Rorig := DifferentialRing(blocks = [[op(outputs)], [op(states)], [op(inputs)]], derivations = [t], arbitrary = params):
           # DifferentialRing(blocks = [[op(inputs)], [op(outputs)], [op(states)]], derivations = [t], arbitrary = params):
    chset_orig := RosenfeldGroebner(model, Rorig)[1]:

    if infolevel > 0 then
        LogText(sprintf("    Computing the Wronskian\n"), target):
    end if:
    M := VectorCalculus[Wronskian](diff_polys, t):
    yus := indets(M) minus {t}:

    if infolevel > 0 then
        LogText(sprintf("    Reducing the Wronskian\n"), target):
    end if:
    if state_space <> [] then
        ps_sol := GetPSSolution(state_space, nops(yus)):
        yus_reduced := []:
        for v in ios do
            vt := parse(cat(v, "(t)")):
            ps := subs(ps_sol, v(t)):
            for i from 0 to nops(yus) - 1 do
                yus_reduced := [op(yus_reduced), vt = subs({t = 0}, ps)]:
                vt := diff(vt, t):
                ps := diff(ps, t):
            end do:
        end do:
    else
        getNormalForm := proc (p, chset_orig)
            return p=DifferentialAlgebra:-NormalForm(p, chset_orig):
        end proc:
        Rorig := DifferentialRing(blocks = [[op(outputs)], [op(states)], [op(inputs)]], derivations = [t], arbitrary = params):
               # DifferentialRing(blocks = [[op(inputs)], [op(outputs)], [op(states)]], derivations = [t], arbitrary = params):
        chset_orig := RosenfeldGroebner(model, Rorig)[1]:
        yus_list := convert(yus, list):
        yus_reduced:=Threads:-Seq[tasksize=nops(yus_list)](getNormalForm(yus_list[i], chset_orig), i =1..nops(yus_list)):
        # yus_reduced := map(p -> p = NormalForm(p, chset_orig), yus):
    end if:

    # iofun:=map(y->parse(cat(convert(y, string), "(t)")), ios):
    # derivative_orders:=table([seq(p=0, p in iofun)]):
    # for each in yus_list do
    #     indets_ := indets(each) minus {t}: # get indets of derivative to compute order
    #     function_ := op(indets_ intersect {op(iofun)}): # for which function?
    #     order:=numelems(indets_): # compute order
    #     if derivative_orders[function_]<order then
    #         derivative_orders[function_]:=order;
    #     fi:
    # end do;
    # LogExpression(derivative_orders):
    # yus_reduced:=[]:
    # count:=0:
    # # yus_reduced:=Threads:-Seq[tasksize=nops(yus_list)](getNormalForm(yus_list[i], chset_orig), i =1..nops(yus_list)):
    # for y in ios do
    #     y:=parse(cat(convert(y, string), "(t)")):
    #     y_rem:=y:
    #     fun:=y:
    #     while count<derivative_orders[fun] do
    #         yus_reduced:=[op(yus_reduced), y=DifferentialAlgebra:-NormalForm(y_rem, chset_orig)]:
    #         count := count+1:
    #         y_rem:=diff(y_rem, t):
    #         y:=diff(y, t):
    #         LogText("Done Processing %a, order: %a\n", fun, count):
    #     end do:
    #     count:=0:
    # end do:

    M_sub := subs(yus_reduced, M):
    M_sub := subs(map(x -> parse(cat(x, "(t)")) = x, states), M_sub):
    return [M_sub, decomp[1]]:
end proc:

#===============================================================================

SingleExperimentIdentifiableFunctions := proc(model, output_targets, {infolevel := 1})
    # Input: model - ODE model represented as a list of differential polynomials
    # Computes generators of the field of single-identifiable functions
    local result, start, finish, states, inputs, outputs, model_eq, ios, params, io_eqs, si_gens, eq, wrnsk, echelon_form, model_denomfree, target:
    states, inputs, outputs, params, model_eq := op(ParseInput_(model)): # states, ios, params := op(ParseInput_(model)):
    ios := [op(inputs), op(outputs)]:

    # Step 1
    if infolevel > 0 then
        LogText(sprintf("SE Step 1: Computing input-output equations\n"), output_targets[log]):
    end if:
    model_denomfree := ExtractDenominator(model_eq):
    io_eqs := GetIOEquations(model_denomfree, states, inputs, outputs, params, false, infolevel, output_targets[log]):
    if infolevel > 0 then
        LogText(sprintf("SE Total number of io-equations: %a\n", nops(io_eqs)), output_targets[log]):
    end if:

    	    si_gens := {}:
	    for eq in io_eqs do
	        # Step 2
	        if infolevel > 0 then
	            LogText(sprintf("SE Step 2: Constructing the Wronskian\n"), output_targets[log]):
	        end if:
	        wrnsk := ConstructWronskian(eq, model_denomfree, states, inputs, outputs, params, [], infolevel, output_targets[log])[1]:
	        # Step 3
	        if infolevel > 0 then
	            LogText(sprintf("SE Step 3: Computing the reduced row echelon form of the Wronskian\n"), output_targets[log]):
	        end if:
	        echelon_form := LinearAlgebra[ReducedRowEchelonForm](wrnsk):
	        si_gens := {op(si_gens), op(select(x -> not type(x, numeric), convert(echelon_form, list)))}:
	    end do:

    # Step 4
    if infolevel > 0 then
        LogText(sprintf("SE Step 4: restricting to the field of parameters"), output_targets[log]):
    end if:
    	result:=map(simplify, convert(FilterGenerators(FieldIntersection(si_gens, params)), list)):
	DocumentTools:-SetProperty(output_targets[single], expression, result, 'refresh'):
	return result:
end proc:

#===============================================================================
# Adapted from https://github.com/pogudingleb/SIAN
FunctionToVariable_ := proc(f):
    convert(convert(f, string)[1..-4], symbol):
end proc:

ParseInput_ := proc(model)
   local all_symbols, x_functions, io_functions, params, states, ios, diff_polys, lhss, out_functions, in_functions, inputs, outputs:
   diff_polys := map(eq -> lhs(eq) - rhs(eq), model):
   all_symbols := foldl(`union`, op( map(e -> indets(e), diff_polys) )) minus {t}:
   x_functions := map(f -> int(f, t), select( f -> type(int(f, t), function(name)), all_symbols )):
   io_functions := select( f -> not type(int(f, t), function(name)) and type(f, function(name)) and not f in x_functions, all_symbols ):
   lhss := map(eq -> lhs(eq), model):
   out_functions := select(f -> f in lhss, io_functions):
   in_functions := select(f -> not (f in lhss), io_functions):
   params := [op(select(f -> not type(f, function(name)) and not type(int(f, t), function(name)), all_symbols))]:
   states := [op(map(FunctionToVariable_, x_functions))]:
   inputs := [op(map(FunctionToVariable_, in_functions))]:
   outputs := [op(map(FunctionToVariable_, out_functions))]:
   return [states, inputs, outputs, params, diff_polys]:
end proc:

#===============================================================================

MultiExperimentIdentifiableFunctions := proc(model, simplified_generators, no_bound, simplify_bound, max_perms, output_targets): # {simplified_generators := false, no_bound := false})
    # Input: model - ODE model in the state-space form
    # Computes the bound from Theorem REF. Returns a list containing
    # 1. the bound
    # 2. the list of lists of coefficients of the IO-equations (after compression)
    # 3. (optional) simplified set of generators of the field of multi-experiment identifiable functions
    #
    # Optional keyword arguments:
    # 1. simplified_generators - if False, then just the coefficients of the IO-equations are returned.
    #                            if True, they are being simplified (maybe be a substantial simplification)
    #                            but this takes time
    # 2. no_bound - if True, then bound for the number of experiments is not computed (may save a lot of time)

    local states, inputs, outputs, ios, params, model_eqs, io_eqs, io_coeffs, io_coef, wrnsk, s, roll, wrnsk_sub, r, bound,
    generators, i, eq, result, model_denomfree, target, start, finish, infolevel, use_brackets, output_permutations,
    outputs_, io_coeffs_sb, io_eqs_sb, bound_sb, skip_simplify, result_sb, best_output_ordering, returned_generators, idx, old_bound:

    states, inputs, outputs, params, model_eqs := op(ParseInput_(model)):
    use_brackets:=false:
    output_permutations := combinat[permute](outputs):
    output_permutations:= output_permutations[..min(nops(output_permutations),max_perms)];

    infolevel := 1:
    model_denomfree := ExtractDenominator(model_eqs):
    skip_simplify := false:
    old_bound := 10: # this will be replaced by a smaller boud every time
    idx:=0:
    for use_brackets in [true, false] do
        for outputs in output_permutations do
        	LogText(sprintf("Permutation:\t%a\n", outputs),  output_targets[log]):
        	# the first iteration is default permutation
	    	   LogText(sprintf("Use Brackets?\t%a\n", use_brackets), output_targets[log]):
	        if infolevel > 0 then
	            LogText(sprintf("ME Computing input-output equations\n"), output_targets[log]):
	   	   end if:
	   	   io_eqs := GetIOEquations(model_denomfree, states, inputs, outputs, params, use_brackets, infolevel, output_targets[log]):
	   	   if infolevel > 0 then
	            LogText(sprintf("ME Total number of io-equations: %a\n", nops(io_eqs)), output_targets[log]):
	        end if:
	        io_coeffs := []:

	        for eq in io_eqs do
	            io_coef := DecomposePolynomial(eq, indets(eq) minus {op(params)}, params, infolevel, output_targets[log])[1]:
	            io_coeffs := [op(io_coeffs), io_coef]:
	        end do:

	        generators := {}:
    	        for io_coef in io_coeffs do
                 io_coef := sort(io_coef, (a, b) -> length(convert(a, string)) < length(convert(b, string)));
                 for i from 2 to nops(io_coef) do
                     generators := {op(generators), io_coef[i] / io_coef[1]}:
                 end do:
              end do:
              bound := 0:
		    if no_bound = false then
                  for eq in io_eqs do
                      if infolevel > 0 then
                          LogText(sprintf("ME Constructing the Wronskian\n"), output_targets[log]):
                      end if:
                      wrnsk, io_coef := op(ConstructWronskian(eq, model_denomfree, states, inputs, outputs, params, model, infolevel, output_targets[log])):
                      # in the notation of the theorem
                      s := nops(io_coef) - 1:
                      # substitution does not increase the rank, so the resulting bound will be correct
                      roll := rand(1..15):
                      wrnsk_sub := map(v -> v = roll(), indets(wrnsk)):
                      r := LinearAlgebra[Rank](subs(wrnsk_sub, wrnsk)):
                      bound := max(bound, s - r + 1):
                  end do:
               end if:
               if bound<old_bound or idx=0 then # idx makes sure we assign a new bound at the first run
               	old_bound:=bound:
               end if:
               idx := idx +1;
               LogText(sprintf("New Bound:\t%a\n", bound),  output_targets[log]):
               result := [old_bound, generators]:
               if simplified_generators then
                   if infolevel > 0 then
		             LogText(sprintf("ME WARNING: Entering simplification of generators! if this takes too long, try unchecking \"Simplified Generators\"\n"), output_targets[log]):
                   end if:
                   result := [op(result), FilterGenerators(FieldToIdeal(generators))]:
                   DocumentTools:-SetProperty(output_targets[multi], expression, map(simplify, convert(result[3], list)), 'refresh'):
                   returned_generators := result[3]:
               else
                   DocumentTools:-SetProperty(output_targets[multi], expression, map(simplify, convert(result[2], list)), 'refresh'):
                   returned_generators := result[2]:
               end if:
               if old_bound > 0 then
    	              DocumentTools:-SetProperty(output_targets[bound_], expression, old_bound, 'refresh'):
    	              if old_bound=1 then
    	  	             skip_simplify := true:
    	  	             if simplify_bound then
    	  		            LogText(sprintf("Bound on the number of experiments = 1, \"Try to refine bound\" was selected but it will be skipped"), output_targets[log]):
    	  	             end if:
	        	        if simplified_generators then
       		            DocumentTools:-SetProperty(output_targets[single], expression, map(simplify, convert(result[3], list)), 'refresh'):
   		             else
    	   		            DocumentTools:-SetProperty(output_targets[single], expression, map(simplify, convert(result[2], list)), 'refresh'):
   		             end if:
    	              end if:
               else
	              DocumentTools:-SetProperty(output_targets[bound_], expression, "",'refresh'):
               end if:
               if skip_simplify or not simplify_bound then
               	break:
              	else
              		DocumentTools:-SetProperty("being_refined", caption, "being refined", 'refresh'):
               end if:
         end do: # loop over outputs
         if skip_simplify or not simplify_bound then
             # only breaks if we do not simplify. the code runs at most once
             break:
         end if:
    end do:
    DocumentTools:-SetProperty("being_refined", caption, "", 'refresh'):
    return [bound, returned_generators];#table([bd=bound]):
end proc:

GetPSSolution := proc(model, ord)
    # Input: model and integer ord
    # Output: a truncated power series solution with random parameter values
    # and initial conditions of order ord
    local roll, states, inputs, outputs, params, model_eqs, model_sub,
    x_funcs, x_sols, x_eqs, cur_ord, i, rhs_eval, total_sub, y_funcs, y_sols,
    params_subs, input_subs:
    roll := rand(1..15):
    states, inputs, outputs, params, model_eqs := op(ParseInput_(model)):
    params_subs := map(p -> p = roll(), params):
    input_subs := map(u -> parse(cat(u, "(t)")) = add([seq(roll() * t^i, i=0..ord)]), inputs):
    model_sub := subs(params_subs, model):
    model_sub := subs(input_subs, model_sub):
    x_funcs := map(x -> parse(cat(x, "(t)")), states):
    x_sols := map(x -> x = roll(), x_funcs):
    x_eqs := map(x -> subs(model_sub, diff(x, t)), x_funcs):

    for cur_ord from 1 to ord do
        for i from 1 to nops(x_funcs) do
            rhs_eval := series(subs(x_sols, x_eqs[i]), t, ord + 1):
            x_sols[i] := (lhs(x_sols[i]) = (rhs(x_sols[i]) + t^cur_ord * coeff(rhs_eval, t, cur_ord - 1) / cur_ord)):
        end do:
    end do:

    total_sub := [op(x_sols), op(params_subs), op(input_subs)]:
    y_funcs := map(y -> parse(cat(y, "(t)")), outputs):
    y_sols := map(y -> y = subs(total_sub, subs(model_sub, y)), y_funcs):

    return [op(y_sols), op(input_subs), op(params_subs), op(x_sols)]:
end proc:


`is_element/shellings` := (A::set) -> (R) -> proc(S)
 global reason;
 local S0,S1,d,n,i,j,k,c,N,K;

 if A = {} then
  reason := ["is_element/shellings","A is empty"];
  return false;
 fi;

 if not type(S,list) then
  reason := ["is_element/shellings","S is not a list",S];
  return false;
 fi;

 S0 := `maximal_chains/partord`(A)(R);

 if {op(S)} <> S0 then
  reason := ["is_element/shellings","S is not an enumeration of the maximal simplices",S,S0];
  return false;
 fi;

 if nops(map(nops,S0)) <> 1 then
  reason := ["is_element/shellings","The maximal simplices are not all of the same dimension",S0];
  return false;
 fi;

 d := nops(S0[1]) - 1;
 n := nops(S);
 S1 := map(c -> {op(c)},S);
 N := table();

 for i from 2 to n do
  N[i] := select(j -> nops(S1[j] intersect S1[i]) = d,{seq(k,k=1..i-1)});
  if N[i] = {} then
   reason := ["is_element/shellings","The initial shelling condition fails for i",S,i];
   return false;
  fi;
 od:

 for i from 1 to n-1 do
  for j from i+1 to n do
   c := S1[i] intersect S1[j];
   K := select(k -> c minus S1[k] = {} ,N[j]);
   if K = {} then
    reason := ["is_element/shellings","The shelling condition fails for (i,j)",S,i,j];
    return false;
   fi;
  od;
 od;

 return true;
end:

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

`is_element/edge_lex_labellings` := (A::set) -> (R) -> proc(l)
 global reason;
 local H,C,d,l0,cut,inc,cmp,R0,C0,C1,c0,c1,ab,a,b,u,i;

 if `bottom_element/partord`(A)(R) = FAIL then
  reason := ["is_element/edge_lex_labellings","There is no bottom element",A,R];
  return false;
 fi;

 if `top_element/partord`(A)(R) = FAIL then
  reason := ["is_element/edge_lex_labellings","There is no top element",A,R];
  return false;
 fi;

 H := `hasse_diagram/partord`(A)(R);

 if not(is_table_on(H)(l)) then
  reason := ["is_element/edge_lex_labellings",
             "l is not a table indexed by the edges of the Hasse diagram",l,H];
  return false;
 fi;

 C := `maximal_chains/partord`(A)(R);
 if nops(map(nops,C)) <> 1 then
  reason := ["is_element/shellings","The maximal simplices are not all of the same dimension",C];
  return false;
 fi;

 d := nops(C[1]) - 1;

 l0 := (c) -> [seq(l[[c[i],c[i+1]]],i=1..nops(c)-1)];
 cmp := proc(c,d)
  local u;

  u := select(x -> x <> 0,l0(d) -~ l0(c));
  return evalb(u <> [] and u[1] > 0);
 end:

 cut := proc(c,a,b)
  local i,c0;

  i := 1;
  while c[i] <> a do i := i+1; od;
  c0 := NULL;
  while c[i] <> b do
   c0 := c0,c[i];
   i := i+1;
  od;
  c0 := [c0,b];
  return c0;
 end:

 inc := proc(c)
  local u,v,m;
  u := l0(c);
  v := [op(u),u[-1]] -~ [u[1],op(u)];
  m := min(op(v));
  return evalb(m >= 0);
 end:

 R0 := select(ab -> ab[1] <> ab[2],R);
 for ab in R0 do
  a,b := op(ab);
  C0 := select(c -> member(a,c) and member(b,c),C);
  C0 := map(cut,C0,a,b);
  C1 := select(inc,C0);

  if nops(C1) <> 1 then
   reason :=
    ["is_element/shellings",
     "The interval [a,b] does not have a unique increasing maximal chain",
     ab,C0,C1];
   return false;
  fi;

  c1 := op(C1);
  for c0 in C0 minus C1 do
   if not cmp(c1,c0) then
    reason :=
     ["is_element/shellings",
      "In the interval [a,b], the increasing chain is not lex-smallest",
      ab,c0,c1];
    return false;
   fi;
  od;
 od:

 return true;
end:


make_tetrahedron_complex := proc()
 global tetrahedron_complex;

 local T,V,E,F,v,f,P2,P3,g,s,x,eqs,sol;

 V := [seq(i,i=1..4)];
 E := [seq(seq([i,j],j=i+1..4),i=1..4)];
 F := [seq(seq(seq([i,j,k],k=j+1..4),j=i+1..4),i=1..4)];

 T := table([]);

 T["vertices"] := V;
 T["edges"] := E;
 T["coedges"] := E;
 T["faces"] := F;
 T["max_simplices"] := F;

 T["edge_index"]   := make_index(T["edges"]):
 T["face_index"]   := make_index(T["faces"]):

 T["simplices"] := [map(v -> [v],V),op(E),op(F)];

 T["embedding_dim"] := 3;
 T["embedding"] := table([
  1 = [ 1, 1, 1], 2 = [ 1,-1,-1], 3 = [-1, 1,-1], 4 = [-1,-1, 1]
 ]);

 T["axial_embedding"] :=
  table([1 = simplex_embedding([1,0,0,0]),
         2 = simplex_embedding([0,1,0,0]),
	 3 = simplex_embedding([0,0,1,0]),
	 4 = simplex_embedding([0,0,0,1])]);

 v := eval(T["embedding"]);

 T["normalised_embedding"] :=
  table([seq(i = v[i] *~ (sqrt(3)/3), i = 1..4)]);

 T["dual_embedding"] := table([seq(i = -~ v[i],i = 1..4)]);

 `plot/simplicial_complex`(T);

 T["edge_centres"] :=
  map(e -> (v[e[1]] +~ v[e[2]]) /~ 2,T["edges"]);

 T["face_centres"] :=
  map(f -> (v[f[1]] +~ v[f[2]] +~ v[f[3]]) /~ 3, T["faces"]);

 f := u -> combine(simplify(rationalize(u /~ sqrt(add(u[i]^2,i=1..3)))));
 P2 := [seq(seq(f(v[i] +~ v[j]),j=i+1..4),i=1..3)];
 P3 := [seq(f(v[i]),i=1..4),seq(f(-~ v[i]),i=1..4)];

 T["poles"] := table([2 = P2, 3 = P3]);

 T["planes"] := [
  seq(seq(f(v[i] -~ v[j]),j=i+1..4),i=1..3),
  seq(seq(f(v[j] -~ v[i]),j=i+1..4),i=1..3)
 ];

 T["pole_plots"] := table([
  2 = map(u -> line(1.2 *~ u, -1.2 *~ u,color=green,thickness=4),T["poles"][2]),
  3 = map(u -> line(1.2 *~ u, -1.2 *~ u,color=red  ,thickness=4),T["poles"][3])
 ]);

 T["all_poles_plot"] := display(
  op(T["pole_plots"][2]),op(T["pole_plots"][3]),
  scaling=constrained,axes=none
 );

 T["symmetry_group"] := combinat[permute](4);
 T["rotation_group"] :=
  select(s -> mul(mul(s[j] - s[i],j=i+1..4),i=1..3) > 0, T["symmetry_group"]);

 T["symmetry_matrix"] := table():

 for s in T["symmetry_group"] do
  g := Matrix(3,3,[seq(x[i],i=1..9)]);
  eqs := map(op,[seq(convert(g . Vector(v[i]) - Vector(v[s[i]]),list),i = 1..4)]);
  sol := solve(eqs);
  T["symmetry_matrix"][s] := simplify(rationalize(subs(sol,convert(g,listlist))));
 od:

 tetrahedron_complex := eval(T);
 return eval(T);
end:

make_tetrahedron_complex():


(*
 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: work_mgga_c *)
(* prefix:
  mgga_x_m11_l_params *params;

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

$include "mgga_x_m08.mpl"
$include "lda_x_erf.mpl"

f_spin := (rs, z, x, t) ->
  lda_x_ax*(1 + z)^(4/3)/rs * (
    + attenuation_erf(a_cnst*rs/(1 + z)^(1/3)) * m08_f(params_a_a, params_a_b, x, t)
    + (1 - attenuation_erf(a_cnst*rs/(1 + z)^(1/3))) * m08_f(params_a_c, params_a_d, x, t)
  ):

f_m11_l := (rs, z, xt, xs0, xs1, ts0, ts1) ->
  f_spin(rs, z, xs0, ts0) + f_spin(rs, -z, xs1, ts1):

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


with(LinearAlgebra):
with(VectorCalculus):
with(plottools);

NALU := proc(w1,w2,ghat1,ghat2,x,t,epsilon)
	local g1, g2, z1, z2, L, i;
	g1 := 1/~(1 +~ exp~(-ghat1));
	z1 := g1 *~ (w1.x) +~ (1 -~ g1) *~ exp~(w1.log~(abs(x) +~ epsilon));

	g2 := 1/~(1 +~ exp~(-ghat2));
	z2 := g2 *~ (w2.z1) +~ (1 -~ g2) *~ exp~(w2.log~(abs(z1) +~ epsilon));

	L := (z2 -~ t)^~2;
	return add(L[i],i=1..numelems(L));
end proc:

NALUsafe := proc(w1,w2,ghat1,ghat2,x,t)
	local g1, g2, z1, z2, L, i;
	g1 := 1/~(1 +~ exp~(-ghat1));
	z1 := g1 *~ (w1.x) +~ (1 -~ g1) *~ exp~(w1.log~(abs(x -~ 1) +~ 1));

	g2 := 1/~(1 +~ exp~(-ghat2));
	z2 := g2 *~ (w2.z1) +~ (1 -~ g2) *~ exp~(w2.log~(abs(z1 -~ 1) +~ 1));

	L := (z2 -~ t)^~2;
	return add(L[i],i=1..numelems(L));
end proc:

NALU(<<w | w>, <w | w>>, <<w | w>>, <g, g>, <g>, <x[1], x[2]>, t, epsilon);

P := plot3d(
	NALU(<<w | w>, <w | w>>, <<w | w>>, <g, g>, <g>, <2, 2>, 8, 10^(-8)),
	w = -1.5..1.5, g = -3..3,
	view = [-1.5..1.5, -3..3, 0..300],
	axes=boxed):
P;

P := plot3d(
	NALU(<<w | w>, <w | w>>, <<w | w>>, <g, g>, <g>, <2, 2>, 16, 10^(-8)),
	w = -1.5..1.5, g = -3..3,
	view = [-1.5..1.5, -3..3, 0..300],
	axes=boxed):
P;

NALUsafe(<<w | w>, <w | w>>, <<w | w>>, <g, g>, <g>, <x[1], x[2]>, t, epsilon);

P := plot3d(
	NALUsafe(<<w | w>, <w | w>>, <<w | w>>, <g, g>, <g>, <2, 2>, 8),
	w = -1.5..1.5, g = -3..3,
	view = [-1.5..1.5, -3..3, 0..300],
	axes=boxed):
P;

P := plot3d(
	NALUsafe(<<w | w>, <w | w>>, <<w | w>>, <g, g>, <g>, <2, 2>, 16),
	w = -1.5..1.5, g = -3..3,
	view = [-1.5..1.5, -3..3, 0..300],
	axes=boxed):
P;

solveNALUsafe := proc(x, t)
	local i, v, w, g, eq, sol1, sol2, sols;

	eq := NALUsafe(<<w | w>, <w | w>>, <<w | w>>, <g, g>, <g>, x, t);
	sols := [];
     for v from -3 to 3 by 0.1 do
       sol1 := fsolve(eval(eq, g=v) = 0, w);
       sol2 := fsolve(eval(eq, g=v) = 0, w, avoid={{w = sol1}});
       sols := [op(sols), [sol1, v], [sol2, v]];
     end do;

	return sols;
end proc:

solveNALU := proc(x, t, epsilon)
	local i, v, w, g, eq, sols, sol1, sol2, sol3, sol4;

	eq := NALU(<<w | w>, <w | w>>, <<w | w>>, <g, g>, <g>, x, t, epsilon);
	sols := [];
     for v from -3 to 3 by 0.1 do
       sol1 := fsolve(eval(eq, g=v) = 0, w);
       sol2 := fsolve(eval(eq, g=v) = 0, w, avoid={{w = sol1}});
       if v < 0.9 and v >= 0 then
         sol3 := fsolve(eval(eq, g=v) = 0, w, avoid={{w = sol1}, {w = sol2}});
         sols := [op(sols), [sol1, v], [sol2, v], [sol3, v]];
       elif v < 0 then
         sol3 := fsolve(eval(eq, g=v) = 0, w, avoid={{w = sol1}, {w = sol2}});
         sol4 := fsolve(eval(eq, g=v) = 0, w, avoid={{w = sol1}, {w = sol2}, {w = sol3}});
         sols := [op(sols), [sol1, v], [sol2, v], [sol3, v], [sol4, v]];
       else
         sols := [op(sols), [sol1, v], [sol2, v]];
       end if;
     end do;

	return sols;
end proc:

NALUsols := solveNALU(<2, 2>, 8, 10^(-8));
P := plot(NALUsols, style = 'point', view = [-1.5..1.5, -3..3]):
P;

NALUsafesols := solveNALUsafe(<2, 2>, 8);
P := plot(NALUsafesols, style = 'point', view = [-1.5..1.5, -3..3]):
P;


(*
 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 *)

params_a_kappa := 4.8827323:
params_a_mu    := 0.3511128:
$include "gga_x_pbe.mpl"

dldf_a := [1, -0.1637571, -0.1880028, -0.4490609, -0.0082359]:
dldf_csi_HF := 1 - 0.6144129:

dldf_f := (x, u, t) ->
  + dldf_csi_HF*pbe_f(x)*mgga_series_w(dldf_a, 5, t):

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


(*
 Copyright (C) 2020 Susi Lehtola

 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: gga_exc *)
(* prefix:
  gga_k_pg_params *params;

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

pg_f0 := s -> 5/3*s^2 + exp(-params_a_pg_mu * s^2):
pg_f := x -> pg_f0(X2S*x):

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


# Velocity Calculation for the Robot based on MDH frames
# Introduction
# Berechnung der Geschwindigkeit von Koordinatensystemen und Schwerpunkten
#
# Dateiname:
# robot -> Berechnung für allgemeinen Roboter
# tree -> Berechnung für eine beliebige Baumstruktur (ohne Schleifen)
# velocity_mdh_angles  -> Berechnung der Geschwindigkeit der MDH-Koordinaten (Drehung und Verschiebung in z-Richtung. Diese können zeitabhängig sein.
# Authors
# Moritz Schappler, schappler@irt.uni-hannover.de, 2016-03
# (C) Institut fuer Regelungstechnik, Leibniz Universitaet Hannover
#
# Sources
# [GautierKhalil1990] Direct Calculation of Minimum Set of Inertial Parameters of Serial Robots
# [KhalilDombre2002] Modeling, Identification and Control of Robots
# [Ortmaier2014] Vorlesungsskript Robotik I (WS 2014/15)
# [Ott2008] Cartesian Impedance Control of Redundant and Flexible-Joint Robots
# Initialization
interface(warnlevel=0): # Unterdrücke die folgende Warnung.
restart: # Gibt eine Warnung, wenn über Terminal-Maple mit read gestartet wird.
interface(warnlevel=3):
with(LinearAlgebra):
with(ArrayTools):
with(codegen):
with(CodeGeneration):
with(StringTools):
codegen_act := true:
codegen_opt := 2:
read "../helper/proc_convert_s_t":
read "../helper/proc_convert_t_s":
read "../helper/proc_MatlabExport":
read "../helper/proc_simplify2":
read "../robot_codegen_definitions/robot_env":
printf("%s. Generiere Geschwindigkeit für %s\n", FormatTime("%Y-%m-%d %H:%M:%S"), robot_name):
read sprintf("../codeexport/%s/tmp/tree_floatb_definitions", robot_name):
# Lade Ausdrücke für kinematische Zwangsbedingungen (Verknüpfung von MDH-Gelenkwinkeln durch verallgemeinerte Koordinaten)
read sprintf("../codeexport/%s/tmp/kinematic_constraints_maple_inert.m", robot_name):
kintmp_qt := kintmp_qt:
kintmp_qt := kintmp_qt:
kin_constraints_exist := kin_constraints_exist:
kintmp_subsexp := kintmp_subsexp:
# Term-Vereinfachungen einstellen
if not assigned(simplify_options) or simplify_options(4)=-1 then # Standard-Einstellungen:
  if not kin_constraints_exist then # normale serielle Ketten und Baumstrukturen
    use_simplify := 0: # Standardmäßig aus
  else # mit kinematischen Zwangsbedingungen
    use_simplify := 1: # standardmäßig simplify-Befehle anwenden
  end if:
else # Benutzer-Einstellungen:
  use_simplify := simplify_options(4): # vierter Eintrag ist für Geschwindigkeit
end if:

# Zeitableitung der Drehwinkel berechnen
# Ersetze die MDH-Winkel durch verallgemeinerte Koordinaten
# Falls die Gelenkwinkel nicht direkt mit verallgemeinerten Koordinaten überstimmen (bei Kopplungen, kinematischen Schleifen) steht hier eine längere Berechnung. Ansonsten reicht das triviale Einsetzen:
# thetaD := qJD_t:
# Ersetze die MDH-Drehung und Verschiebung entlang der z-Achse durch verallgemeinerte Koordinaten
theta_qt := theta:
d_qt := d:
for ii from 1 to NJ do
  for jj from 1 to RowDimension(kintmp_qt) do
    theta_qt(ii, 1) := subs( { kintmp_t(jj, 1) = kintmp_qt(jj, 1) }, theta_qt(ii, 1) ):
    d_qt(ii, 1)     := subs( { kintmp_t(jj, 1) = kintmp_qt(jj, 1) }, d_qt(ii, 1) ):
  end do:
end do:
# Zeitableitung der MDH-Drehung und Verschiebung entlang der z-Achse in Abhängigkeit der verallgemeinerten Koordinaten
thetaD := Matrix(NJ, 1):
dD := Matrix(NJ, 1):

for i from 1 to NJ do
  thetaD(i,1) := diff(theta_qt(i,1), t):
  dD(i,1)     := diff(d_qt(i,1), t):
end do:
if kin_constraints_exist then # ist nur rechenaufwändig, wenn ZB vorliegen
  printf("%s. Zeitableitung der MDH-Winkel gebildet.\n", FormatTime("%Y-%m-%d %H:%M:%S")):
end if:
# Terme vereinfachen

if use_simplify>=1 and kin_constraints_exist then # ist nur sinnvoll, wenn ZB vorliegen
  tmp_t0 := time():
  tmp_l0 := length(thetaD)+length(dD):
  printf("%s: Vereinfache MDH-Geschwindigkeiten. Länge: %d.\n", \
    FormatTime("%Y-%m-%d %H:%M:%S"), tmp_l0):
  for i from 1 to NJ do
    tmp_t1 := time():
    tmp_l1 := length(thetaD(i,1)) + length(dD(i,1)): # es kann sowieso nur einer der beiden Informationen enthalten
    printf("%s: Vereinfache MDH-Geschw. %d. Länge: %d.\n", \
      FormatTime("%Y-%m-%d %H:%M:%S"), i, tmp_l1):
    thetaD(i,1) := simplify2(thetaD(i,1)):
    dD(i,1)     := simplify2(dD(i,1)):
    tmp_t2 := time():
    tmp_l2 := length(thetaD(i,1)) + length(dD(i,1)):
    printf("%s: MDH-Geschw. %d vereinfacht. Länge: %d->%d. Rechenzeit %1.1fs.\n", \
      FormatTime("%Y-%m-%d %H:%M:%S"), i, tmp_l1, tmp_l2, tmp_t2-tmp_t1):
  end do:
  tmp_l3 := length(thetaD)+length(dD):
  printf("%s: MDH-Geschwindigkeiten vereinfacht. Länge: %d->%d. Rechenzeit %1.1fs.\n", \
    FormatTime("%Y-%m-%d %H:%M:%S"), tmp_l0, tmp_l3, tmp_t2-tmp_t0):
end if:

# Ausdruck für Zeitableitungen der MDH-Winkel exportieren
if codegen_act then
  MatlabExport(convert_t_s(thetaD), sprintf("../codeexport/%s/tmp/velocity_mdh_angles_matlab.m", robot_name), codegen_opt):
  MatlabExport(convert_t_s(dD), sprintf("../codeexport/%s/tmp/velocity_mdh_deltaz_matlab.m", robot_name), codegen_opt):
end if:
# Ausdruck für Maple speichern
save thetaD, dD, sprintf("../codeexport/%s/tmp/velocity_mdh_angles_maple.m", robot_name):


input := FileTools:-Text:-ReadFile("AoC-2021-10-input.txt" ):

lines := StringTools:-Split(input):
matchlookup := table( [ "]"="[", "}"="{", ">"="<", ")"="(",
    "["="]", "{"="}", "<"=">", "("=")" ] );
scores :=  table( [ "]"=57, "}"=1197, ">"=25137, ")"=3 ] ):
scores2 := table( ["("=1, "["=2, "{"=3, "<"=4] ):

points := 0:
badlines := NULL:
for j to nops(lines) do

    bracestack := DEQueue();
    for i to length(lines[j]) do
        if lines[j][i] in { "[", "{", "<", "(" } then
            push_back(bracestack, lines[j][i]);
        elif lines[j][i] in { "]", "}", ">", ")" } then
            c := pop_back(bracestack);
            if not c = matchlookup[lines[j][i]] then
                printf("Expected %a, but found %a instead.\n",
                    matchlookup[c], lines[j][i] );
                points += scores[lines[j][i]];
                badlines := badlines, j;
                break;
            end if;
        end if;
    end do;

    acscore[j] := 0;
    while not empty(bracestack) do
        c := pop_back(bracestack);
        acscore[j] := 5*acscore[j] + scores2[c];
    end do;
end do:

answer1 := points;
answer2 := round(Statistics:-Median([seq( acscore[i],
    i in ({ seq(1..nops(lines)) } minus {badlines}))] ));


(*
 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_bc95_params *params;

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

$define lda_c_pw_params
$define lda_c_pw_modified_params
$include "lda_c_pw.mpl"

(* The B97 function g *)
bc95_gpar  := (xs, ts) -> ts*Fermi_D(xs, ts)/(K_FACTOR_C*(1 + params_a_css*xs^2)^2):
bc95_gperp := (xs0, xs1) -> 1/(1 + params_a_copp*(xs0^2 + xs1^2)):

(* The parallel and perpendicular components of the energy *)
bc95_fpar  := (rs, z, xs0, xs1, ts0, ts1) ->
  + lda_stoll_par(f_pw, rs,  z,  1) * bc95_gpar(xs0, ts0)
  + lda_stoll_par(f_pw, rs, -z, -1) * bc95_gpar(xs1, ts1):

bc95_fperp := (rs, z, xs0, xs1) ->
  lda_stoll_perp(f_pw, rs, z) * bc95_gperp(xs0, xs1):

f_bc95 := (rs, z, xs0, xs1, ts0, ts1) ->
  + bc95_fpar (rs, z, xs0, xs1, ts0, ts1)
  + bc95_fperp(rs, z, xs0, xs1):

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


# This makes the formal group law for integral Morava K-theory
# We truncate powers d+1 and higher

make_fgl_Morava := proc(p,n,d)
 local T,ld,x,y,u,i;

 T := table();
 T["p"] := p;
 T["n"] := n;
 T["d"] := d;
 T["height"] := n;
 T["degree"] := d;
 T["modulus"] := 0;

 ld := 0;
 while p^ld <= d/p do ld := ld+1; od;
 T["log_degree"] := ld;

 T["log"] := unapply(add(x^(p^(n*i))/p^i,i=0..ld),x);
 T["p_series"] := unapply(x^(p^n),x);

 Order := d+2;

 T["exp"] :=
  unapply(
   convert(
    solve(x = series(T["log"](y) + sin(y)^(d+1),y=0,d+1),y),
    polynom,x
   ),
   x
  );

 T["p_series"] :=
  unapply(expand(convert(series(T["exp"](p*T["log"](x)),x=0,d+1),polynom,x)),x);

 T["sum"] :=
  unapply(
   subs(u=1,expand(convert(series(T["exp"](T["log"](u*x)+T["log"](u*y)),u=0,d+1),polynom,u))),
   x,y
  ):

 T["sum0"] := unapply(mods(T["sum"](x,y),p),x,y);
 T["p_series0"] := unapply(mods(T["p_series"](x),p),x);

 return eval(T);
end: