# An RZ_set is a subset of the circle R/Z that can be expressed as
# a finite union of half-open intervals [u,v).  Any such set can
# be expressed uniquely as
# [t[1],t[2]) u [t[3],t[4]) u ... u [t[2*n-1],t[2*n]) with
# 0 <= t[0] < t[1] < ... < t[2*n] <= 1.

`is_element/RZ_set` := proc(T)
 local n,i;

 if not type(T,list(realcons)) then return false; fi;
 n := nops(T)/2;
 if not(type(n,nonnegint)) then return false; fi;
 if n = 0 then return true; fi;
 if T[1] < 0 or T[2*n] > 1 then return false; fi;
 for i from 1 to 2*n-1 do
  if T[i+1] <= T[i] then return false; fi;
 od;
 return true;
end:

`is_equal/RZ_set` := proc(T,U)
 if nops(T) <> nops(U) then return false; fi;
 return evalb(simplify({0,op(T -~ U)}) = {0});
end:

`is_leq/RZ_set` := proc(T,U)
 evalb(`intersect/RZ_set`(T,`complement/RZ_set`(U)) = `empty/RZ_set`);
end:

`list_elements/RZ_set` := NULL:
`count_elements/RZ_set` := NULL:

`random_element/RZ_set` := proc()
 local n,S,T,i;

 n := rand(0..5)();
 S := {};
 while nops(S) < 2*n do
  S := {seq(rand(0..719)(),i=1..2*n)};
 od:
 T := sort([op(S)] /~ 720);
 T := `shift/RZ_set`(`random_element/RZ`())(T);
 return T;
end:

`length/RZ_set` := proc(T) local i; add((-1)^i * T[i],i=1..nops(T)); end:

`bot/RZ_set`   := []:
`empty/RZ_set` := []:
`top/RZ_set`   := [0,1];
`RZ/RZ_set`    := [0,1];

`complement/RZ_set` := proc(T)
 local n,U;
 n := nops(T)/2;
 if n = 0 then return [0,1]; fi;
 U := NULL;
 if T[1] > 0 then U := U,0,T[1]; fi;
 U := U,op(2..2*n-1,T);
 if T[2*n] < 1 then U := U,T[2*n],1; fi;
 U := [U];
 return U;
end:

`add_interval/RZ_set` := proc(T,u,v)
 local n,i,j,k,a,b;
 if nops(T) = 0 then return [u,v]; fi;
 n := nops(T)/2;
 i := 0;
 while i < n and T[2*i+2] < u do i := i+1; od;
 if i = n then return [op(T),u,v]; fi;
 j := i+1;
 while j <= n and T[2*j-1] <= v do j := j+1; od;
 a := min(u,T[2*i+1]);
 b := max(v,`if`(j = 1,0,T[2*j-2]));
 return [seq(T[k],k=1..2*i),a,b,seq(T[k],k=2*j-1..2*n)];
end:

`union/RZ_set` := proc()
 local U,T,n,i,j;
 if nargs = 0 then
  return `bot/RZ_set`;
 else
  U := args[1];
  for i from 2 to nargs do
   T := args[i];
   n := nops(T)/2;
   for j from 1 to n do
    U := `add_interval/RZ_set`(U,T[2*j-1],T[2*j]);
   od;
  od:
  return U;
 fi;
end:

`intersect/RZ_set` := proc()
 local T,U,V,n,m,i,j,a,b;
 if nargs = 0 then
  return `top/RZ_set`;
 elif nargs = 1 then
  return args[1];
 elif nargs > 2 then
  return `intersect/RZ_set`(args[1],`intersect/RZ_set`(args[2..-1]));
 else
  T := args[1];
  U := args[2];
  n := nops(T)/2;
  m := nops(U)/2;
  V := NULL;
  for i from 1 to n do
   for j from 1 to m do
    a := max(T[2*i-1],U[2*j-1]);
    b := min(T[2*i],U[2*j]);
    if a < b then
     V := V,[a,b];
    fi;
   od;
  od;
  V := sort([V],(x,y) -> (x[1] < y[1]));
  V := map(op,V);
  return V;
 fi;
end:

`symdiff/RZ_set` := proc(T,U)
 local A,B;

 A := `intersect/RZ_set`(T,`complement/RZ_set`(U));
 B := `intersect/RZ_set`(U,`complement/RZ_set`(T));
 return(`union/RZ_set`(A,B));
end:

`dist/RZ_set` := proc(T,U) `length/RZ_set`(`symdiff/RZ_set`(T,U)); end:

`shift/RZ_set` := (t) -> proc(T)
 local U,n,i,j;
 if T = [] then return []; fi;

 U := T +~ t;
 U := U -~ floor(U[1]);
 n := nops(U)/2;
 if U[2*n] <= 1 then return U; fi;

 i := 0;
 while i < n and U[2*i+2] <= 1 do i := i+1; od;
 if U[2*i+1] < 1 then
  if U[2*n] - 1 = U[1] then
   return [0,seq(U[j]-1,j=2*i+2..2*n-1),seq(U[j],j=2..2*i+1),1];
  else
   return [0,seq(U[j]-1,j=2*i+2..2*n),seq(U[j],j=1..2*i+1),1];
  fi;
 else
  if U[2*n]-1 = U[1] then
   return [seq(U[j]-1,j=2*i+1..2*n-1),seq(U[j],j=2..2*i)];
  else
   return [seq(U[j]-1,j=2*i+1..2*n),seq(U[j],j=1..2*i)];
  fi;
 fi;
end:

`interval/RZ_set` := proc(a,b)
 local a0,b0;

 a0 := a - floor(a);
 b0 := b - floor(b);
 if a0 < b0 then
  return [a0,b0];
 elif a0 = b0 then
  return [];
 else
  return [0,b0,a0,1];
 fi;
end:

`unroll/RZ_set` := proc(T,k::posint := 2)
 local n,i,j,t;
 n := nops(T)/2;
 if n=0 then return []; fi;
 if k = 1 then return T; fi;

 if T[1] = 0 and T[2*n] = 1 then
  return [seq(T[i],i=1..2*n-1),
          seq(seq(T[i]+j,i=2..2*n-1),j=1..k-2),
          seq(T[i]+k-1,i=2..2*n)];
 else
  return [seq(seq(t+j,t in T),j=0..k-1)];
 fi;
end:

`starts/RZ_set` := proc(T)
 local n,i;
 n := nops(T)/2;

 if n = 0 then return {}; fi;

 if T[1] = 0 and T[2*n] = 1 then
  return {seq(T[2*i-1],i=2..n)};
 else
  return {seq(T[2*i-1],i=1..n)};
 fi;
end:

`boundary/RZ_set` := proc(T)
 local n,i;
 n := nops(T)/2;

 if n = 0 then return {}; fi;

 if T[1] = 0 and T[2*n] = 1 then
  return {seq(T[i],i=2..2*n-1)};
 else
  return {seq(T[i],i=1..2*n)};
 fi;
end:

`are_crossed/RZ_set` := proc(T,U)
 local A,B,n,i;
 if `intersect/RZ_set`(T,U) <> `empty/RZ_set` then
  return true;
 fi;

 if nops(T) = 0 or nops(U) = 0 then
  return false;
 fi;

 A := `shift/RZ_set`(-T[1])(T);
 B := `shift/RZ_set`(-T[1])(U);
 i := 1;
 n := nops(A)/2;
 while i < n and A[2*i+2] <= B[1] do
  i := i+1;
 od;
 if i = n then
  return false;
 else
  return evalb(B[nops(B)] > A[2*i+1]);
 fi;
end:

`centroid_C/RZ_set` := proc(T)
 local n,l,t,i;
 n := nops(T)/2;
 if n = 0 then error("T is empty"); fi;
 l := `length/RZ_set`(T);
 evalf(add(int(exp(2*Pi*I*t),t=T[2*i-1]..T[2*i]),i=1..n)/l);
end:

`centroid_R2/RZ_set` := proc(T)
 local z;
 z := `centroid_C/RZ_set`(T);
 return([Re(z),Im(z)]);
end:

`flat_plot/RZ_set` := proc(T,y)
 local i;

 if T = [] then
  return NULL;
 else
  return
   display(seq(line([T[2*i-1],y],[T[2*i],y],args[3..-1]),i=1..nops(T)/2),
           scaling=constrained,axes=none);
 fi;
end:

`plot/RZ_set` := proc(T,r := 1,c := [0,0])
 local A,i,n,z,t;
 if nargs > 3 then
  A := args[4..-1];
 else
  A := NULL;
 fi;
 if T = [] then
  return NULL;
 else
  n := nops(T)/2;
  z := [seq(c +~ r *~ [cos(2*Pi*T[2*i-1]),sin(2*Pi*T[2*i-1])],i=1..n)];
  if T[1] = 0 and T[2*n] = 1 then
   z := [op(2..-1,z)];
  fi;
  return
   display(
    seq(plot([c[1]+r*cos(2*Pi*t),
	      c[2]+r*sin(2*Pi*t),
	      t = T[2*i-1]..T[2*i]],
	      A),
	i=1..nops(T)/2),
    seq(line(0.95 *~ z[i],z[i],A),i=1..nops(z)),
    scaling=constrained,axes=none);
 fi;
end:


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

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

(* type: mgga_exc *)
(* replace: "mbrxc_x\(" -> "xc_mgga_x_mbrxc_get_x(" *)

$include "mgga_x_mbrxc_bg.mpl"

task_alpha := (x, t) -> (t/K_FACTOR_C) * m_max(1 - x^2/(8*t), 1e-10):

mggac_b1 := 3.712:
mggac_b2 := 2.0:
mggac_b4 := 0.1:
mggac_b3 := 2.595 + 0.5197*mggac_b4 + 0.559*mggac_b2:
mggac_b5 := -3*mggac_b3:

(* new definition of Q. The rest of the functional remains the same *)
(* We have Lambda = (32 Pi^2)^(2/3)/(6 Q) *)
mbrxc_Q := (x, t) ->
      + (32*Pi)^(2/3)/6
      * (1 + mggac_b4*task_alpha(x, t) + mggac_b5*task_alpha(x, t)^2)
      / (mggac_b1 + mggac_b2*task_alpha(x, t) + mggac_b3*task_alpha(x, t)^2):


read "../ComputeIdentifiableFunctions.mpl":

cases := [
    [
        [PolynomialIdeal([a * x + b * y + c * y^2, d * y], variables={x, y}), PolynomialIdeal([a - a_aux, b - b_aux], variables={a_aux, b_aux})],
        PolynomialIdeal([x, y])
    ],
    [
        [PolynomialIdeal([a * x + b * z + c * y^2, d * y], variables={x, y, z}), PolynomialIdeal([a - a_aux, b - b_aux], variables={a_aux, b_aux})],
        PolynomialIdeal([a * x + b * z, y], variables={x, y, z})
    ],
    [
        [PolynomialIdeal([a - a_aux], variables={a_aux}), PolynomialIdeal([a - a_aux, b - b_aux], variables={a_aux, b_aux})],
        PolynomialIdeal([a - a_aux], variables={a_aux})
    ],
    [
        [PolynomialIdeal([-a - b + a_aux + b_aux, -a * a_aux + a * b + a_aux^2 - a_aux * b], variables={a_aux, b_aux}), PolynomialIdeal([-a + a_aux, -b + b_aux], variables={a_aux, b_aux})],
        PolynomialIdeal([-a - b + a_aux + b_aux, -a * a_aux + a * b + a_aux^2 - a_aux * b], variables={a_aux, b_aux})
    ],
    [
        [
            PolynomialIdeal([-a - b + a_aux + b_aux, -a * a_aux + a * b + a_aux^2 - a_aux * b], variables={a_aux, b_aux}),
            PolynomialIdeal([-a - b + a_aux + b_aux, -a * a_aux + a * b + a_aux^2 - a_aux * b, c - c_aux], variables={a_aux, b_aux, c_aux})
        ],
        PolynomialIdeal([-a - b + a_aux + b_aux, -a * a_aux + a * b + a_aux^2 - a_aux * b], variables={a_aux, b_aux})
    ]
];

num_passed := 0:
num_failed := 0:

for case in cases do
    input := case[1]:
    correct := case[2]:
    if IdealsEq(FieldCoefficientRestriction(op(input)), correct) then
        printf("PASSED\n");
        num_passed := num_passed + 1:
    else
        printf("FAILED\n");
        num_failed := num_failed + 1:
        print("Expected: ", correct);
        print("Got: ", FieldCoefficientRestriction(op(input)));
    end if:
end do:

printf("Passed: %a, failed %a \n", num_passed, num_failed);


######################################################################
# Intervals in the set of positive integers

`is_element/posint_intervals` := proc(J)
 global reason;

 if not(type(J,set(posint)) or type(J,list(posint))) then
  reason := [convert(procname,string),"J is not a list or set of positive integers",J];
  return false;
 fi;

 if nops(J) = 0 or nops(J) <> max(op(J)) - min(op(J)) + 1 then
  reason := [convert(procname,string),"J is not an interval",J];
  return false;
 fi;

 return true;
end;

`is_equal/posint_intervals` := (J,K) -> evalb({op(J)} = {op(K)});

`is_leq/posint_intervals` := (J,K) -> evalb({op(J)} minus {op(K)} = {});

`random_element/posint_intervals` := proc()
 local a,b,i;
 a := rand(1..10)();
 b := rand(0..9)();
 [seq(i,i=a..a+b)];
end:

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


# h := discrim(a1*x^4 + x^5 + a2*x^3 + a3*x^2 + a4*x + a5, x):

# # (1)-(47) are from Wang Dongming - So1ving po1ynomia1 equations: Characteristic sets and triangu1ar systems
# # 共16个例子

wangzero :=
[
    [   #(2) wang_ex9
        [x^8 + 4*x^6*y^2 + 6*x^4*y^4 + 4*x^2*y^6 + y^8 - 2*x^6*y - 6*x^4*y^3 - 6*x^2*y^5 - 2*y^7 - 5*x^6 - 11*x^4*y^2 - 7*x^2*y^4 - y^6 + 10*x^4*y + 12*x^2*y^3 + 2*y^5 + 4*x^4 + 4*x^2*y^2 - 8*x^2*y,
        8*x^7 + 24*x^5*y^2 + 24*x^3*y^4 + 8*x*y^6 - 12*x^5*y - 24*x^3*y^3 - 12*x*y^5 - 30*x^5 - 44*x^3*y^2 - 14*x*y^4 + 40*x^3*y + 24*x*y^3 + 16*x^3 + 8*x*y^2 - 16*x*y,
        8*x^6*y + 24*x^4*y^3 + 24*x^2*y^5 + 8*y^7 - 2*x^6 - 18*x^4*y^2 - 30*x^2*y^4 - 14*y^6 - 22*x^4*y - 28*x^2*y^3 - 6*y^5 + 10*x^4 + 36*x^2*y^2 + 10*y^4 + 8*x^2*y - 8*x^2
        ],
        [x, y]
    ],
    [   #(7) wang_ex15
        [8*x^2-2*x*y-6*x*z+3*x+3*y^2-7*y*z+10*y+10*z^2-8*z-4,
         10*x^2-2*x*y+6*x*z-6*x+9*y^2-y*z-4*y-2*z^2+5*z-9,
         5*x^2+8*x*y+4*x*z+8*x+9*y^2-6*y*z+2*y-z^2-7*z+5
        ],
        [x, y, z]
    ],
    [
        #(8) wang_ex16
        [2 + 10*p^2 - 2*p*q - 2*q + c^2*(q - 1)^2 + 2*c*d*(1 - q)*(q - p) + 4*p*q*d*(d - c) + 4*d^2*(1 - 2*p) + 4*d^2*(p - q) + 4*d*c*(p - 1) + 4*p*q*(c + 1) - 8*p + d^2*(p - q)^2,
        d*(2*p + 1)*(q - p) + c*(p + 2)*(1 - q) - 6*p*d + 2*c*(-p*q + p + q - 1) + 6*p^2*d,
        -4*(p - 1)^2 + 2*p*(p - q) - 2*q + 2,
        4 - 4*q^2 + 4*p + 3*c^2*(q - 1)^2 - 3*d^2*(p - q)^2 + 12*d^2*(p - 1)^2 + 4*p*(p - 2) + 12*d*c*(p + q + p*q - 1)
        ],
        [q, c, p, d]
    ],
    [
        #(10) wang_ex21
        [x + y + z + t + u,
         x*y + y*z + z*t + t*u + u*x,
         x*y*z + y*z*t + z*t*u + t*u*x + u*x*y,
         x*y*z*t + y*z*t*u + z*t*u*x + t*u*x*y + u*x*y*z,
         x*y*z*t*u + 1
        ],
        [x, y, z, t, u]
    ],
    [   #(13) wang_ex26
        [x^2 + y^2 + z^2,
         z*y*x,
         y^2*x^2 + z^2*x^2 + z^2*y^2,
         u^2 + 1/3*t^2,
         u^3 - t^2*u,
         2*x^2*u - y^2*u - z^2*u + y^2*t - z^2*t,
         -y^2*x^2*u - z^2*x^2*u + 2*z^2*y^2*u - y^2*x^2*t + z^2*x^2*t,
         2*x^2*u^2 - y^2*u^2 - z^2*u^2 - 2*y^2*t*u + 2*z^2*t*u - 2/3*x^2*t^2 + 1/3*y^2*t^2 + 1/3*z^2*t^2,
         - y^2*x^2*u^2 - z^2*x^2*u^2 + 2*z^2*y^2*u^2 + 2*y^2*x^2*t*u - 2*z^2*x^2*t*u + 1/3*y^2*x^2*t^2 + 1/3*z^2*x^2*t^2 - 2/3*z^2*y^2*t^2,
         - 3*y^2*x^4*t*u^2 + 3*z^2*x^4*t*u^2 + 3*y^4*x^2*t*u^2 - 3*z^4*x^2*t*u^2 - 3*z^2*y^4*t*u^2 + 3*z^4*y^2*t*u^2
         + 1/3*y^2*x^4*t^3 - 1/3*z^2*x^4*t^3 - 1/3*y^4*x^2*t^3 + 1/3*z^4*x^2*t^3 + 1/3*z^2*y^4*t^3 - 1/3*z^4*y^2*t^3
        ],
        [x, y, z, t, u]
    ],
    [   #(14) wang_ex27
        [y + u + v - 1,
         z + t + 2*u - 3,
         y + t + 2*v - 1,
         x - y - z - t - u - v,
         t*u*x^2 - 1569/31250*y*z^3,
         z*v - 587/15625*y*t
        ],
        [x, y, z, t, u, v]
    ],
    [
        #(15) wang_ex28
        [x^2 - x + 2*y^2 + 2*z^2 + 2*t^2,
         2*x*y + 2*y*z + 2*z*t - y,
         2*x*z + y^2 + 2*y*t - z,
         x + 2*y + 2*z + 2*t - 1
        ],
        [x, y, z, t]
    ],
    [   #(21) wang_ex34
        [B2*C2 + B3*C3 + B4*C4 + B5*C5 - 1/2,
         B2*C2^2 + B3*C3^2 + B4*C4^2 + B5*C5^2 - 1/3,
         B3*A32*C2 + B4*A42*C2 + B4*A43*C3 + B5*A52*C2 + B5*A53*C3 + B5*A54*C4 - 1/6,
         B2*C2^3 + B3*C3^3 + B4*C4^3 + B5*C5^3 - 1/4,
         B3*C3*A32*C2 + B4*C4*A42*C2 + B4*C4*A43*C3 + B5*C5*A52*C2 + B5*C5*A53*C3 + B5*C5*A54*C4 - 1/8,
         B3*A32*C2^2 + B4*A42*C2^2 + B4*A43*C3^2 + B5*A52*C2^2 + B5*A53*C3^2 + B5*A54*C4^2 - 1/12,
         B4*A43*A32*C2 + B5*A53*A32*C2 + B5*A54*A42*C2 + B5*A54*A43*C3-1/24,
         B2*C2^4 + B3*C3^4 + B4*C4^4 + B5*C5^4 - 1/5,
         B3*C3^2*A32*C2 + B4*C4^2*A42*C2 + B4*C4^2*A43*C3 + B5*C5^2*A52*C2 + B5*C5^2*A53*C3 + B5*C5^2*A54*C4 - 1/10,
         B3*C2^2*A32*C3 + B4*C2^2*A42*C4 + B4*C3^2*A43*C4 + B5*C2^2*A52*C2 + B5*C3^2*A53*C5 + B5*C4^2*A54*C5 - 1/15,
         B4*C4*A43*A32*C2 + B5*C5*A53*A32*C2 + B5*C5*A54*A42*C2
         + B5*C5*A54*A43*C3 - 1/30,
         B3*A32^2*C2^2 + B4*A42^2*C2^2 + 2*B4*A42*C2*A43*C3 + B4*A43^2*C3^2 + B5*A52^2*C2^2 + B5*A53^2*C3^2 + B5*A54^2*C4^2 + 2*B5*A52*C2*A53*C3 + 2*B5*A52*C2*A54*C4 + 2*B5*A53*C3*A54*C4 - 1/20,
         B3*A32*C2^3 + B4*A42*C2^3 + B4*A43*C3^3 + B5*A52*C2^3 + B5*A53*C3^3 + B5*A54*C4^3 - 1/20,
         B4*A43*C3*A32*C2 + B5*A53*C3*A32*C2 + B5*A54*C4*A42*C2 + B5*A54*C4*A43*C3- 1/40,
         B4*A43*A32*C2^2 + B5*A53*A32*C2^2 + B5*A54*A42*C2^2 + B5*A54*A43*C3^2- 1/60,
         B5*A54*A43*A32*C2-1/120
        ],
        [B2, B3, B4, B5, A32, A42, A43, A52, A53, A54, C4, C2, C3, C5]
    ],
    [   #(23) wang_ex36
        [U0^2 - U0 + 2*U1^2,
         U0 + 2*U1 - 1
        ],
        [U0, U1]
    ],
    [   #(24) wang_ex37
        [U0^2 - U0 + 2*U1^2 + 2*U2^2,
         2*U0*U1 + 2*U1*U2 - U1,
         U0 + 2*U1 + 2*U2 - 1
        ],
        [U0, U1, U2]
    ],
    [   #(25) wang_ex38
        [U0^2 - U0 + 2*U1^2 + 2*U2^2 + 2*U3^2,
         2*U0*U1 + 2*U1*U2 + 2*U2*U3 - U1,
         2*U0*U2 + U1^2 + 2*U1*U3 - U2,
         U0 + 2*U1 + 2*U2 + 2*U3 - 1
        ],
        [U0, U1, U2, U3]
    ],
    [   #(26) wang_ex39
        [
         U0^2 - U0 + 2*U1^2 + 2*U2^2 + 2*U3^2 + 2*U4^2,
         2*U0*U1 + 2*U1*U2 + 2*U2*U3 + 2*U3*U4 - U1,
         2*U0*U2 + U1^2 + 2*U1*U3 + 2*U2*U4 - U2,
         2*U0*U3 + 2*U1*U2 + 2*U1*U4 - U3,
         U0 + 2*U1 + 2*U2 + 2*U3 + 2*U4 - 1
        ],
        [U4, U3, U2, U1, U0]
    ],
    [   #(27) wang_ex40
        [U0^2 - U0 + 2*U1^2 + 2*U2^2 + 2*U3^2 + 2*U4^2 + 2*U5^2,
         2*U0*U1 + 2*U1*U2 + 2*U2*U3 + 2*U3*U4 + 2*U4*U5 - U1,
         2*U0*U2 + U1^2 + 2*U1*U3 + 2*U2*U4 + 2*U3*U5 - U2,
         2*U0*U3 + 2*U1*U2 + 2*U1*U4 + 2*U2*U5 - U3,
         2*U0*U4 + 2*U1*U3 + 2*U1*U5 + U2^2 - U4,
         U0 + 2*U1 + 2*U2 + 2*U3 + 2*U4 + 2*U5 - 1
        ],
        [U5, U4, U3, U2, U1, U0]
    ],
    [   #(28) wang_ex43
        [U4^4 - 20/7*A46^2,
         A46^2*U3^4 + 7/10*A46*U3^4 + 7/48*U3^4 - 50/27*A46^2 - 35/27*A46 - 49/216,
         A46^5*U4^3 + 7/5*A46^4*U4^3 + 609/1000*A46^3*U4^3 + 49/1250*A46^2*U4^3 - 27391/800000*A46*U4^3 - 1029/160000*U4^3 + 3/7*A46^5*U3*U4^2 + 3/5*A46^6*U3*U4^2 + 63/200*A46^3*U3*U4^2 + 147/2000*A46^2*U3*U4^2 + 4137/800000*A46*U3*U4^2 - 7/20*A46^4*U3^2*U4 - 77/125*A46^3*U3^2*U4 - 23863/60000*A46^2*U3^2*U4 - 1078/9375*A46*U3^2*U4 - 24353/1920000*U3^2*U4 - 3/20*A46^4*U3^3 - 21/100*A46^3*U3^3 - 91/800*A46^2*U3^3 - 5887/200000*A46*U3^3 - 343/128000*U3^3
        ],
        [U3, U4, A46]
    ],
    [   #(29) wang_ex45
        [45*P + 35*S - 165*B - 36,
         35*P + 40*Z + 25*T - 27*S,
         15*W + 25*P*S + 30*Z - 18*T - 165*B^2,
         -9*W + 15*P*T + 20*Z*S,
         W*P + 2*Z*T - 11*B^3,
         99*W - 11*S*B + 3*B^2
        ],
        [W, P, Z, T, S, B]
    ],
    [   #(30) wang_ex46
        [45*P + 35*S - 165*B - 36,
         35*P + 40*Z + 25*T - 27*S,
         15*W + 25*P*S + 30*Z - 18*T - 165*B^2,
         -9*W + 15*P*T + 20*Z*S,
         W*P + 2*Z*T - 11*B^3,
         99*W - 11*S*B + 3*B^2,
         B^2 + 33/50*B + 2673/10000
        ],
        [W, P, Z, T, S, B]
    ]
]:


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

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]:
csi_HF := 1 - 0.6144129:

f := (rs, x, t, u) ->
  + csi_HF*f_pbe(x)*mgga_series_w(dldf_a, 5, t):


n_max := 6; # Number of generators to use in the dual Steenrod algebra

bar := proc()
 local n,m,i,j,u,a,v,ac,av,x,y;
 n := nargs;
 for i from 1 to n do
  u := seq(args[j],j=1..i-1);
  a := args[i];
  v := seq(args[j],j=i+1..n);
  if type(a,`+`) then
   return map(t -> bar(u,t,v),a);
  elif type(a,integer) and modp(a,2) = 0 then
   return 0;
  elif type(a,`*`) then
   ac,av := selectremove(type,a,rational);
   ac := modp(ac,2);
   if ac <> 1 then
    return ac * bar(u,av,v);
   fi;
  elif type(a,specfunc(bar)) then
   return bar(u,op(a),v);
  fi;
 od;
 return 'procname'(args);
end:

steenrod_length := proc(u::specfunc(nonnegint,Sq)) nops(u); end:
steenrod_deg    := proc(u::specfunc(nonnegint,Sq)) `+`(op(u)); end:
steenrod_excess := proc(u::specfunc(nonnegint,Sq))
 add(op(i,u) - 2*op(i+1,u), i=1..nops(u)-1);
end:

is_admissible := proc(u::specfunc(nonnegint,Sq))
 local m,i;
 m := nops(u);
 for i from 1 to m-1 do
  if op(i,u) < 2*op(i+1,u) then return false; fi;
 od;
 return true;
end:

admissible_basis := proc(n::nonnegint)
 option remember;
 local L,i,v;

 if n = 0 then return [Sq()]; fi;
 L := NULL;
 for i from 1 to n do
  for v in admissible_basis(n-i) do
   if i = n or i >= 2 * op(1,v) then
    L := L,Sq(i,op(v));
   fi;
  od;
 od;

 return [L];
end:

admissible_lt := proc(u,v)
 local i;
 if steenrod_deg(u) < steenrod_deg(v) then return true;  fi;
 if steenrod_deg(u) > steenrod_deg(v) then return false; fi;

 for i from 1 to min(nops(u),nops(v)) do
  if op(i,u) < op(i,v) then return true; fi;
  if op(i,u) > op(i,v) then return false; fi;
 od:

 if nops(u) > nops(v) then return true; fi;
 return false;
end:

mate := proc(u::specfunc(nonnegint,Sq))
 local m,i,t;

 if not(is_admissible(u)) then return FAIL; fi;

 m := nops(u);
 i := [op(u),0];
 return mul(a[t]^(i[t] - 2 * i[t+1]),t=1..m);
end:

comate := proc(v)
 local r,alpha;
 r := n_max;
 while r > 0 and degree(v,a[r]) = 0 do r := r - 1; od;
 if r = 0 then return Sq(); fi;
 alpha := [seq(degree(v,a[t]),t=1..r)];
 return Sq(seq(add(2^(i-t)*alpha[i],i=t..r),t=1..r));
end;

adem_rhs := proc(k::nonnegint,j::nonnegint)
 modp(add(binomial(j-m-1,k-2*m) * Sq(j+k-m,m),m=0..floor(k/2)),2);
end:

adem_relation := (k,j) -> modp(Sq(k,j) + adem_rhs(k,j),2);

adem_reduce0 := proc(u)
 local v,v0,v1,m,r,i;
 if type(u,list) or type (u,set) or type(u,specfunc(anything,bar)) then
  return(map(adem_reduce0,u));
 elif type (u,`+`) then
  return modp(expand(map(adem_reduce0,u)),2);
 elif type (u,`*`) then
  return modp(expand(map(adem_reduce0,u)),2);
 elif type(u,specfunc(nonnegint,Sq)) then
  v := remove(i -> i=0, [op(u)]);
  m := nops(v);
  if m < 2 then return Sq(op(v)); fi;
  i := 1;
  while i < m and v[i] >= 2 * v[i+1] do
   i := i + 1;
  od;
  if i = m then return Sq(op(v)); fi;
  r := adem_rhs(v[i],v[i+1]);
  if r = 0 then return 0; fi;
  if type(r,`+`) then r := [op(r)] else r := [r]; fi;
  v0 := op(1..i-1,v);
  v1 := op(i+2..-1,v);
  r := map(w -> Sq(v0,op(w),v1),r);
  return modp(`+`(op(r)),2);
 else
  return modp(u,2);
 fi;
end:

adem_reduce := proc(u)
 local v,w;
 v := u;
 w := adem_reduce0(u);
 while w <> v do
  v := w;
  w := adem_reduce0(v);
 od;
 return w;
end:

bullett_macdonald_series := (n,s,t) ->
  modp(expand(add(add(
    ((t^2+s*t)^i*s^(2*j) + (s^2+s*t)^i*t^(2*j)) * Sq(i,j),
      j=0..n-i),i=0..n)),2);

bullett_macdonald_term := proc(i::nonnegint,j::nonnegint)
 local k0;
 k0 := modp(i,2);
 if modp(j,2) <> k0 then return 0; fi;
 return add(
   modp(binomial((j+k)/2,k),2) * Sq((j+k)/2,(i-k)/2),
   k=k0..min(i,j),2);
end:

bullett_macdonald_relation := proc(i::nonnegint,j::nonnegint)
 modp(bullett_macdonald_term(i,j) + bullett_macdonald_term(j,i),2);
end:

singer_relation := proc(p::nonnegint,q::nonnegint)
 if p > 2*q then return 0; fi;

 return add(modp(binomial(p,i),2) * Sq(2*q-i+1,q-p+i+1),
            i = max(0,p-q-1)..p);
end:

steenrod_mul := proc()
 local u,v;
 if nargs = 0 then
  return Sq();
 elif nargs = 1 then
  return modp(args[1],2);
 elif nargs > 2 then
  return steenrod_mul(steenrod_mul(args[1],args[2]),args[3..-1]);
 fi;

 u := modp(args[1],2);
 v := modp(args[2],2);
 if type(v,`+`) then
  return modp(expand(map(t -> steenrod_mul(u,t),v)),2);
 fi;
 if type(u,`+`) then
  return modp(expand(map(t -> steenrod_mul(t,v),u)),2);
 fi;

 if type(u,specfunc(nonnegint,Sq)) and type(v,specfunc(nonnegint,Sq)) then
  return Sq(op(u),op(v));
 else
  return u * v;
 fi;
end:

adem_mul := proc() adem_reduce(steenrod_mul(args)); end:

two_power_Sq := proc(n::nonnegint)
 option remember;
 local m,p,s,t,rel;

 if n = 0 then return Sq(); fi;

 m := n;
 p := 1;
 while modp(m,2) = 0 do m := m/2; p := 2*p; od;
 if p = n then return Sq(n); fi;

 rel := bullett_macdonald_series(n,s,t);
 rel := coeff(coeff(rel,s,p),t,2*n-p) - Sq(n,0);

 return two_power_reduce(rel);
end:

two_power_reduce := proc(u)
 if type(u,list) or type(u,set)  or type(u,specfunc(anything,bar)) then
  return map(two_power_reduce,u);
 elif type(u,`+`) or type(u,`*`) then
  return modp(expand(map(two_power_reduce,u)),2);
 elif type(u,specfunc(nonnegint,Sq)) then
  return steenrod_mul(op(map(two_power_Sq, [op(u)])));
 fi;
end:

milnor_Q := proc(n::nonnegint)
 option remember;
 local u,v;

 if n = 0 then
  return Sq(1);
 else
  u := Sq(2^n);
  v := milnor_Q(n-1);
  return modp(adem_mul(u,v) + adem_mul(v,u),2);
 fi;
end:

cartan_psi := proc(u)
 local v,f,m,i,j,k;
 if type(u,list) or type(u,set) then
  return map(cartan_psi,u);
 elif type(u,`+`) or type(u,`*`) then
  return modp(expand(map(cartan_psi,u)),2);
 elif type(u,specfunc(nonnegint,Sq)) then
  v := [bar(Sq(),Sq())];
  f := (i,j) -> v -> bar(Sq(op(op(1,v)),i),Sq(op(op(2,v)),j));
  for k from 1 to nops(u) do
   m := op(k,u);
   v := [seq(seq(f(i,m-i)(x),x in v),i=0..m)];
  od:
  return `+`(op(v));
 else
  return u;
 fi;
end:

a[0] := 1;
aL[0] := 1;
aR[0] := 1;

dual_psi := (u) ->
 subs({seq(a[i] = add(aL[j] * aR[i-j]^(2^j),j=0..i),i=0..n_max)},u);

steenrod_pairing := proc(u,v)
 local m,c,i;

 if u = 0 or v = 0 then return 0; fi;

 if type(u,`+`) then
  return modp(expand(map(t -> steenrod_pairing(t,v),u)),2);
 fi;
 if type(v,`+`) then
  return modp(expand(map(t -> steenrod_pairing(u,t),v)),2);
 fi;

 if type(u,specfunc(nonnegint,Sq)) then
  m := nops(u);
  if m = 0 then
   c := v;
   for i from 1 to n_max do c := coeff(c,a[i],0); od;
   return modp(c,2);
  elif m = 1 then
   c := coeff(v,a[1],op(u));
   for i from 2 to n_max do c := coeff(c,a[i],0); od;
   return modp(c,2);
  else
   c := coeff(dual_psi(v),aR[1],op(1,u));
   for i from 2 to n_max do c := coeff(c,aR[i],0); od;
   c := eval(subs(aL = a,c));
   c := steenrod_pairing(Sq(op(2..-1,u)),c);
   return c;
  fi;
 else
  return FAIL;
 fi;
end:

dickson_fW := proc(n)
 local t;
 return unapply(add(W[n,i] * t^(2^i),i = 0..n-1) + t^(2^n),t);
end:

dickson_fx := proc(n)
 option remember;
 local t,g,h,i;

 if n = 0 then
  return unapply(t,t);
 else
  g := dickson_fx(n-1)(t);
  h := modp(expand(g * add(coeff(g,t,2^i) * (t^(2^i) + x[n-1]^(2^i)),i=0..n-1)),2);
  return unapply(h,t);
 fi;
end:

dickson_W_deg := (n,i) -> 2^n - 2^i;

dickson_Wx := proc(n,k)
 option remember;
 return coeff(dickson_fx(n)(t),t,2^k);
end:

mui_Vx := (k) -> dickson_fx(k)(x[k]);

mui_V_deg := (i) -> 2^i;

mui_gV := (k) -> unapply(V[k] * t + t^2,t);

mui_gx := (k) -> unapply(mui_Vx(k) * t + t^2,t);

dickson_WV := proc(n,k)
 local L;
 if k > n then return 0; fi;

 L := combinat[choose]([seq(j,j=0..n-1)],n-k):
 return add(mul(V[i[t]]^(2^(t-i[t]+k-1)),t=1..n-k),i in L);
end:

dickson_WV_alt := proc(n,k)
 option remember;

 if k > n or k < 0 then return 0; fi;
 if k = n then return 1; fi;
 if k = 0 then return mul(V[i],i=0..n-1); fi;

 return modp(expand(V[n-1] * dickson_WV(n-1,k) + dickson_WV(n-1,k-1)^2),2);
end:

TSq_x := proc(n) local t; unapply(x[n] + t * x[n]^2, t); end;

TSq_mui_V := proc(n)
 local t,u;
 u := t^(2^n) * V[n]^2 + add(t^(2^n - 2^i) * V[n] * dickson_WV(n,i),i=0..n);
 return unapply(u,t);
end:

TSq_dickson_W := proc(n,k)
 local t,u;
 u := subs(W[n,n] = 1,
       W[n,k]^2 * t^(2^n - 2^k) +
       add(add(W[n,i]*W[n,j]* t^(2^n+2^k-2^i-2^j),j=k+1..n),i=0..k));
 return unapply(u,t);
end:

dickson_w_deg := (n,k) -> 1 - 2^k;

dickson_wW := proc(n::nonnegint,i::nonnegint)
 if i < n then
  return W[n,i]/W[n,0];
 elif i = n then
  return 1/W[n,0];
 else
  return 0;
 fi;
end:

dickson_Ww := proc(n,i)
 if i = 0 then
  return 1/w[n,n];
 elif i <= n then
  return w[n,i]/w[n,n];
 else
  return 0;
 fi;
end:

dickson_wx := (n,i) -> dickson_Wx(n,i)/dickson_Wx(n,0);

dickson_wv := proc(n,k)
 local L;
 L := combinat[choose]([seq(j,j=0..n-1)],k):
 return add(mul(v[i[t]]^(-2^(k-t)),t=1..k),i in L);
end:

dickson_wv_alt := proc(n,k)
 option remember;
 local u;

 if k > n or k < 0 then return 0; fi;
 if k = 0 then return 1; fi;

 u := dickson_wv(n-1,k) + dickson_wv(n-1,k-1)^2/v[n-1];
 u := expand(modp(factor(u),2));
 return u;
end:

dickson_fw := (n) -> unapply(t + add(w[n,i] * t^(2^i),i=1..n),t);

mui_v_deg := (i) -> 1;

mui_vV := (i) -> V[i] / mul(V[j],j=0..i-1);
mui_Vv := (i) -> mul(v[j] ^ (2^max(i-j-1,0)),j=0..i);

mui_vx := (i) -> mui_Vx(i) / mul(mui_Vx(j),j=0..i-1);

mui_gv := (i) -> unapply(t + t^2/v[i],t);

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

check_admissible := proc(m::nonnegint)
 local B,BB,n;

 B := admissible_basis(m);

 _ASSERT(
  `and`(op(map(is_admissible,B))),
  "Admissible moomials are admissible"
 );

 _ASSERT(
  B = sort(B,admissible_lt),
  "Admissible monomials are sorted"
 );

 _ASSERT(
  B = map(comate,map(mate,B)),
  "comate o mate = 1"
 );

 n := nops(B);
 _ASSERT(
  {1,op(map(u -> steenrod_pairing(u,mate(u)),B))} = {1},
  "<A,mate(A)> = 1"
 );

 _ASSERT(
  {0,seq(seq(steenrod_pairing(B[j],mate(B[i])),j=i+1..n),i=1..n)} = {0},
  "<A,mate(B)> = 0 for A > B"
 );

 BB := {seq(seq([u,v],v in B),u in B)};
 BB := select(uv -> steenrod_length(uv[1]) < steenrod_length(uv[2]),BB);
 BB := map(uv -> steenrod_pairing(uv[1],mate(uv[2])), BB);
 _ASSERT(
  BB = {0},
  "<A,mate(B)> = 0 for len(A) < len(B)"
 );

end:

check_adem := proc(m::nonnegint)
 local err;

 err :=
 {0, seq(seq(
      steenrod_pairing(adem_relation(i,m-i),mate(u)),
     i=0..m),u in admissible_basis(m))};

 _ASSERT(err = {0},"Adem relations are compatible with pairing");
end:

check_milnor_Q := proc(m)
 local i,Q;

 for i from 0 to m do Q[i] := milnor_Q(i); od;

 _ASSERT(
  {0,seq(adem_mul(Q[i],Q[i]),i=0..m)} = {0},
  "Q_i^2 = 0"
 );

 _ASSERT(
  {0,seq(seq(modp(adem_mul(Q[i],Q[j])+adem_mul(Q[j],Q[i]),2),j=i+1..m),i=0..m)} = {0},
  "Q_i Q_j = Q_j Q_i"
 );

 _ASSERT(
  {0,seq(modp(eval(adem_reduce(cartan_psi(Q[i]) + bar(Sq(),Q[i]) + bar(Q[i],Sq()))),2),i=0..m)} = {0},
  "Q_i is primitive"
 );
end:

check_two_power := proc(m)
 local B,err;

 B := [seq(seq(seq(Sq(i,j,k),k=0..m),j=0..m),i=0..m)];

 err := {0,op(map(u -> adem_reduce(u + two_power_reduce(u)),B))};

 _ASSERT(err = {0},"Two-power reduction is consistent");
end:

check_bullett_macdonald := proc(m)
 local s,t;

 _ASSERT(
  adem_reduce(bullett_macdonald_series(m,s,t)) = 0,
  "Bullett-Macdonald series"
 );

 _ASSERT(
  {0,seq(seq(adem_reduce(bullett_macdonald_relation(i,j)),j=0..20),i=0..20)} = {0},
  "Bullett-Macdonald relations"
 );

 _ASSERT(
  {0,seq(seq(adem_reduce(singer_relation(p,q)),p=0..2*q),q=0..15)} = {0},
  "Singer relations"
 );
end:

check_dickson := proc(m::nonnegint)
 local t,err;

 _ASSERT(
  modp(expand(dickson_fx(m)(t) - add(dickson_Wx(m,i) * t^(2^i),i=0..m)),2) = 0,
  "The Dickson polynomial is additive"
 );

 _ASSERT(
  modp(expand(dickson_Wx(m,0) + mul(mui_Vx(i),i=0..m-1)),2) = 0,
  "W_{m0} = prod_{i<m} V_i"
 );

 _ASSERT(
  {0,seq(modp(expand(
      dickson_Wx(m,k) + mui_Vx(m-1) * dickson_Wx(m-1,k) + dickson_Wx(m-1,k-1)^2
     ),2),k=1..m-1)} = {0},
  "W_{mk} = V_{m-1} W_{m-1,k} + W_{m-1,k-1}^2"
 );

 _ASSERT(
  modp(expand(dickson_fx(m)(t) + mui_gx(m-1)(dickson_fx(m-1)(t))),2) = 0,
  "f_m(t) = g_{m-1}(f_{m-1}(t))"
 );

end:

check_rules := proc(m)
 local Wx_rule, wx_rule, WV_rule, wv_rule,
       Ww_rule, wW_rule, Vx_rule, vx_rule, Vv_rule, vV_rule;

 Wx_rule := {seq(W[m,i] = dickson_Wx(m,i),i=0..m+1)}:
 wx_rule := {seq(w[m,i] = dickson_wx(m,i),i=0..m+1)}:
 WV_rule := {seq(W[m,i] = dickson_WV(m,i),i=0..m  )}:
 wv_rule := {seq(w[m,i] = dickson_wv(m,i),i=0..m+1)}:
 Ww_rule := {seq(W[m,i] = dickson_Ww(m,i),i=0..m+1)}:
 wW_rule := {seq(w[m,i] = dickson_wW(m,i),i=0..m+1)}:
 Vx_rule := {seq(V[i] = mui_Vx(i),i=0..m+1)}:
 vx_rule := {seq(v[i] = mui_vx(i),i=0..m+1)}:
 Vv_rule := {seq(V[i] = mui_Vv(i),i=0..m+1)}:
 vV_rule := {seq(v[i] = mui_vV(i),i=0..m+1)}:

 _ASSERT(
  {seq(subs(Vv_rule,subs(vV_rule,v[i])) - v[i],i=0..m-1),
   seq(subs(vV_rule,subs(Vv_rule,V[i])) - V[i],i=0..m-1),
   seq(subs(Ww_rule,subs(wW_rule,w[m,i])) - w[m,i],i=1..m),
   seq(subs(wW_rule,subs(Ww_rule,W[m,i])) - W[m,i],i=0..m-1),
   seq(subs(Ww_rule,subs(wW_rule,w[m,i])) - w[m,i],i=1..m),
   seq(subs(vx_rule,subs(Vv_rule,V[i])) - subs(Vx_rule,V[i]),i=1..m),
   seq(subs(wx_rule,subs(Ww_rule,W[m,i])) - subs(Wx_rule,W[m,i]),i=0..m-1),
   seq(modp(factor(subs(vx_rule,subs(wv_rule,w[m,i])) - subs(wx_rule,w[m,i])),2),i=1..m),
   seq(modp(factor(subs(Vx_rule,subs(WV_rule,W[m,i])) - subs(Wx_rule,W[m,i])),2),i=0..m-1),
   0} = {0},
  "translation rules"
 );
end:


`bar/EA` := proc ()
 local i;
 for i from 2 to nargs do
  if args[i] = 1 then return 0 fi;
 od;
 return '`bar/EA`'(args);
end:

# The standard differential in the bar complex is `d/EA`

`d/EA` := (u) -> sort(expand(eval(subs(`bar/EA`=`d_bar/EA`,u))));

`d_bar/EA` := proc()
 local n,i,q,a;
 a := args;
 n := nargs;
 if n = 0 then
  return FAIL;
 elif n = 1 then
  return 0;
 else
  return
   add((-1)^i*`bar/EA`(a[1..i-1],a[i]*a[i+1],a[i+2..n]),i=1..n-1) +
    (-1)^n*`bar/EA`(a[1..n-1]);
 fi;
end:

# The shuffle product in the bar complex is `mu/EA`

`mu/EA` := proc()
 apply_linear_assoc(`mu0/EA`,`bar/EA`())(args);
end:

`mu0/EA` := proc(u,v)
 local n,m,uv,c,L,s,i;
 n := nops(u)-1;
 m := nops(v)-1;
 uv := [op(2..n+1,u),op(2..m+1,v)];
 c := op(1,u) * op(1,v);
 L := `list_elements/inverse_shuffles`(n,m);

 return add(`sgn/shuffles`(n,m)(s) *
             `bar/EA`(c,seq(uv[s[i]],i=1..n+m)),s in L):
end:

`mu_bar/EA` := proc()
 `mu/EA`(op(map(`bar/EA`,[args])));
end:

# We now give a chain homotopy of EA for the case where A is cyclic
# of infinite order generated by a.  This gives a retraction onto
# a subcomplex concentrated in degrees 0 and 1.

`s0/EA` := (a) -> proc(u)
 local n,k,s,i;
 if type(u,specfunc(anything,`bar/EA`)) then
  n := nops(u);
  if n <= 1 then return 0; fi;
  k := degree(op(n,u),a);
  if op(n,u) <> a^k then
   return FAIL;
  fi;
  if k >= 0 then
   return add((-1)^n*`bar/EA`(op(1..n-1,u),a^i,a),i=0..k-1);
  else
   return add((-1)^(n+1)*`bar/EA`(op(1..n-1,u),a^(-i),a),i=1..abs(k));
  fi:
 else
  return FAIL;
 fi;
end:

`s/EA` := (a) -> apply_linear(`s0/EA`(a));

`p0/EA` := (a) -> proc(u)
 local n,i,k;
 if type(u,specfunc(anything,`bar/EA`)) then
  n := nops(u);
  if n <= 1 then
   return u;
  elif n = 2 then
   k := degree(op(2,u),a);
   if op(n,u) <> a^k then
    return FAIL;
   fi;
   if k >= 0 then
    return add(`bar/EA`(a^i*op(1,u),a),i=0..k-1);
   else
    return add(-`bar/EA`(a^(-i)*op(1,u),a),i=1..abs(k));
   fi;
  else
   return 0;
  fi;
 else
  return FAIL;
 fi;

end:

`p/EA` := (a) -> apply_linear(`p0/EA`(a));

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

# Given elements a[i] in A we have elements 1 - a[i] in the group ring.
# The tensor product of these is represented by `bar/BA`(a[1],...,a[n])

`bar/BA` := proc ()
 local i;
 for i to nargs do
  if args[i] = 1 then return 0 fi;
 od;
 return '`bar/BA`'(args);
end:

# The standard differential in the bar complex is `d/BA`

`d/BA` := (u) -> sort(expand(eval(subs(`bar/BA`=`d_bar/BA`,u))));

`d_bar/BA` := proc()
 local n,i,q;
 n := nargs;
 if n = 0 then
  return 0;
 else
  return -`bar/BA`(args[2..n]) +
         (-1)^(n+1)*`bar/BA`(args[1..n-1]) +
         add((-1)^(i+1)*`bar/BA`(args[1..i-1],args[i]*args[i+1],args[i+2..n]),
             i=1..n-1);
 fi;
end:

# The shuffle product in the bar complex is `mu/BA`

`mu/BA` := proc()
 apply_linear_assoc(`mu0/BA`,`bar/BA`())(args);
end:

`mu0/BA` := proc(u,v)
 local n,m,uv,L,s,i;
 n := nops(u);
 m := nops(v);
 uv := [op(u),op(v)];
 L := `list_elements/inverse_shuffles`(n,m);

 return add(`sgn/shuffles`(n,m)(s) * `bar/BA`(seq(uv[s[i]],i=1..n+m)),s in L):
end:

`mu_bar/BA` := proc()
 `mu/BA`(op(map(`bar/BA`,[args])));
end:

`proj_bar/EA` := proc() `bar/BA`(args[2..-1]); end:
`lift_bar/BA` := proc() `bar/EA`(1,args); end:
`proj/EA/BA` := (u) -> eval(subs(`bar/EA` = `proj_bar/EA`,u));
`lift/BA/EA` := (u) -> eval(subs(`bar/BA` = `lift_bar/BA`,u));

######################################################################
# The element u = `tau/BA`(n,a) has du = n[a] - [a^n].
# Thus, if a^n = 1 then u is a 2-cycle modulo n.

`tau/BA` := proc(n,a)
 local k;
 add(-`bar/BA`(a^k,a),k=0..n-1);
end:

`zeta/BA` := proc(n,m,a)
 local i,j;
 - add(add(`bar/BA`(a^(m*i),a^j,a),j=0..m-1),i=0..n-1);
end:

# The element `sigma/BA`(n,a,b) is a chain of dimension 3.
# It is symmetric in a and b, and is a cycle if a^n = b^n = 1.

`sigma/BA` := proc(n,a,b)
 `mu/BA`(`tau/BA`(n, a), `bar/BA`(b)) +
 `mu/BA`(`tau/BA`(n, b), `bar/BA`(a))
end:

# The element u = `gamma/BA`(n,a) is a chain of dimension 2n+1.
# It is a cycle if a^n = 1.

`gamma/BA` := proc(n,k,a)
 local u,v,i;
 u := `bar/BA`(a);
 v := `tau/BA`(n,a);
 for i from 1 to k do
  u := `mu/BA`(u,v);
 od;
 u := expand(u/k!);
 return u;
end:

`xi/BA` := proc(n,m,a)
 local i,j;

 add(add(-`bar/BA`(a^i,a,a^j,a),i=1..m-1),j=1..n*m-1) +
 add(add(-`bar/BA`(a^m,a^(i*m),a^j,a),j=1..m-1),i=1..n-1);
end:

`rho/BA` := proc(n,a,b)
 `tau/BA`(n,a) +
 `tau/BA`(n,b) -
 `tau/BA`(n,a*b) +
 n*`bar/BA`(a, b);
end:

`omega/BA` := proc (n,a,b)
 local i,j;

 -add(add(`bar/BA`(a^i*b^j,b,a), j = i .. n-1), i = 0 .. n-1) +
  add(add(`bar/BA`(a^i*b^j,a,b), j = i+1 .. n-1), i = 0 .. n-2);
end:

######################################################################
# We now introduce the standard DGA for H_*(BZ/n).

# The k'th chain group is freely generated over Z[Z/n] by
# `e/EC`(n)(k,0).  The orbit of this consists of elements `e/EC`(n)(k,i).

`de/EC` := (n::posint) -> proc(k::nonnegint,i::nonnegint)
 local j;

 if k = 0 then
  return 0;
 elif modp(k,2) = 0 then
  return(add(`e/EC`(n)(k-1,j),j=0..n-1));
 else
  return `e/EC`(n)(k-1,modp(i+1,n)) - `e/EC`(n)(k-1,i);
 fi;
end:

`d/EC` := (n) -> (u) -> eval(subs(`e/EC` = `de/EC`,u));

`mu/EC` := (n) -> proc()
 apply_linear_assoc(`mu0/EC`(n),`e/EC`(n)(0,0))(args);
end:

`mu0/EC` := (n) -> proc(a,b)
 local ka,kb,ia,ib,la,lb;
 if type(a,specfunc(anything,`e/EC`(n))) and
    type(b,specfunc(anything,`e/EC`(n))) then
  ka,ia := op(a);
  kb,ib := op(b);
  if modp(ka,2) = 1 and modp(kb,2) = 1 then
   return 0;
  fi;
  la := floor(ka/2);
  lb := floor(kb/2);
  return binomial(la+lb,la) * `e/EC`(n)(ka+kb,modp(ia+ib,n));
 else
  return('`mu/EC`'(n)(args))
 fi;
end:

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

`de/BC` := (n::posint) -> proc(k::nonnegint)
 if k = 0 or modp(k,2) = 1 then
  return 0;
 else
  return n * `e/BC`(n)(k-1);
 fi;
end:

`d/BC` := (n) -> (u) -> eval(subs(`e/BC` = `de/BC`,u));

`mu/BC` := (n) -> proc()
 apply_linear_assoc(`mu0/BC`(n),`e/BC`(n)(0))(args);
end:

`mu0/BC` := (n) -> proc(a,b)
 local ka,kb,la,lb;
 if type(a,specfunc(anything,`e/BC`(n))) and
    type(b,specfunc(anything,`e/BC`(n))) then
  ka := op(a);
  kb := op(b);
  if modp(ka,2) = 1 and modp(kb,2) = 1 then
   return 0;
  fi;
  la := floor(ka/2);
  lb := floor(kb/2);
  return binomial(la+lb,la) * `e/BC`(n)(ka+kb);
 else
  return('`mu/BC`'(n)(args))
 fi;
end:

`e/BC/BA` := (n::posint) -> proc(k::nonnegint)
 option remember;

 if k = 0 then
  return `bar/BA`();
 elif k = 1 then
  return `bar/BA`(a);
 else
  return expand(`mu/BA`(`tau/BA`(n,a),`e/BC/BA`(n)(k-2))/floor(k/2));
 fi;
end:

`phi/BC/BA` := proc(u)
 eval(subs(`e/BC` = `e/BC/BA`,u));
end:

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

check_homology_BA := proc()
 local i,j,k,n,m,a,b,c,t,u,v,w,T,ok,err,exp_rel,diff_rel;

 ok := true;
 for i from 0 to 4 do
  for j from 0 to 4 do
   u := `bar/EA`(seq(a[m],m=1..i+1));
   v := `bar/EA`(seq(a[m],m=i+2..i+j+2));
   err := `mu/EA`(u,v) - (-1)^(i*j) * `mu/EA`(v,u);
   if err <> 0 then
    ok := false;
    break;
   fi;
  od:
  if not(ok) then break; fi;
 od:

 _ASSERT(ok,"`mu/EA` is graded-commutative");

 ok := true;
 for i from 0 to 4 do
  for j from 0 to 4 do
   for k from 0 to 4 do
    u := `bar/EA`(seq(a[m],m=1..i+1));
    v := `bar/EA`(seq(a[m],m=i+2..i+j+2));
    w := `bar/EA`(seq(a[m],m=i+j+3..i+j+k+3));
    err := `mu/EA`(`mu/EA`(u,v),w) - `mu/EA`(u,`mu/EA`(v,w));
    if err <> 0 then
     ok := false;
     break;
    fi;
   od:
   if not(ok) then break; fi;
  od:
  if not(ok) then break; fi;
 od:

 _ASSERT(ok,"`mu/EA` is associative");

 ok := true;
 for i from 0 to 3 do
  for j from 0 to 3 do
   u := `bar/EA`(seq(a[m],m=1..i+1));
   v := `bar/EA`(seq(a[m],m=i+2..i+j+2));
   err := `d/EA`(`mu/EA`(u,v)) - `mu/EA`(`d/EA`(u),v) - (-1)^i*`mu/EA`(u,`d/EA`(v));
   if err <> 0 then
    ok := false;
    break;
   fi;
  od:
  if not(ok) then break; fi;
 od:

 _ASSERT(ok,"`d/EA` and `mu/EA` satisfy the Leibniz rule");

 ok := true;
 for i from 0 to 4 do
  for j from 0 to 4 do
   u := `bar/BA`(seq(a[m],m=1..i));
   v := `bar/BA`(seq(a[m],m=i+1..i+j));
   err := `mu/BA`(u,v) - (-1)^(i*j) * `mu/BA`(v,u);
   if err <> 0 then
    ok := false;
    break;
   fi;
  od:
  if not(ok) then break; fi;
 od:

 _ASSERT(ok,"`mu/BA` is graded-commutative");

 ok := true;
 for i from 0 to 4 do
  for j from 0 to 4 do
   for k from 0 to 4 do
    u := `bar/BA`(seq(a[m],m=1..i));
    v := `bar/BA`(seq(a[m],m=i+1..i+j));
    w := `bar/BA`(seq(a[m],m=i+j+1..i+j+k));
    err := `mu/BA`(`mu/BA`(u,v),w) - `mu/BA`(u,`mu/BA`(v,w));
    if err <> 0 then
     ok := false;
     break;
    fi;
   od:
   if not(ok) then break; fi;
  od:
  if not(ok) then break; fi;
 od:

 _ASSERT(ok,"`mu/BA` is associative");

 ok := true;
 for i from 0 to 4 do
  for j from 0 to 4 do
   u := `bar/BA`(seq(a[m],m=1..i));
   v := `bar/BA`(seq(a[m],m=i+1..i+j));
   err := `d/BA`(`mu/BA`(u,v)) - `mu/BA`(`d/BA`(u),v) - (-1)^i*`mu/BA`(u,`d/BA`(v));
   if err <> 0 then
    ok := false;
    break;
   fi;
  od:
  if not(ok) then break; fi;
 od:

 _ASSERT(ok,"`d/BA` and `mu/BA` satisfy the Leibniz rule");

 n := 5;
 err := `d/BA`(`tau/BA`(n,a)) - n * `bar/BA`(a);
 exp_rel := `bar/BA`(a^n);
 err := err + exp_rel;

 _ASSERT(err = 0,"d(tau_n(a))");

 err :=
  `d/BA`(`mu/BA`(`tau/BA`(n,a),`bar/BA`(b))) - n * `mu_bar/BA`(a,b);
 exp_rel := `mu_bar/BA`(a^n,b);
 err := err + exp_rel;

 _ASSERT(err = 0,"d(tau_n(a) b)");

 _ASSERT(
  {seq(seq(
   `tau/BA`(i*j,a) - `tau/BA`(i,a^j) - i * `tau/BA`(j,a) - `d/BA`(`zeta/BA`(i,j,a)),
  j=1..4),i=1..4)} = {0},
  "tau_{ij}(a)"
 );

 err := `d/BA`(`sigma/BA`(n,a,b));
 exp_rel := `mu_bar/BA`(a^n,b) - `mu_bar/BA`(a,b^n);
 err := err + exp_rel;

 _ASSERT(err = 0,"d(sigma_n(a,b))");

 _ASSERT(`sigma/BA`(n,a,b) = `sigma/BA`(n,b,a),"sigma_n is symmetric");

 err :=
  `sigma/BA`(n,a,b*c) - `sigma/BA`(n,a,b) - `sigma/BA`(n,a,c) +
    `mu/BA`(`bar/BA`(a),`rho/BA`(n,b,c));
 diff_rel := - `mu/BA`(`tau/BA`(n,a),`bar/BA`(b,c));
 exp_rel  := - `mu/BA`(`bar/BA`(a^n),`bar/BA`(b,c));
 err := err + `d/BA`(diff_rel) + exp_rel;

 _ASSERT(err = 0,"First formula for sigma_n(a,bc)");

 err :=
  `sigma/BA`(n,a,b*c)-`sigma/BA`(n,a,b)-`sigma/BA`(n,a,c)+
   binomial(n+1,2)*`mu_bar/BA`(a,b,c);

 diff_rel := -(`mu/BA`(`bar/BA`(a),`omega/BA`(n,b,c))+
  	       `mu/BA`(`tau/BA`(n,a),`bar/BA`(b,c)));
 exp_rel :=
  - `mu/BA`(`bar/BA`(a^n),`bar/BA`(b,c)) -
  add(`bar/BA`(a,b^i,b)-`bar/BA`(a,b^i*c^n,b),i=0..n-1)-
  add(`bar/BA`(b^i,b,a)-`bar/BA`(b^i*c^n,b,a),i=0..n-1)+
  add(`bar/BA`(b^i,a,b)-`bar/BA`(b^i*c^n,a,b),i=0..n-1);

 err := err + `d/BA`(diff_rel) + exp_rel;

 _ASSERT(err = 0,"Second formula for sigma_n(a,bc)");

 for k from 1 to 5 do
  err := `d/BA`(`gamma/BA`(n,k,a));
  T := [[]]:
  for i from 1 to k-1 do
   T := [seq(seq([op(t),a,a^j],j=1..n-1),t in T)]:
  od:
  exp_rel := (-1)^k*add(`mu/BA`(`bar/BA`(op(t),a),`bar/BA`(a^n)),t in T);
  err := err + exp_rel;
  _ASSERT(err = 0,sprintf("d(gamma_{n,%d}(u))",k));
 od:

 _ASSERT(simplify(`sigma/BA`(n,a,a) - 2 * `gamma/BA`(n,1,a)) = 0,
         "sigma_n(a,a) = 2 gamma_{n,1}(a)");

 err :=
  `gamma/BA`(n,1,a*b) - `gamma/BA`(n,1,a) - `gamma/BA`(n,1,b) -
    `sigma/BA`(n,a,b);

 diff_rel :=
  n*`bar/BA`(a,b,a,b) -
  `mu/BA`(`bar/BA`(a,b),`tau/BA`(n,a*b)) +
  `mu/BA`(`omega/BA`(n,a,b),`bar/BA`(a)+`bar/BA`(b));

 exp_rel :=
  add(`bar/BA`(a^i,b,a) - `bar/BA`(a^i*b^n,b,a),i=0..n-1) -
  add(`bar/BA`(a^i,a,b) - `bar/BA`(a^i*b^n,a,b),i=0..n-1) -
  add(`bar/BA`(b,a^i,a) - `bar/BA`(b,a^i*b^n,a),i=0..n-1) -
  add(`bar/BA`(a,a^i,a) - `bar/BA`(a,a^i*b^n,a),i=0..n-1) -
 `mu/BA`(`bar/BA`(a^n*b^n),`bar/BA`(a,b));

 err := err + `d/BA`(diff_rel) + exp_rel;

 _ASSERT(err = 0,"gamma_{n,1}(ab)");

  _ASSERT(
  {seq(seq(
   `gamma/BA`(i,1,a^j) - j * `gamma/BA`(i*j,1,a) +
   `mu/BA`(`bar/BA`(a^(i*j)),`tau/BA`(j,a)) -
   `d/BA`(`xi/BA`(i,j,a)),
  j=1..4),i=1..4)} = {0},
  "gamma_{ij,1}(a)"
 );
end:

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

check_homology_BZ := proc()
 local U,i,j,u,du,sdu,su,dsu,pu,ok,err;

 U := [seq(`bar/EA`(a^j),j=-2..2)]:
 for i from 1 to 4 do
  U := [op(U),
	seq(seq(`bar/EA`(op(u),a^j),j=1..2),u in U),
	seq(seq(`bar/EA`(op(u),a^(-j)),j=1..2),u in U)]:
 od:

 ok := true;

 for u in U do
  du := `d/EA`(u);
  sdu := `s/EA`(a)(du);
  su := `s/EA`(a)(u);
  dsu := `d/EA`(su);
  pu := `p/EA`(a)(u);
  err := sdu + dsu - u + pu;
  if err <> 0 then
   ok := false;
   break;
  fi;
 od:

 _ASSERT(ok,"ds + ds = 1 - p",[u,du,sdu,su,dsu,pu]);
end:

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

check_homology_BC := proc()
 local n,ok,u,v,w,ku,kv,kw,err;

 n := 5;

 ok := true;
 for ku from 0 to 4 do
  for kv from 0 to 4 do
   u := `e/BC`(n)(ku);
   v := `e/BC`(n)(kv);
   err := `mu/BC`(n)(u,v) - (-1)^(ku*kv) * `mu/BC`(n)(v,u);
   if err <> 0 then
    ok := false;
    break;
   fi;
  od:
  if not(ok) then break; fi;
 od:

 _ASSERT(ok,"`mu_BC` is graded-commutative");

 ok := true;
 for ku from 0 to 4 do
  for kv from 0 to 4 do
   for kw from 0 to 4 do
    u := `e/BC`(n)(ku);
    v := `e/BC`(n)(kv);
    w := `e/BC`(n)(kw);
    err := `mu/BC`(n)(`mu/BC`(n)(u,v),w) - `mu/BC`(n)(u,`mu/BC`(n)(v,w));
    if err <> 0 then
     ok := false;
     break;
    fi;
   od:
   if not(ok) then break; fi;
  od:
 od:

 _ASSERT(ok,"`mu_BC` is associative",[u,v,w,err]);

 ok := true;
 for ku from 0 to 4 do
  for kv from 0 to 4 do
   u := `e/BC`(n)(ku);
   v := `e/BC`(n)(kv);
   err := `d/BC`(n)(`mu/BC`(n)(u,v)) - `mu/BC`(n)(`d/BC`(n)(u),v) - (-1)^ku * `mu/BC`(n)(u,`d/BC`(n)(v));
   if err <> 0 then
    ok := false;
    break;
   fi;
  od:
  if not(ok) then break; fi;
 od:

 _ASSERT(ok,"Leibniz rule for BC");
end:


make_octahedron_complex := proc()
 global octahedron_complex,cube_complex;
 local OC,CC,vO,vC,vOi,vCi,i,j,k,dp,CF,f,G,G0,G1,r,g,h,eqs,sol,sc,OS,s,t;

 CC := table():
 OC := table():

 CC["vertices"] := [seq(i,i=1..8)];
 OC["vertices"] := [seq(i,i=1..6)];

 vO := table([
  1 = [1,0,0], 2 = [0,1,0], 3 = [0,0,1], 4 = [0,0,-1], 5 = [0,-1,0], 6 = [-1,0,0]
 ]);

 vC := table([
  1 = [ 1, 1, 1], 2 = [ 1, 1,-1], 3 = [ 1,-1, 1], 4 = [ 1,-1,-1],
  5 = [-1, 1, 1], 6 = [-1, 1,-1], 7 = [-1,-1, 1], 8 = [-1,-1,-1]
 ]);

 vOi := table():
 vCi := table():

 for i from 1 to 6 do vOi[vO[i]] := i; od;
 for i from 1 to 8 do vCi[vC[i]] := i; od;

 OC["embedding_dim"] := 3;
 CC["embedding_dim"] := 3;

 OC["embedding"]            := eval(vO);
 OC["normalised_embedding"] := copy(vO);
 OC["dual_embedding"]       := copy(vO);

 CC["embedding"]            := eval(vC);
 CC["normalised_embedding"] := table([seq(i = vC[i] *~ (sqrt(3)/3), i = 1 .. 8)]);
 CC["dual_embedding"]       := table([seq(i = vC[i] /~ 3, i = 1 .. 8)]);

 dp := (u,v) -> add(u[i] * v[i],i=1..3);

 OC["faces"]   := [seq(select(i -> dp(vO[i],vC[j]) = 1,OC["vertices"]),j = 1..8)];
 CC["squares"] := [seq(select(j -> dp(vO[i],vC[j]) = 1,CC["vertices"]),i = 1..6)];

 OC["edges"] := {op(map(op,map(f -> [[f[1],f[2]],[f[1],f[3]],[f[2],f[3]]],OC["faces"])))};
 OC["edges"] := sort([op(OC["edges"])]);

 CC["short_edges"] := [[1,2],[1,3],[1,5],[1,6],
                      [2,4],[2,6],[3,4],[3,7],[5,6],[5,7],
		      [4,8],[5,8],[6,8],[7,8]];

 CC["long_edges"]  := [[1,4],[1,6],[1,7],[2,8],[3,8],[5,8]];

 CC["edges"] := sort([op(CC["short_edges"]),op(CC["long_edges"])]);
 sc := [1,6,4,2,7,5,3,8];
 CC["six_cycle"] := sc;

 CF := NULL;
 OS := NULL;
 for s in CC["squares"] do
  i := op({op(s)} minus {seq(sc[j],j in s)});
  if member(1,s) then
   CF := CF,[1,s[2],s[4]],[1,s[3],s[4]];
   OS := OS,[1,i,sc[i],sc[sc[i]]];
  else
   CF := CF,[s[1],s[2],8],[s[1],s[3],8];
   OS := OS,[sc[sc[i]],sc[i],i,8];
  fi;
 od:
 OS := [OS];

 CC["faces"] := sort([CF]);
 CC["oriented_squares"] := OS;
 CC["square_plot"] :=
   display(
    seq(polygon(map(j -> vC[j],OS[i]),colour=standard_colour(i)),i=1..6),
    scaling=constrained,axes=none);

 OC["max_simplices"] := OC["faces"];
 CC["max_simplices"] := CC["faces"];

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

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

 `plot/simplicial_complex`(OC);
 `plot/simplicial_complex`(CC);

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

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

 CC["short_edge_centres"] :=
  map(e -> (vC[e[1]] +~ vC[e[2]]) /~ 2,CC["short_edges"]);

 CC["square_centres"] :=
  map(f -> (vC[f[1]] +~ vC[f[2]] +~ vC[f[3]] +~ vC[f[4]]) /~ 4, CC["squares"]);

 f := (u) -> simplify(rationalize(u /~ sqrt(add(u[i]^2,i=1..3))));

 OC["poles"] := table([
  2 = map(f,OC["edge_centres"]),
  3 = map(f,OC["face_centres"]),
  4 = map(i -> f(vO[i]),OC["vertices"])
 ]);

 CC["poles"] := copy(OC["poles"]);

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

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

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

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

 G0 := [];
 G1 := [[2,4,1,3,6,8,5,7],[1,3,5,7,2,4,6,8]];
 G := [[1,2,3,4,5,6,7,8]];

 while G <> G0 do
  G0 := G;
  G := sort([op({seq(seq(`o/permutations`(8)(g,h),g in G1),h in G)})]);
 od:

 r := table([1 = 1, 2 = 2, 3 = 3, 4 = 4, 5 = 4, 6 = 3, 7 = 2, 8 = 1]):

 CC["vertex_action"]     := table():
 CC["short_edge_action"] := table():
 CC["square_action"]     := table():
 CC["rotation_matrix"]   := table():

 OC["vertex_action"]     := table():
 OC["edge_action"]       := table():
 OC["face_action"]       := table():
 OC["rotation_matrix"]   := table():

 for s in G do
  t := [r[s[1]],r[s[2]],r[s[3]],r[s[4]]];
  CC["vertex_action"][t] := s;
  OC["face_action"][t]   := s;

  CC["short_edge_action"][t] :=
   map(e -> CC["short_edge_index"][sort([s[e[1]],s[e[2]]])],CC["short_edges"]);

  CC["square_action"][t] :=
   map(e -> CC["square_index"][sort([s[e[1]],s[e[2]],s[e[3]],s[e[4]]])],CC["squares"]);

  OC["vertex_action"][t] := CC["square_action"][t];

  OC["edge_action"][t] :=
   map(e -> OC["edge_index"][sort([s[e[1]],s[e[2]]])],OC["edges"]);

  g := Matrix(3,3,[seq(x[i],i=1..9)]);
  eqs := map(op,[seq(convert(g . Vector(vC[i]) - Vector(vC[s[i]]),list),i = 1..8)]);
  sol := solve(eqs);
  CC["rotation_matrix"][t] := subs(sol,convert( g,listlist));
  OC["rotation_matrix"][t] := CC["rotation_matrix"][s];
 od:

 octahedron_complex := eval(OC);
 cube_complex := eval(CC);
 return eval(OC);
end:

make_octahedron_complex():

octosphere_complex := proc(n::nonnegint)
 local T,T0,E,v,x,i,j;

 T := eval(octahedron_complex);

 for i from 1 to n do
  T0 := eval(T);
  T := eval(`triangular_subdivision/simplicial_complex`(T0));
  T0 := eval(T);
  T := eval(`condense/simplicial_complex`(T0));
  E := T["embedding"];
  for v in T["vertices"] do
   x := E[v];
   x := evalf(x /~ sqrt(add(x[j]^2,j=1..3)));
   E[v] := x;
  od:
 od:

 return eval(T):
end:


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

(* This is the definition in the paper *)
th_f0 := (x, u, t) -> -27*Pi/(10*t) * (1 + 7*x^2/(108*t)):

(* Since we write this as an enhancement functional, we need to divide
   out the LDA prefactor. The paper also defines tau without one half *)
th_f := (x, u, t) -> -th_f0(x,u,2*t) / X_FACTOR_C:

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


make_platonic := proc()
 global platonic_complexes,tetrahedron_complex,cube_complex,
   octahedron_complex,dodecahedron_complex,icosahedron_complex;
 local AC,TC,CC,OC,DC,IC,t0,t1,t2,s0,s1,AV,p,q,u,v,ui,s,t,n,m,d,M,A5,dp,nm,dd,r,k,i,E,g,
       E0,E1,E2,F1,F2,F3,C0,P0,PP0,PM,pole_colours,c;

 AC := [seq(table(),i=1..5)];
 IC := eval(AC[1]); OC := eval(AC[2]); TC := eval(AC[3]); CC := eval(AC[4]); DC := eval(AC[5]);

 t0 := (sqrt(5) + 1)/2;
 t1 := (sqrt(5) - 1)/2;
 t2 := expand(t1^2);
 s0 := sqrt(2/(5 + sqrt(5)));
 s1 := sqrt(2/(5 - sqrt(5)));

 dp := (u,v) -> simplify(expand(add(u[i] * v[i],i=1..3)));
 nm := (u) -> simplify(sqrt(dp(u,u)));
 dd := (u,v) -> nm(u -~ v);

 AV := [
 [
  [  0, t2, t1],[  0, t2,-t1],[  0,-t2, t1],[  0,-t2,-t1],
  [ t1,  0, t2],[-t1,  0, t2],[ t1,  0,-t2],[-t1,  0,-t2],
  [ t2, t1,  0],[ t2,-t1,  0],[-t2, t1,  0],[-t2,-t1,  0]
 ],
 [
  [ 1, 0, 0],[ 0, 1, 0],[ 0, 0, 1],
  [ 0, 0,-1],[ 0,-1, 0],[-1, 0, 0]
 ],
 [
  [ 1, 1, 1],[ 1,-1,-1],[-1, 1,-1],[-1,-1, 1]
 ],
 [
  [ 1, 1, 1],[ 1,-1,-1],[-1, 1,-1],[-1,-1, 1],
  [-1, 1, 1],[ 1,-1, 1],[ 1, 1,-1],[-1,-1,-1]
 ],
 [
  [  1,  1,  1],[  1, -1, -1],[ -1,  1, -1],[ -1, -1,  1],
  [  0, t0, t1],[  0, t0,-t1],[  0,-t0, t1],[  0,-t0,-t1],
  [ t1,  0, t0],[-t1,  0, t0],[ t1,  0,-t0],[-t1,  0,-t0],
  [ t0, t1,  0],[ t0,-t1,  0],[-t0, t1,  0],[-t0,-t1,  0],
  [ -1,  1,  1],[  1, -1,  1],[  1,  1, -1],[ -1, -1, -1]
 ]];

 for p from 1 to 5 do
  n := nops(AV[p]);
  AC[p]["num_vertices"] := n;
  AC[p]["vertices"] := [seq(i,i=1..AC[p]["num_vertices"])];
  r := simplify(sqrt(dp(AV[p][1],AV[p][1])));
  AC[p]["vertex_radius"] := r;
  AC[p]["embedding"] := table([seq(i = AV[p][i],i=1..n)]);
  AC[p]["normalised_embedding"] := table([seq(i = evalf(AV[p][i] /~ r),i=1..n)]);
  AC[p]["embedding_index"] := table():
  for i from 1 to n do
   AC[p]["embedding_index"][AV[p][i]] := i;
  od:
 od:

 for p from 1 to 5 do
  q := 6 - p;
  u := AV[p]; v := AV[q]; n := nops(u); m := nops(v);
  k := `if`(p = 5,"pentagons",`if`(p = 4,"squares","faces"));
  AC[p][k] := [seq(select(i -> dp(u[i],v[j]) = -1,[seq(i,i=1..n)]),j = 1..m)];
  AC[p][cat("oriented_",k)] :=
   [seq(orient_face(f,AC[p]["embedding"]),f in AC[p][k])];
  AC[p]["facets"] := AC[p][k];
  AC[p]["oriented_facets"] := AC[p][cat("oriented_",k)];
  AC[p][cat("num_",k)] := m;
  AC[p]["num_facets"] := m;
  AC[p]["plot"] := display(
   seq(polygon(map(j -> u[j],AC[p]["oriented_facets"][i]),colour=standard_colour(i)),i=1..m),
   scaling=constrained,axes=none);
  AC[p]["grey_plot"] := display(
   seq(polygon(map(j -> u[j],AC[p]["oriented_facets"][i]),colour=grey),i=1..m),
   scaling=constrained,axes=none);
  AC[p]["wireframe_plot"] := display(
   seq(polygon(map(j -> u[j],AC[p]["oriented_facets"][i]),colour=grey,style=wireframe),i=1..m),
   scaling=constrained,axes=none);
 od;

 for p from 1 to 3 do
  u := AV[p];
  E := {op(map(op,map(f -> [[f[1],f[2]],[f[1],f[3]],[f[2],f[3]]],AC[p]["faces"])))};
  AC[p]["edges"] := sort([op(E)]);
  AC[p]["short_edges"] := AC[p]["edges"];
  AC[p]["long_edges"] := [];
  r := dd(u[E[1][1]],u[E[1][2]]);
  AC[p]["short_edge_length"] := r;
 od:

 u := AV[4];
 r := 2;
 CC["short_edge_length"] := r;
 CC["short_edges"] :=
  select(e -> dd(u[e[1]],u[e[2]]) = r,[seq(seq([i,j],j=i+1..8),i=1..8)]);
 CC["long_edges"] := [[1,2],[1,3],[1,4],[5,8],[6,8],[7,8]];
 CC["edges"] := sort([op(CC["short_edges"]),op(CC["long_edges"])]);
 CC["faces"] := [];

 u := AV[5];
 r := sqrt(5) - 1;
 DC["short_edge_length"] := r;
 DC["short_edges"] :=
  select(e -> dd(u[e[1]],u[e[2]]) = 2,[seq(seq([i,j],j=i+1..20),i=1..20)]);

 A5 := eval(alternating_five);

 for p from 1 to 5 do
  u := AV[p];
  ui := AC[p]["embedding_index"];
  AC[p]["rotation_group"] := NULL;
  AC[p]["vertex_permutation"] := table();
  for g in A5["elements"] do
   M := Matrix(A5["matrix"][g]);
   s := [seq(ui[expand(convert(M . Vector(u[i]),list))],i=1..nops(u))];
   if type(s,list(posint)) then
    AC[p]["rotation_group"] := AC[p]["rotation_group"],g;
    AC[p]["vertex_permutation"][g] := s;
   fi;
  od:
  AC[p]["rotation_group"] := [AC[p]["rotation_group"]];
 od:

 for p from 2 to 4 do
  AC[p]["poles"] := table([2 = {}, 3 = {}, 5 = {}]);

  for g in AC[p]["rotation_group"] do
   if g = [1,2,3,4,5] then continue; fi;
   d := A5["element_order"][g];
   AC[p]["poles"][d] := {op(AC[p]["poles"][d]),A5["axis"][g],-~ A5["axis"][g]};
  od;

  for d in [2,3,5] do
   AC[p]["poles"][d] := [op(AC[p]["poles"][d])];
  od:
 od:

 PM := [1,-1];
 IC["poles"] := table():
 IC["poles"][2] := [
  [1,0,0],[0,1,0],[0,0,1],[-1,0,0],[0,-1,0],[0,0,-1],
  seq(seq(seq([i,j * t1,k * t0]/~2,k in PM),j in PM),i in PM),
  seq(seq(seq([k * t0,i,j * t1]/~2,k in PM),j in PM),i in PM),
  seq(seq(seq([j * t1,k * t0,i]/~2,k in PM),j in PM),i in PM)
 ];

 IC["poles"][3] := expand([seq(DC["embedding"][i] *~ sqrt(3)/3,i=1..20)]);

 IC["poles"][5] := [
  [  0, s0, s1],[  0, s0,-s1],[  0,-s0, s1],[  0,-s0,-s1],
  [ s1,  0, s0],[-s1,  0, s0],[ s1,  0,-s0],[-s1,  0,-s0],
  [ s0, s1,  0],[ s0,-s1,  0],[-s0, s1,  0],[-s0,-s1,  0]
 ];

 DC["poles"] := copy(IC["poles"]);

 E0 := NULL:
 E1 := NULL:
 E2 := NULL:
 F1 := NULL:
 F2 := NULL:
 F3 := NULL:
 for s in DC["rotation_group"] do
  t := DC["vertex_permutation"][s];
  E0 := E0,sort([t[1],t[ 5]]);
 od:
 for s in CC["rotation_group"] do
  t := DC["vertex_permutation"][s];
  E1 := E1,sort([t[1],t[10]]);
  E2 := E2,sort([t[1],t[17]]);
  F1 := F1,sort([t[1],t[ 9],t[10]]);
  F2 := F2,sort([t[1],t[ 5],t[17]]);
  F3 := F3,sort([t[1],t[10],t[17]]);
 od:
 E0 := sort([op({E0})]);
 E1 := sort([op({E1})]);
 E2 := sort([op({E2})]);
 F1 := sort([op({F1})]);
 F2 := sort([op({F2})]);
 F3 := sort([op({F3})]);

 DC["short_edges"] := E0;
 DC["long_edges_a"] := E1;
 DC["long_edges_b"] := E2;
 DC["edges"] := sort([op(E0),op(E1),op(E2)]);

 DC["faces_a"] := F1;
 DC["faces_b"] := F2;
 DC["faces_c"] := F3;
 DC["faces"] := sort([op(F1),op(F2),op(F3)]);

 DC["inscribed_cubes"] := [
  [3, 5, 8, 10, 11, 13, 16, 18],
  [4, 5, 8,  9, 12, 14, 15, 19],
  [2, 6, 7,  9, 12, 13, 16, 17],
  [1, 6, 7, 10, 11, 14, 15, 20],
  [1, 2, 3,  4, 17, 18, 19, 20]
 ];

 v := DC["embedding"];

 DC["all_edges_plot"] :=
  display(
   seq(line(v[e[1]],v[e[2]],colour=blue) ,e in DC["short_edges"]),
   seq(line(v[e[1]],v[e[2]],colour=red)  ,e in DC["long_edges_a"]),
   seq(line(v[e[1]],v[e[2]],colour=green),e in DC["long_edges_b"]),
   scaling=constrained,axes=none
  );

 DC["triangle_plot"] :=
  display(
   seq(polygon([v[e[1]],v[e[2]],v[e[3]]],colour=blue ),e in DC["faces_a"]),
   seq(polygon([v[e[1]],v[e[2]],v[e[3]]],colour=red  ),e in DC["faces_b"]),
   seq(polygon([v[e[1]],v[e[2]],v[e[3]]],colour=green),e in DC["faces_c"]),
   scaling=constrained,axes=none
  );

 PP0 := NULL:
 for k from 1 to 5 do
  C0 := DC["inscribed_cubes"][k];
  E0 := [seq(seq([C0[i],C0[j]],j=i+1..8),i=1..7)]:
  E0 := select(e -> simplify(expand(dd(v[e[1]],v[e[2]]))) = 2,E0);
  P0 := display(seq(line(v[e[1]],v[e[2]],colour=standard_colour(k)),e in E0),
                scaling=constrained,axes=none);
  PP0 := PP0,P0;
 od:
 DC["cubes_plot"] := display(DC["grey_plot"],PP0);

 pole_colours := table([2 = green, 3 = red, 5 = blue]):

 IC["pole_length"] := table([2 = 0.8, 3 = 0.8, 5 = 0.9]):
 OC["pole_length"] := table([2 = 1.2, 3 = 0.8, 5 = 0.9]):
 TC["pole_length"] := table([2 = 1.3, 3 = 1.2, 5 = 0.9]):
 CC["pole_length"] := table([2 = 1.3, 3 = 2.0, 5 = 0.9]):
 DC["pole_length"] := table([2 = 2.0, 3 = 2.0, 5 = 1.7]):

 for p from 1 to 5 do
  AC[p]["unit_pole_plot"] := table():
  AC[p]["pole_plot"] := table():
  for d in [2,3,5] do
   r := AC[p]["pole_length"][d];
   c := pole_colours[d];
   AC[p]["pole_plot"][d] :=
     map(u -> line(-r *~ u,r *~u,colour = c,thickness=4),AC[p]["poles"][d]);
   AC[p]["unit_pole_plot"][d] :=
     map(u -> line(-1.1 *~ u,1.1 *~u,colour = c,thickness=4),AC[p]["poles"][d]);
  od:
  AC[p]["all_poles_plot"] :=
   display(seq(op(AC[p]["pole_plot"][d]),d in [2,3,5]),
	   scaling=constrained,axes=none);
  AC[p]["all_unit_poles_plot"] :=
   display(seq(op(AC[p]["unit_pole_plot"][d]),d in [2,3,5]),
	   scaling=constrained,axes=none);
  if p >= 2 and p <= 4 then
   AC[p]["sample_poles_plot"] :=
    display(AC[p]["pole_plot"][2][1],
	    AC[p]["pole_plot"][3][1],
	    scaling=constrained,axes=none);
  else
   AC[p]["sample_poles_plot"] :=
    display(AC[p]["pole_plot"][2][1],
	    AC[p]["pole_plot"][3][1],
	    AC[p]["pole_plot"][5][1],
	    scaling=constrained,axes=none);
  fi:
 od:

 IC["dual_factor"] := 3;
 OC["dual_factor"] := 3;
 TC["dual_factor"] := 3;
 CC["dual_factor"] := 1;
 DC["dual_factor"] := 5 - 2 * sqrt(5);

 for p from 1 to 5 do
  q := 6 - p;
  v := AC[q]["embedding"];
  m := nops(AC[q]["oriented_facets"]);
  r := AC[p]["dual_factor"];

  AC[p]["dual_plot"] := display(
   AC[p]["wireframe_plot"],
   seq(polygon(map(j -> evalf(v[j] /~ (-r)),AC[q]["oriented_facets"][i]),colour=standard_colour(i)),i=1..m),
   scaling=constrained,axes=none
  );
 od:

 platonic_complexes   := eval(AC);
 icosahedron_complex  := eval(IC);
 octahedron_complex   := eval(OC);
 tetrahedron_complex  := eval(TC);
 cube_complex         := eval(CC);
 dodecahedron_complex := eval(DC);
 NULL;
end:


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

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

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

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

(* the extra factor of 1/2 comes from the spin sum rule *)
rlda_a1 := (5/4) * 3*Pi * params_a_prefactor/X_FACTOR_C:

(* the functional is inherently unstable but that's how it is *)
rlda_f := (x, u, t) -> rlda_a1/(2*t - u/4):

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


# https://www.reddit.com/r/adventofcode/comments/ra88up/2021_day_6_part_4_day_googolplex/
# Calculate the population at the googolplex generation mod nextprime(10^8)
input := "4,1,7,7,4,7,6,2,5,4,3,1,4,7,2,4,5,2,2,1,3,7,4,5,1,3,3,5,5,7,6,3,3,3,7,7,5,4,6,3,1,7,6,1,3,5,1,2,6,6,5,5,4,3,2,6,5,3,7,5,4,2,1,3,6,2,7,2,2,6,5,6,7,6,3,3,1,1,1,3,7,3,3,5,4,7,2,1,4,4,1,2,5,5,4,3,4,4,7,4,2,1,2,2,4":
tally := table(sparse=0,Statistics:-Tally(StringTools:-Split(input,","))):
lanternfish := Vector([seq(tally[cat("",i)],i=0..8)]):

U := Matrix([
 [0, 1, 0, 0, 0, 0, 0, 0, 0],
 [0, 0, 1, 0, 0, 0, 0, 0, 0],
 [0, 0, 0, 1, 0, 0, 0, 0, 0],
 [0, 0, 0, 0, 1, 0, 0, 0, 0],
 [0, 0, 0, 0, 0, 1, 0, 0, 0],
 [0, 0, 0, 0, 0, 0, 1, 0, 0],
 [1, 0, 0, 0, 0, 0, 0, 1, 0],
 [0, 0, 0, 0, 0, 0, 0, 0, 1],
 [1, 0, 0, 0, 0, 0, 0, 0, 0]]):

minpoly := LinearAlgebra:-MinimalPolynomial(U,x);
# x^9 - x^2 - 1

q := 100000007:

# look for a power of x that is 1 modulo the minpoly in F_q[x]
for i from 1 to 100 do
   qq := q^i-1;
   # x^qq ( mod minpoly ) in F_q[x]
   if Powmod(x, qq, minpoly, x) mod q = 1 then
        break;
   end if;
end do:
i, qq;
# i=8, qq=10000005600001372000192080016807000941192032941720658834405764800

# qq is the period of powers of U mod q

# calculate googolplex mod qq
n := Power(10, 10^100) mod qq;
# 7308711993169798294967234678458568672383628022002873653735230400
# so U^googolplex = U^n mod q

# I like computing powers of U using the minpoly
g := Powmod(x, n, minpoly, x) mod q;
# 46714893*x^8+75968618*x^7+86556894*x^6+35145482*x^5+7013179*x^4
#  +30172454*x^3+81311138*x^2+30235098*x+46689635

# g(U) = U^googolplex mod q

add(eval(g, x=U) . lanternfish) mod q;
# 52292574


make_fgl_Lazard := proc(d)
 global a,m,ma,am;
 local T,u,x,y,q,i,k,Fm,sol;

 T := table();
 T["degree"] := d;
 Order := d+2;

 T["log_m"] := unapply(x + add(m[i]*x^(i+1),i=1..d-1),x);
 T["exp_m"] :=
   unapply(
   convert(
    solve(x = series(T["log_m"](y) + sin(y)^(d+1),y=0,d+1),y),
    polynom,x
   ),
   x
  );

 T["sum_m"] :=
  unapply(
   subs(u=1,expand(convert(series(T["exp_m"](T["log_m"](u*x)+T["log_m"](u*y)),u=0,d+1),polynom,u))),
   x,y
  ):

 Fm := T["sum_m"](x,y);
 am[1] := m[1];
 for k from 2 to d-1 do
  q := igcd_alt([seq(binomial(k+1,i),i=1..k)])[2];
  am[k] := -add(q[i]*coeff(coeff(Fm,x,i),y,k+1-i),i=1..k);
 od:
 sol := solve({seq(a[i]=am[i],i=1..d-1)},{seq(m[i],i=1..d-1)}):
 for i from 1 to d-1 do ma[i] := subs(sol,m[i]); od:

 T["log_a"] := unapply(collect(expand(eval(subs(m = ma,T["log_m"](x)))),x),x);
 T["exp_a"] := unapply(collect(expand(eval(subs(m = ma,T["exp_m"](x)))),x),x);
 T["sum_a"] := unapply(collect(expand(eval(subs(m = ma,T["sum_m"](x,y)))),{x,y}),x,y);

 return eval(T);
end:


# Acceleration Calculation for the Robot based on MDH frames
# Introduction
# Berechnung der Beschleunigung von Koordinatensystemen und Schwerpunkten
#
# Dateiname:
# robot -> Berechnung für allgemeinen Roboter
# tree -> Berechnung für eine beliebige Baumstruktur (ohne Schleifen)
# acceleration_mdh_angles  -> Berechnung der Beschleunigung der MDH-Koordinaten (Drehung und Verschiebung in z-Richtung. Diese können zeitabhängig sein.)
# Sources
# [KhalilDombre2002] Modeling, Identification and Control of Robots
# [Ortmaier2014] Vorlesungsskript Robotik I (WS 2014/15)
# 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("Generiere Beschleunigung für %s\n", robot_name):
read sprintf("../codeexport/%s/tmp/tree_floatb_definitions", robot_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
;
# Term-Vereinfachungen einstellen
if not assigned(simplify_options) or simplify_options(5)=-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(5): # fünfter Eintrag ist für Beschleunigung
end if:

# Ergebnisse der Geschwindigkeit laden
read sprintf("../codeexport/%s/tmp/velocity_mdh_angles_maple.m", robot_name):
thetaD:= thetaD:
dD:=dD:
# Lade Marker für Existenz kinematischer Zwangsbedingungen (Verknüpfung von MDH-Gelenkwinkeln durch verallgemeinerte Koordinaten)
read sprintf("../codeexport/%s/tmp/kinematic_constraints_maple_inert.m", robot_name):
kin_constraints_exist := kin_constraints_exist:

# Zeitableitung der Drehwinkelgeschwindigkeit berechnen
# Im Falle kinematischer Zwangsbedingungen wurden diese schon im Arbeitsblatt für die Geschwindigkeit eingesetzt
# und müssen hier nicht mehr betrachtet werden.
# Zeitableitung der Geschwindigkeit in Abhängigkeit der verallgemeinerten Koordinaten
thetaD_qt := thetaD:
dD_qt := dD:
thetaDD := Matrix(NJ, 1):
dDD:= Matrix(NJ, 1):

for i from 1 to NJ do:
  thetaDD(i,1):= diff(thetaD_qt(i,1),t):
  dDD(i,1)    := diff(dD_qt(i,1),t):
end do:
if kin_constraints_exist then # ist nur rechenaufwändig, wenn ZB vorliegen
  printf("%s. Zweite 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(thetaDD)+length(dDD):
  printf("%s: Vereinfache MDH-Beschleunigungen. 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(thetaDD(i,1)) + length(dDD(i,1)): # es kann sowieso nur einer der beiden Informationen enthalten
    printf("%s: Vereinfache MDH-Beschl. %d. Länge: %d.\n", \
      FormatTime("%Y-%m-%d %H:%M:%S"), i, tmp_l1):
    thetaDD(i,1) := simplify2(thetaDD(i,1)):
    dDD(i,1)     := simplify2(dDD(i,1)):
    tmp_t2 := time():
    tmp_l2 := length(thetaDD(i,1)) + length(dDD(i,1)):
    printf("%s: MDH-Beschl. %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(thetaDD)+length(dDD):
  printf("%s: MDH-Beschleunigungen 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 Beschleunigungen exportieren
if codegen_act then
  MatlabExport(convert_t_s(thetaDD), sprintf("../codeexport/%s/tmp/acceleration_mdh_angles_matlab.m", robot_name), codegen_opt):
  MatlabExport(convert_t_s(dDD), sprintf("../codeexport/%s/tmp/acceleration_mdh_deltaz_matlab.m", robot_name), codegen_opt):
end if:
# Ausdruck für Maple speichern
save thetaDD, dDD, sprintf("../codeexport/%s/tmp/acceleration_mdh_angles_maple.m", robot_name):
save thetaDD, dDD, sprintf("../codeexport/%s/tmp/acceleration_mdh_angles_maple", robot_name):


(*
 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: mgga_exc *)
(* prefix:
  mgga_c_b94_params *params;

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

(* replace: "br89_x\(" -> "xc_mgga_x_br89_get_x(" *)

$define mgga_x_br89_params
$include "mgga_x_br89.mpl"

(* This is a fake parameter in libxc *)
params_a_at := 0:

(* Equation 9, same-spin correlation *)
b94_css := (rs, z, xs, us, ts) ->
  - 0.01 * (1 + z)^(8/3) * 2^(-8/3) * n_total(rs)^(5/3) * (2*ts - xs^2/4)
  * b94_zss(params_a_css, br89_f, rs, z, xs, us, ts)^4 * (
    1 - 2*log(1 + b94_zss(params_a_css, br89_f, rs, z, xs, us, ts)/2)
      / b94_zss(params_a_css, br89_f, rs, z, xs, us, ts)
  ):

(* Same-spin correlation overall *)
b94_par := (rs, z, xs0, xs1, us0, us1, ts0, ts1) ->
  + my_piecewise3(screen_dens(rs,  z), 0, b94_css(rs, z_thr( z), xs0, us0, ts0))
  + my_piecewise3(screen_dens(rs, -z), 0, b94_css(rs, z_thr(-z), xs1, us1, ts1)):

(* Equation 8, opposite-spin correlation *)
b94_cab := (rs, z, xs0, xs1, us0, us1, ts0, ts1) ->
  - 0.8 * (1 - z^2)/4 * n_total(rs)
  * b94_zab(params_a_cab, br89_f, rs, z, xs0, xs1, us0, us1, ts0, ts1) * (
     b94_zab(params_a_cab, br89_f, rs, z, xs0, xs1, us0, us1, ts0, ts1)
     - log(1 + b94_zab(params_a_cab, br89_f, rs, z, xs0, xs1, us0, us1, ts0, ts1))
  ):

(* Whole functional *)
b94_c_f := (rs, z, xs0, xs1, us0, us1, ts0, ts1) ->
  + b94_cab(rs,  z, xs0, xs1, us0, us1, ts0, ts1)
  + b94_par(rs,  z, xs0, xs1, us0, us1, ts0, ts1):

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


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

`is_element/cubes` := (k::posint) -> (A::set) -> proc(f)
 local n,i,j;
 global reason;

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

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

 n := nops(A);
 for i from 1 to n do
  if not `is_element/single_cubes`(k)(f[A[i]]) then
   reason := [convert(procname,string),"f(a) is not a single cube",A[i],f(A[i]),reason];
   return false;
  fi;

  for j from 1 to i-1 do
   if `overlap/single_cubes`(k)(f[A[j]],f[A[i]]) then
    reason := [convert(procname,string),"subcubes f(a) and f(b) overlap",A[i],A[j],f(A[i]),f(A[j])];
    return false;
   fi;
  od;
 od;

 return true;
end;

`is_equal/cubes` := (k::posint) -> (A::set) -> proc(f,g)
 local a;
 global reason;

 for a in A do
  if not `is_equal/single_cubes`(k)(f[a],g[a]) then
   reason := [convert(procname,string),"f[a] <> g[a]",a,f[a],g[a]];
   return false;
  fi;
 od;

 return true;
end;

`is_leq/cubes` := NULL;

`random_element/cubes` := (N::posint) -> (A::set) -> proc()
 local d,f,a;

 d := 5;

 while true do
  d := d+1;
  f := table();
  for a in A do
   f[a] := `random_element/single_cubes`(N)(d);
  od;

  if `is_element/cubes`(N)(A)(f) then
   return(eval(f));
  fi;

  if d > 1000 then return FAIL; fi;
 od;
end;

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

`draw/cubes` := (A::set) -> proc(f)
 local P,a;

 P := rectangle([0,0],[1,1],colour=blue,style=line);
 for a in A do
  P := P,rectangle(f[a][1],f[a][2],colour=red);
 od;
 display(P,scaling=constrained,axes=none);
end;

`centres/cubes` := (k::posint) -> (A::set) -> proc(f)
 local g,a;

 g := table();
 for a in A do
  g[a] := `centre/single_cubes`(k)(f[a]);
 od;

 return eval(g);
end;


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

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

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

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

scan_p     := x -> X2S^2*x^2:
scan_alpha := (x, t) -> (t - x^2/8)/K_FACTOR_C:

(* The interpolating functions are nasty for a -> 1, so we need to
   truncate them. The natural choice is to cut off the functions to
   zero when the exponential term reaches machine epsilon.

   The left cutoff is |log epsilon|/(|log epsilon| + c1) < 1
   and the right one is (|log epsilon| + c2)/|log epsilon| > 1,
   so we don't even really need the step function.
*)
scan_f_alpha_left0 := a -> exp(-params_a_c1*a/(1 - a)):
scan_f_alpha_left_cutoff := -log(DBL_EPSILON)/(-log(DBL_EPSILON) + params_a_c1):
scan_f_alpha_left := a -> my_piecewise3(a > scan_f_alpha_left_cutoff, 0, scan_f_alpha_left0(m_min(scan_f_alpha_left_cutoff, a))):

scan_f_alpha_right0 := a -> -params_a_d*exp(params_a_c2/(1 - a)):
scan_f_alpha_right_cutoff := (-log(DBL_EPSILON/abs(params_a_d)) + params_a_c2)/(-log(DBL_EPSILON/abs(params_a_d))):
scan_f_alpha_right := a -> my_piecewise3(a < scan_f_alpha_right_cutoff, 0, scan_f_alpha_right0(m_max(scan_f_alpha_right_cutoff, a))):
scan_f_alpha := a -> my_piecewise3(
  a <= 1, scan_f_alpha_left(a), scan_f_alpha_right(a)
  ):

scan_h1x := x -> 1 + params_a_k1*(1 - params_a_k1/(params_a_k1 + x)):

scan_b2 := sqrt(5913/405000):
scan_b1 := (511/13500)/(2*scan_b2):
scan_b3 := 1/2:
scan_b4 := MU_GE^2/params_a_k1 - 1606/18225 - scan_b1^2:
scan_y  := (x, a) -> MU_GE*scan_p(x) + scan_b4*scan_p(x)^2*exp(-scan_b4*scan_p(x)/MU_GE)
  + (scan_b1*scan_p(x) + scan_b2*(1 - a)*exp(-scan_b3*(1 - a)^2))^2:

scan_a1 := 4.9479:
scan_gx := x -> 1 - exp(-scan_a1/sqrt(X2S*x)):

scan_h0x := 1.174:
scan_f   := (x, u, t) -> (scan_h1x(scan_y(x, scan_alpha(x, t)))*(1 - scan_f_alpha(scan_alpha(x, t)))
  + scan_h0x*scan_f_alpha(scan_alpha(x, t)))*scan_gx(x):

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


with(Groebner):
with(PolynomialIdeals):

J := PolynomialIdeal({x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10, x1*x2 + x1*x3 + x1*x4 + x1*x5 + x1*x6 + x1*x7 + x1*x8 + x1*x9 + x1*x10 + x2*x3 + x2*x4 + x2*x5 + x2*x6 + x2*x7 + x2*x8 + x2*x9 + x2*x10 + x3*x4 + x3*x5 + x3*x6 + x3*x7 + x3*x8 + x3*x9 + x3*x10 + x4*x5 + x4*x6 + x4*x7 + x4*x8 + x4*x9 + x4*x10 + x5*x6 + x5*x7 + x5*x8 + x5*x9 + x5*x10 + x6*x7 + x6*x8 + x6*x9 + x6*x10 + x7*x8 + x7*x9 + x7*x10 + x8*x9 + x8*x10 + x9*x10, x1*x2*x3 + x1*x2*x4 + x1*x2*x5 + x1*x2*x6 + x1*x2*x7 + x1*x2*x8 + x1*x2*x9 + x1*x2*x10 + x1*x3*x4 + x1*x3*x5 + x1*x3*x6 + x1*x3*x7 + x1*x3*x8 + x1*x3*x9 + x1*x3*x10 + x1*x4*x5 + x1*x4*x6 + x1*x4*x7 +
x1*x4*x8 + x1*x4*x9 + x1*x4*x10 + x1*x5*x6 + x1*x5*x7 + x1*x5*x8 + x1*x5*x9 + x1*x5*x10 + x1*x6*x7 + x1*x6*x8 + x1*x6*x9 + x1*x6*x10 + x1*x7*x8 + x1*x7*x9 + x1*x7*x10 + x1*x8*x9 + x1*x8*x10 + x1*x9*x10 + x2*x3*x4 + x2*x3*x5 + x2*x3*x6 + x2*x3*x7 + x2*x3*x8 + x2*x3*x9 + x2*x3*x10 + x2*x4*x5 + x2*x4*x6 + x2*x4*x7 + x2*x4*x8 + x2*x4*x9 + x2*x4*x10 + x2*x5*x6 + x2*x5*x7 + x2*x5*x8 + x2*x5*x9 + x2*x5*x10 + x2*x6*x7 + x2*x6*x8 + x2*x6*x9 + x2*x6*x10 + x2*x7*x8 + x2*x7*x9 + x2*x7*x10 + x2*x8*x9 + x2*x8*x10 + x2*x9*x10 + x3*x4*x5 + x3*x4*x6 + x3*x4*x7 + x3*x4*x8 + x3*x4*x9 + x3*x4*x10 + x3*x5*x6 + x3*x5*x7 + x3*x5*x8 + x3*x5*x9 + x3*x5*x10 + x3*x6*x7 + x3*x6*x8 + x3*x6*x9 + x3*x6*x10 + x3*x7*x8 + x3*x7*x9 + x3*x7*x10 + x3*x8*x9 + x3*x8*x10 + x3*x9*x10 + x4*x5*x6 + x4*x5*x7 + x4*x5*x8 + x4*x5*x9 + x4*x5*x10 + x4*x6*x7 + x4*x6*x8 + x4*x6*x9 + x4*x6*x10 + x4*x7*x8 + x4*x7*x9 + x4*x7*x10 + x4*x8*x9 + x4*x8*x10 + x4*x9*x10 + x5*x6*x7 + x5*x6*x8 + x5*x6*x9 + x5*x6*x10 + x5*x7*x8 + x5*x7*x9 + x5*x7*x10 + x5*x8*x9 + x5*x8*x10 + x5*x9*x10 + x6*x7*x8 + x6*x7*x9 + x6*x7*x10 + x6*x8*x9 + x6*x8*x10 + x6*x9*x10 + x7*x8*x9 + x7*x8*x10 + x7*x9*x10 + x8*x9*x10, x1*x2*x3*x4 + x1*x2*x3*x5 + x1*x2*x3*x6 + x1*x2*x3*x7 + x1*x2*x3*x8 + x1*x2*x3*x9 + x1*x2*x3*x10 + x1*x2*x4*x5 + x1*x2*x4*x6 + x1*x2*x4*x7 + x1*x2*x4*x8 + x1*x2*x4*x9 + x1*x2*x4*x10 + x1*x2*x5*x6 + x1*x2*x5*x7 + x1*x2*x5*x8 + x1*x2*x5*x9 + x1*x2*x5*x10 + x1*x2*x6*x7 + x1*x2*x6*x8 + x1*x2*x6*x9 + x1*x2*x6*x10 + x1*x2*x7*x8 + x1*x2*x7*x9 + x1*x2*x7*x10 + x1*x2*x8*x9 + x1*x2*x8*x10 + x1*x2*x9*x10 +
x1*x3*x4*x5 + x1*x3*x4*x6 + x1*x3*x4*x7 + x1*x3*x4*x8 + x1*x3*x4*x9 + x1*x3*x4*x10 + x1*x3*x5*x6 + x1*x3*x5*x7 + x1*x3*x5*x8 + x1*x3*x5*x9 + x1*x3*x5*x10 + x1*x3*x6*x7 + x1*x3*x6*x8 + x1*x3*x6*x9 + x1*x3*x6*x10 + x1*x3*x7*x8 + x1*x3*x7*x9 + x1*x3*x7*x10 + x1*x3*x8*x9 + x1*x3*x8*x10 + x1*x3*x9*x10 + x1*x4*x5*x6 + x1*x4*x5*x7 + x1*x4*x5*x8 + x1*x4*x5*x9 + x1*x4*x5*x10 + x1*x4*x6*x7 + x1*x4*x6*x8 + x1*x4*x6*x9 + x1*x4*x6*x10 + x1*x4*x7*x8 + x1*x4*x7*x9 + x1*x4*x7*x10 + x1*x4*x8*x9 + x1*x4*x8*x10 + x1*x4*x9*x10 + x1*x5*x6*x7 + x1*x5*x6*x8 + x1*x5*x6*x9 + x1*x5*x6*x10 + x1*x5*x7*x8 + x1*x5*x7*x9 + x1*x5*x7*x10 + x1*x5*x8*x9 + x1*x5*x8*x10 + x1*x5*x9*x10 + x1*x6*x7*x8 + x1*x6*x7*x9 + x1*x6*x7*x10 + x1*x6*x8*x9 + x1*x6*x8*x10 + x1*x6*x9*x10 + x1*x7*x8*x9 + x1*x7*x8*x10 + x1*x7*x9*x10 + x1*x8*x9*x10 + x2*x3*x4*x5 + x2*x3*x4*x6 + x2*x3*x4*x7 + x2*x3*x4*x8 + x2*x3*x4*x9 + x2*x3*x4*x10
+ x2*x3*x5*x6 + x2*x3*x5*x7 + x2*x3*x5*x8 + x2*x3*x5*x9 + x2*x3*x5*x10 + x2*x3*x6*x7 + x2*x3*x6*x8 + x2*x3*x6*x9 + x2*x3*x6*x10 + x2*x3*x7*x8 + x2*x3*x7*x9 + x2*x3*x7*x10 + x2*x3*x8*x9 + x2*x3*x8*x10 + x2*x3*x9*x10 + x2*x4*x5*x6 + x2*x4*x5*x7 + x2*x4*x5*x8 + x2*x4*x5*x9 + x2*x4*x5*x10 + x2*x4*x6*x7 + x2*x4*x6*x8 + x2*x4*x6*x9 + x2*x4*x6*x10 + x2*x4*x7*x8 + x2*x4*x7*x9 + x2*x4*x7*x10 + x2*x4*x8*x9 + x2*x4*x8*x10 + x2*x4*x9*x10 + x2*x5*x6*x7
+ x2*x5*x6*x8 + x2*x5*x6*x9 + x2*x5*x6*x10 + x2*x5*x7*x8 + x2*x5*x7*x9 + x2*x5*x7*x10 + x2*x5*x8*x9 + x2*x5*x8*x10 + x2*x5*x9*x10 + x2*x6*x7*x8 + x2*x6*x7*x9 + x2*x6*x7*x10 + x2*x6*x8*x9 + x2*x6*x8*x10 + x2*x6*x9*x10 + x2*x7*x8*x9 + x2*x7*x8*x10 + x2*x7*x9*x10 + x2*x8*x9*x10 + x3*x4*x5*x6 + x3*x4*x5*x7 + x3*x4*x5*x8 + x3*x4*x5*x9 + x3*x4*x5*x10 + x3*x4*x6*x7 + x3*x4*x6*x8 + x3*x4*x6*x9 + x3*x4*x6*x10 + x3*x4*x7*x8 + x3*x4*x7*x9 + x3*x4*x7*x10 + x3*x4*x8*x9 + x3*x4*x8*x10 + x3*x4*x9*x10 + x3*x5*x6*x7 + x3*x5*x6*x8 + x3*x5*x6*x9 + x3*x5*x6*x10 + x3*x5*x7*x8 + x3*x5*x7*x9 + x3*x5*x7*x10 + x3*x5*x8*x9 + x3*x5*x8*x10 + x3*x5*x9*x10 + x3*x6*x7*x8 + x3*x6*x7*x9 + x3*x6*x7*x10 + x3*x6*x8*x9 + x3*x6*x8*x10 + x3*x6*x9*x10 + x3*x7*x8*x9 + x3*x7*x8*x10 + x3*x7*x9*x10 + x3*x8*x9*x10 + x4*x5*x6*x7 + x4*x5*x6*x8 + x4*x5*x6*x9 + x4*x5*x6*x10 + x4*x5*x7*x8 + x4*x5*x7*x9 + x4*x5*x7*x10 + x4*x5*x8*x9 + x4*x5*x8*x10 + x4*x5*x9*x10 + x4*x6*x7*x8 + x4*x6*x7*x9 + x4*x6*x7*x10 + x4*x6*x8*x9 + x4*x6*x8*x10 + x4*x6*x9*x10 + x4*x7*x8*x9 + x4*x7*x8*x10 + x4*x7*x9*x10 + x4*x8*x9*x10 + x5*x6*x7*x8 + x5*x6*x7*x9 + x5*x6*x7*x10 + x5*x6*x8*x9 + x5*x6*x8*x10 + x5*x6*x9*x10 + x5*x7*x8*x9 + x5*x7*x8*x10 + x5*x7*x9*x10 + x5*x8*x9*x10 + x6*x7*x8*x9 + x6*x7*x8*x10 + x6*x7*x9*x10 + x6*x8*x9*x10 + x7*x8*x9*x10, x1*x2*x3*x4*x5 + x1*x2*x3*x4*x6 + x1*x2*x3*x4*x7 + x1*x2*x3*x4*x8 + x1*x2*x3*x4*x9 + x1*x2*x3*x4*x10 + x1*x2*x3*x5*x6 + x1*x2*x3*x5*x7 + x1*x2*x3*x5*x8 + x1*x2*x3*x5*x9 + x1*x2*x3*x5*x10 + x1*x2*x3*x6*x7 + x1*x2*x3*x6*x8 + x1*x2*x3*x6*x9 + x1*x2*x3*x6*x10 + x1*x2*x3*x7*x8 + x1*x2*x3*x7*x9 + x1*x2*x3*x7*x10 + x1*x2*x3*x8*x9 + x1*x2*x3*x8*x10 + x1*x2*x3*x9*x10 + x1*x2*x4*x5*x6 + x1*x2*x4*x5*x7 + x1*x2*x4*x5*x8 + x1*x2*x4*x5*x9 + x1*x2*x4*x5*x10 + x1*x2*x4*x6*x7 + x1*x2*x4*x6*x8 + x1*x2*x4*x6*x9 + x1*x2*x4*x6*x10 + x1*x2*x4*x7*x8 + x1*x2*x4*x7*x9 + x1*x2*x4*x7*x10 + x1*x2*x4*x8*x9 + x1*x2*x4*x8*x10 + x1*x2*x4*x9*x10 + x1*x2*x5*x6*x7 + x1*x2*x5*x6*x8 + x1*x2*x5*x6*x9 + x1*x2*x5*x6*x10 + x1*x2*x5*x7*x8 + x1*x2*x5*x7*x9 + x1*x2*x5*x7*x10 + x1*x2*x5*x8*x9 + x1*x2*x5*x8*x10 + x1*x2*x5*x9*x10 + x1*x2*x6*x7*x8 + x1*x2*x6*x7*x9 + x1*x2*x6*x7*x10 + x1*x2*x6*x8*x9 + x1*x2*x6*x8*x10 + x1*x2*x6*x9*x10 + x1*x2*x7*x8*x9 + x1*x2*x7*x8*x10 + x1*x2*x7*x9*x10 + x1*x2*x8*x9*x10 + x1*x3*x4*x5*x6 + x1*x3*x4*x5*x7 + x1*x3*x4*x5*x8 + x1*x3*x4*x5*x9 + x1*x3*x4*x5*x10 + x1*x3*x4*x6*x7 +
x1*x3*x4*x6*x8 + x1*x3*x4*x6*x9 + x1*x3*x4*x6*x10 + x1*x3*x4*x7*x8 + x1*x3*x4*x7*x9 + x1*x3*x4*x7*x10 + x1*x3*x4*x8*x9 + x1*x3*x4*x8*x10 + x1*x3*x4*x9*x10 + x1*x3*x5*x6*x7 + x1*x3*x5*x6*x8 + x1*x3*x5*x6*x9 + x1*x3*x5*x6*x10 + x1*x3*x5*x7*x8 + x1*x3*x5*x7*x9 + x1*x3*x5*x7*x10 + x1*x3*x5*x8*x9 + x1*x3*x5*x8*x10 + x1*x3*x5*x9*x10 + x1*x3*x6*x7*x8 + x1*x3*x6*x7*x9 + x1*x3*x6*x7*x10 + x1*x3*x6*x8*x9 + x1*x3*x6*x8*x10 + x1*x3*x6*x9*x10 + x1*x3*x7*x8*x9 + x1*x3*x7*x8*x10 + x1*x3*x7*x9*x10 + x1*x3*x8*x9*x10 + x1*x4*x5*x6*x7 + x1*x4*x5*x6*x8 + x1*x4*x5*x6*x9 + x1*x4*x5*x6*x10 + x1*x4*x5*x7*x8 + x1*x4*x5*x7*x9 + x1*x4*x5*x7*x10 + x1*x4*x5*x8*x9 + x1*x4*x5*x8*x10 + x1*x4*x5*x9*x10 + x1*x4*x6*x7*x8 + x1*x4*x6*x7*x9 + x1*x4*x6*x7*x10 + x1*x4*x6*x8*x9 + x1*x4*x6*x8*x10 + x1*x4*x6*x9*x10 + x1*x4*x7*x8*x9 + x1*x4*x7*x8*x10 + x1*x4*x7*x9*x10 + x1*x4*x8*x9*x10 + x1*x5*x6*x7*x8 + x1*x5*x6*x7*x9 + x1*x5*x6*x7*x10 + x1*x5*x6*x8*x9 + x1*x5*x6*x8*x10 + x1*x5*x6*x9*x10 +
x1*x5*x7*x8*x9 + x1*x5*x7*x8*x10 + x1*x5*x7*x9*x10 + x1*x5*x8*x9*x10 + x1*x6*x7*x8*x9 + x1*x6*x7*x8*x10 + x1*x6*x7*x9*x10 + x1*x6*x8*x9*x10 + x1*x7*x8*x9*x10 + x2*x3*x4*x5*x6 + x2*x3*x4*x5*x7 + x2*x3*x4*x5*x8 + x2*x3*x4*x5*x9 + x2*x3*x4*x5*x10 + x2*x3*x4*x6*x7 + x2*x3*x4*x6*x8 + x2*x3*x4*x6*x9 + x2*x3*x4*x6*x10 + x2*x3*x4*x7*x8 + x2*x3*x4*x7*x9 + x2*x3*x4*x7*x10 + x2*x3*x4*x8*x9 + x2*x3*x4*x8*x10 + x2*x3*x4*x9*x10 + x2*x3*x5*x6*x7 + x2*x3*x5*x6*x8 + x2*x3*x5*x6*x9 + x2*x3*x5*x6*x10 + x2*x3*x5*x7*x8 + x2*x3*x5*x7*x9 + x2*x3*x5*x7*x10 + x2*x3*x5*x8*x9 + x2*x3*x5*x8*x10 + x2*x3*x5*x9*x10
+ x2*x3*x6*x7*x8 + x2*x3*x6*x7*x9 + x2*x3*x6*x7*x10 + x2*x3*x6*x8*x9 + x2*x3*x6*x8*x10 + x2*x3*x6*x9*x10 + x2*x3*x7*x8*x9 + x2*x3*x7*x8*x10 + x2*x3*x7*x9*x10 + x2*x3*x8*x9*x10 + x2*x4*x5*x6*x7 + x2*x4*x5*x6*x8 + x2*x4*x5*x6*x9 + x2*x4*x5*x6*x10 + x2*x4*x5*x7*x8 + x2*x4*x5*x7*x9 + x2*x4*x5*x7*x10 + x2*x4*x5*x8*x9 + x2*x4*x5*x8*x10 + x2*x4*x5*x9*x10 + x2*x4*x6*x7*x8 + x2*x4*x6*x7*x9 + x2*x4*x6*x7*x10 + x2*x4*x6*x8*x9 + x2*x4*x6*x8*x10 + x2*x4*x6*x9*x10 + x2*x4*x7*x8*x9 + x2*x4*x7*x8*x10 + x2*x4*x7*x9*x10 + x2*x4*x8*x9*x10 + x2*x5*x6*x7*x8 + x2*x5*x6*x7*x9 + x2*x5*x6*x7*x10 + x2*x5*x6*x8*x9 + x2*x5*x6*x8*x10 + x2*x5*x6*x9*x10 + x2*x5*x7*x8*x9 + x2*x5*x7*x8*x10
+ x2*x5*x7*x9*x10 + x2*x5*x8*x9*x10 + x2*x6*x7*x8*x9 + x2*x6*x7*x8*x10 + x2*x6*x7*x9*x10 + x2*x6*x8*x9*x10 + x2*x7*x8*x9*x10 + x3*x4*x5*x6*x7 + x3*x4*x5*x6*x8 + x3*x4*x5*x6*x9 + x3*x4*x5*x6*x10 + x3*x4*x5*x7*x8 + x3*x4*x5*x7*x9 + x3*x4*x5*x7*x10 + x3*x4*x5*x8*x9 + x3*x4*x5*x8*x10 + x3*x4*x5*x9*x10 + x3*x4*x6*x7*x8 + x3*x4*x6*x7*x9 + x3*x4*x6*x7*x10 + x3*x4*x6*x8*x9 +
x3*x4*x6*x8*x10 + x3*x4*x6*x9*x10 + x3*x4*x7*x8*x9 + x3*x4*x7*x8*x10 + x3*x4*x7*x9*x10 + x3*x4*x8*x9*x10 + x3*x5*x6*x7*x8 + x3*x5*x6*x7*x9 + x3*x5*x6*x7*x10 + x3*x5*x6*x8*x9 + x3*x5*x6*x8*x10 + x3*x5*x6*x9*x10 + x3*x5*x7*x8*x9 + x3*x5*x7*x8*x10 + x3*x5*x7*x9*x10 + x3*x5*x8*x9*x10 + x3*x6*x7*x8*x9 + x3*x6*x7*x8*x10 + x3*x6*x7*x9*x10 + x3*x6*x8*x9*x10 + x3*x7*x8*x9*x10
+ x4*x5*x6*x7*x8 + x4*x5*x6*x7*x9 + x4*x5*x6*x7*x10 + x4*x5*x6*x8*x9 + x4*x5*x6*x8*x10 + x4*x5*x6*x9*x10 + x4*x5*x7*x8*x9 + x4*x5*x7*x8*x10 + x4*x5*x7*x9*x10 + x4*x5*x8*x9*x10 + x4*x6*x7*x8*x9 + x4*x6*x7*x8*x10 + x4*x6*x7*x9*x10 + x4*x6*x8*x9*x10 + x4*x7*x8*x9*x10 + x5*x6*x7*x8*x9 + x5*x6*x7*x8*x10 + x5*x6*x7*x9*x10 + x5*x6*x8*x9*x10 + x5*x7*x8*x9*x10 + x6*x7*x8*x9*x10, x1*x2*x3*x4*x5*x6 + x1*x2*x3*x4*x5*x7 + x1*x2*x3*x4*x5*x8 + x1*x2*x3*x4*x5*x9 + x1*x2*x3*x4*x5*x10 + x1*x2*x3*x4*x6*x7 + x1*x2*x3*x4*x6*x8 + x1*x2*x3*x4*x6*x9 + x1*x2*x3*x4*x6*x10 + x1*x2*x3*x4*x7*x8 + x1*x2*x3*x4*x7*x9 + x1*x2*x3*x4*x7*x10 + x1*x2*x3*x4*x8*x9 + x1*x2*x3*x4*x8*x10 + x1*x2*x3*x4*x9*x10 + x1*x2*x3*x5*x6*x7 + x1*x2*x3*x5*x6*x8 + x1*x2*x3*x5*x6*x9 + x1*x2*x3*x5*x6*x10 + x1*x2*x3*x5*x7*x8 + x1*x2*x3*x5*x7*x9 + x1*x2*x3*x5*x7*x10 + x1*x2*x3*x5*x8*x9 + x1*x2*x3*x5*x8*x10 + x1*x2*x3*x5*x9*x10 + x1*x2*x3*x6*x7*x8 + x1*x2*x3*x6*x7*x9 + x1*x2*x3*x6*x7*x10 + x1*x2*x3*x6*x8*x9 + x1*x2*x3*x6*x8*x10 + x1*x2*x3*x6*x9*x10 + x1*x2*x3*x7*x8*x9 + x1*x2*x3*x7*x8*x10 + x1*x2*x3*x7*x9*x10 + x1*x2*x3*x8*x9*x10 + x1*x2*x4*x5*x6*x7 + x1*x2*x4*x5*x6*x8 + x1*x2*x4*x5*x6*x9 + x1*x2*x4*x5*x6*x10 + x1*x2*x4*x5*x7*x8 + x1*x2*x4*x5*x7*x9 + x1*x2*x4*x5*x7*x10 + x1*x2*x4*x5*x8*x9 + x1*x2*x4*x5*x8*x10 + x1*x2*x4*x5*x9*x10 + x1*x2*x4*x6*x7*x8 + x1*x2*x4*x6*x7*x9 +
x1*x2*x4*x6*x7*x10 + x1*x2*x4*x6*x8*x9 + x1*x2*x4*x6*x8*x10 + x1*x2*x4*x6*x9*x10 + x1*x2*x4*x7*x8*x9 + x1*x2*x4*x7*x8*x10 + x1*x2*x4*x7*x9*x10 + x1*x2*x4*x8*x9*x10 + x1*x2*x5*x6*x7*x8 + x1*x2*x5*x6*x7*x9 + x1*x2*x5*x6*x7*x10 + x1*x2*x5*x6*x8*x9 + x1*x2*x5*x6*x8*x10 + x1*x2*x5*x6*x9*x10 + x1*x2*x5*x7*x8*x9 + x1*x2*x5*x7*x8*x10 + x1*x2*x5*x7*x9*x10 + x1*x2*x5*x8*x9*x10
+ x1*x2*x6*x7*x8*x9 + x1*x2*x6*x7*x8*x10 + x1*x2*x6*x7*x9*x10 + x1*x2*x6*x8*x9*x10 + x1*x2*x7*x8*x9*x10 + x1*x3*x4*x5*x6*x7 + x1*x3*x4*x5*x6*x8 + x1*x3*x4*x5*x6*x9 + x1*x3*x4*x5*x6*x10 + x1*x3*x4*x5*x7*x8 + x1*x3*x4*x5*x7*x9 + x1*x3*x4*x5*x7*x10 + x1*x3*x4*x5*x8*x9 + x1*x3*x4*x5*x8*x10 + x1*x3*x4*x5*x9*x10 + x1*x3*x4*x6*x7*x8 + x1*x3*x4*x6*x7*x9 + x1*x3*x4*x6*x7*x10 + x1*x3*x4*x6*x8*x9 + x1*x3*x4*x6*x8*x10 + x1*x3*x4*x6*x9*x10 + x1*x3*x4*x7*x8*x9 + x1*x3*x4*x7*x8*x10 + x1*x3*x4*x7*x9*x10 + x1*x3*x4*x8*x9*x10 + x1*x3*x5*x6*x7*x8 + x1*x3*x5*x6*x7*x9 + x1*x3*x5*x6*x7*x10 + x1*x3*x5*x6*x8*x9 + x1*x3*x5*x6*x8*x10 + x1*x3*x5*x6*x9*x10 + x1*x3*x5*x7*x8*x9 + x1*x3*x5*x7*x8*x10 + x1*x3*x5*x7*x9*x10 + x1*x3*x5*x8*x9*x10 + x1*x3*x6*x7*x8*x9
+ x1*x3*x6*x7*x8*x10 + x1*x3*x6*x7*x9*x10 + x1*x3*x6*x8*x9*x10 + x1*x3*x7*x8*x9*x10 + x1*x4*x5*x6*x7*x8 + x1*x4*x5*x6*x7*x9 + x1*x4*x5*x6*x7*x10 + x1*x4*x5*x6*x8*x9 + x1*x4*x5*x6*x8*x10 + x1*x4*x5*x6*x9*x10 + x1*x4*x5*x7*x8*x9 + x1*x4*x5*x7*x8*x10 + x1*x4*x5*x7*x9*x10 + x1*x4*x5*x8*x9*x10 + x1*x4*x6*x7*x8*x9 + x1*x4*x6*x7*x8*x10 + x1*x4*x6*x7*x9*x10 + x1*x4*x6*x8*x9*x10 + x1*x4*x7*x8*x9*x10 + x1*x5*x6*x7*x8*x9 + x1*x5*x6*x7*x8*x10 + x1*x5*x6*x7*x9*x10 + x1*x5*x6*x8*x9*x10 + x1*x5*x7*x8*x9*x10 + x1*x6*x7*x8*x9*x10 + x2*x3*x4*x5*x6*x7 + x2*x3*x4*x5*x6*x8 + x2*x3*x4*x5*x6*x9 + x2*x3*x4*x5*x6*x10 + x2*x3*x4*x5*x7*x8 + x2*x3*x4*x5*x7*x9 + x2*x3*x4*x5*x7*x10 + x2*x3*x4*x5*x8*x9 + x2*x3*x4*x5*x8*x10 + x2*x3*x4*x5*x9*x10 + x2*x3*x4*x6*x7*x8 + x2*x3*x4*x6*x7*x9 + x2*x3*x4*x6*x7*x10 + x2*x3*x4*x6*x8*x9 + x2*x3*x4*x6*x8*x10 + x2*x3*x4*x6*x9*x10 + x2*x3*x4*x7*x8*x9 + x2*x3*x4*x7*x8*x10 + x2*x3*x4*x7*x9*x10 + x2*x3*x4*x8*x9*x10 + x2*x3*x5*x6*x7*x8 + x2*x3*x5*x6*x7*x9 + x2*x3*x5*x6*x7*x10 + x2*x3*x5*x6*x8*x9 + x2*x3*x5*x6*x8*x10 + x2*x3*x5*x6*x9*x10 + x2*x3*x5*x7*x8*x9 + x2*x3*x5*x7*x8*x10 + x2*x3*x5*x7*x9*x10 + x2*x3*x5*x8*x9*x10 + x2*x3*x6*x7*x8*x9 + x2*x3*x6*x7*x8*x10 + x2*x3*x6*x7*x9*x10 + x2*x3*x6*x8*x9*x10 + x2*x3*x7*x8*x9*x10 + x2*x4*x5*x6*x7*x8 + x2*x4*x5*x6*x7*x9 + x2*x4*x5*x6*x7*x10 + x2*x4*x5*x6*x8*x9 + x2*x4*x5*x6*x8*x10 + x2*x4*x5*x6*x9*x10 + x2*x4*x5*x7*x8*x9 + x2*x4*x5*x7*x8*x10 + x2*x4*x5*x7*x9*x10 + x2*x4*x5*x8*x9*x10 + x2*x4*x6*x7*x8*x9 + x2*x4*x6*x7*x8*x10 + x2*x4*x6*x7*x9*x10 + x2*x4*x6*x8*x9*x10 + x2*x4*x7*x8*x9*x10 + x2*x5*x6*x7*x8*x9 + x2*x5*x6*x7*x8*x10 + x2*x5*x6*x7*x9*x10 + x2*x5*x6*x8*x9*x10 + x2*x5*x7*x8*x9*x10 + x2*x6*x7*x8*x9*x10 + x3*x4*x5*x6*x7*x8 + x3*x4*x5*x6*x7*x9 + x3*x4*x5*x6*x7*x10 + x3*x4*x5*x6*x8*x9 + x3*x4*x5*x6*x8*x10
+ x3*x4*x5*x6*x9*x10 + x3*x4*x5*x7*x8*x9 + x3*x4*x5*x7*x8*x10 + x3*x4*x5*x7*x9*x10 + x3*x4*x5*x8*x9*x10 + x3*x4*x6*x7*x8*x9 + x3*x4*x6*x7*x8*x10 + x3*x4*x6*x7*x9*x10 + x3*x4*x6*x8*x9*x10 + x3*x4*x7*x8*x9*x10 + x3*x5*x6*x7*x8*x9 + x3*x5*x6*x7*x8*x10 + x3*x5*x6*x7*x9*x10 + x3*x5*x6*x8*x9*x10 + x3*x5*x7*x8*x9*x10 + x3*x6*x7*x8*x9*x10 + x4*x5*x6*x7*x8*x9 + x4*x5*x6*x7*x8*x10 + x4*x5*x6*x7*x9*x10 + x4*x5*x6*x8*x9*x10 + x4*x5*x7*x8*x9*x10 + x4*x6*x7*x8*x9*x10 + x5*x6*x7*x8*x9*x10, x1*x2*x3*x4*x5*x6*x7 + x1*x2*x3*x4*x5*x6*x8 + x1*x2*x3*x4*x5*x6*x9 + x1*x2*x3*x4*x5*x6*x10 + x1*x2*x3*x4*x5*x7*x8 + x1*x2*x3*x4*x5*x7*x9 + x1*x2*x3*x4*x5*x7*x10 + x1*x2*x3*x4*x5*x8*x9 +
x1*x2*x3*x4*x5*x8*x10 + x1*x2*x3*x4*x5*x9*x10 + x1*x2*x3*x4*x6*x7*x8 + x1*x2*x3*x4*x6*x7*x9 + x1*x2*x3*x4*x6*x7*x10 + x1*x2*x3*x4*x6*x8*x9 + x1*x2*x3*x4*x6*x8*x10 + x1*x2*x3*x4*x6*x9*x10 + x1*x2*x3*x4*x7*x8*x9 + x1*x2*x3*x4*x7*x8*x10 + x1*x2*x3*x4*x7*x9*x10 + x1*x2*x3*x4*x8*x9*x10 + x1*x2*x3*x5*x6*x7*x8 + x1*x2*x3*x5*x6*x7*x9 + x1*x2*x3*x5*x6*x7*x10 + x1*x2*x3*x5*x6*x8*x9 + x1*x2*x3*x5*x6*x8*x10 + x1*x2*x3*x5*x6*x9*x10 + x1*x2*x3*x5*x7*x8*x9 + x1*x2*x3*x5*x7*x8*x10 + x1*x2*x3*x5*x7*x9*x10 + x1*x2*x3*x5*x8*x9*x10
+ x1*x2*x3*x6*x7*x8*x9 + x1*x2*x3*x6*x7*x8*x10 + x1*x2*x3*x6*x7*x9*x10 + x1*x2*x3*x6*x8*x9*x10 + x1*x2*x3*x7*x8*x9*x10 + x1*x2*x4*x5*x6*x7*x8 + x1*x2*x4*x5*x6*x7*x9 + x1*x2*x4*x5*x6*x7*x10 + x1*x2*x4*x5*x6*x8*x9 + x1*x2*x4*x5*x6*x8*x10 + x1*x2*x4*x5*x6*x9*x10 + x1*x2*x4*x5*x7*x8*x9 + x1*x2*x4*x5*x7*x8*x10 + x1*x2*x4*x5*x7*x9*x10 + x1*x2*x4*x5*x8*x9*x10 + x1*x2*x4*x6*x7*x8*x9 + x1*x2*x4*x6*x7*x8*x10 + x1*x2*x4*x6*x7*x9*x10 + x1*x2*x4*x6*x8*x9*x10 + x1*x2*x4*x7*x8*x9*x10 + x1*x2*x5*x6*x7*x8*x9 + x1*x2*x5*x6*x7*x8*x10 + x1*x2*x5*x6*x7*x9*x10 + x1*x2*x5*x6*x8*x9*x10 + x1*x2*x5*x7*x8*x9*x10 + x1*x2*x6*x7*x8*x9*x10 + x1*x3*x4*x5*x6*x7*x8 + x1*x3*x4*x5*x6*x7*x9 + x1*x3*x4*x5*x6*x7*x10 + x1*x3*x4*x5*x6*x8*x9 + x1*x3*x4*x5*x6*x8*x10 + x1*x3*x4*x5*x6*x9*x10 + x1*x3*x4*x5*x7*x8*x9 + x1*x3*x4*x5*x7*x8*x10 + x1*x3*x4*x5*x7*x9*x10 + x1*x3*x4*x5*x8*x9*x10 + x1*x3*x4*x6*x7*x8*x9 + x1*x3*x4*x6*x7*x8*x10 + x1*x3*x4*x6*x7*x9*x10 + x1*x3*x4*x6*x8*x9*x10 + x1*x3*x4*x7*x8*x9*x10 + x1*x3*x5*x6*x7*x8*x9 + x1*x3*x5*x6*x7*x8*x10 + x1*x3*x5*x6*x7*x9*x10 + x1*x3*x5*x6*x8*x9*x10 + x1*x3*x5*x7*x8*x9*x10 + x1*x3*x6*x7*x8*x9*x10 + x1*x4*x5*x6*x7*x8*x9 + x1*x4*x5*x6*x7*x8*x10 + x1*x4*x5*x6*x7*x9*x10 + x1*x4*x5*x6*x8*x9*x10 + x1*x4*x5*x7*x8*x9*x10 + x1*x4*x6*x7*x8*x9*x10
+ x1*x5*x6*x7*x8*x9*x10 + x2*x3*x4*x5*x6*x7*x8 + x2*x3*x4*x5*x6*x7*x9 + x2*x3*x4*x5*x6*x7*x10 + x2*x3*x4*x5*x6*x8*x9 + x2*x3*x4*x5*x6*x8*x10 + x2*x3*x4*x5*x6*x9*x10 + x2*x3*x4*x5*x7*x8*x9 + x2*x3*x4*x5*x7*x8*x10 + x2*x3*x4*x5*x7*x9*x10 + x2*x3*x4*x5*x8*x9*x10 + x2*x3*x4*x6*x7*x8*x9 + x2*x3*x4*x6*x7*x8*x10 + x2*x3*x4*x6*x7*x9*x10 + x2*x3*x4*x6*x8*x9*x10 + x2*x3*x4*x7*x8*x9*x10 + x2*x3*x5*x6*x7*x8*x9 + x2*x3*x5*x6*x7*x8*x10 + x2*x3*x5*x6*x7*x9*x10 + x2*x3*x5*x6*x8*x9*x10 + x2*x3*x5*x7*x8*x9*x10 + x2*x3*x6*x7*x8*x9*x10 + x2*x4*x5*x6*x7*x8*x9 + x2*x4*x5*x6*x7*x8*x10 + x2*x4*x5*x6*x7*x9*x10 + x2*x4*x5*x6*x8*x9*x10 + x2*x4*x5*x7*x8*x9*x10 + x2*x4*x6*x7*x8*x9*x10 + x2*x5*x6*x7*x8*x9*x10 + x3*x4*x5*x6*x7*x8*x9 + x3*x4*x5*x6*x7*x8*x10 + x3*x4*x5*x6*x7*x9*x10 + x3*x4*x5*x6*x8*x9*x10 + x3*x4*x5*x7*x8*x9*x10 + x3*x4*x6*x7*x8*x9*x10 + x3*x5*x6*x7*x8*x9*x10 + x4*x5*x6*x7*x8*x9*x10, x1*x2*x3*x4*x5*x6*x7*x8 + x1*x2*x3*x4*x5*x6*x7*x9 + x1*x2*x3*x4*x5*x6*x7*x10 + x1*x2*x3*x4*x5*x6*x8*x9 + x1*x2*x3*x4*x5*x6*x8*x10 + x1*x2*x3*x4*x5*x6*x9*x10 + x1*x2*x3*x4*x5*x7*x8*x9 + x1*x2*x3*x4*x5*x7*x8*x10 + x1*x2*x3*x4*x5*x7*x9*x10 + x1*x2*x3*x4*x5*x8*x9*x10 + x1*x2*x3*x4*x6*x7*x8*x9 + x1*x2*x3*x4*x6*x7*x8*x10 + x1*x2*x3*x4*x6*x7*x9*x10 + x1*x2*x3*x4*x6*x8*x9*x10 + x1*x2*x3*x4*x7*x8*x9*x10 + x1*x2*x3*x5*x6*x7*x8*x9 + x1*x2*x3*x5*x6*x7*x8*x10
+ x1*x2*x3*x5*x6*x7*x9*x10 + x1*x2*x3*x5*x6*x8*x9*x10 + x1*x2*x3*x5*x7*x8*x9*x10 + x1*x2*x3*x6*x7*x8*x9*x10 + x1*x2*x4*x5*x6*x7*x8*x9 + x1*x2*x4*x5*x6*x7*x8*x10 + x1*x2*x4*x5*x6*x7*x9*x10 + x1*x2*x4*x5*x6*x8*x9*x10 + x1*x2*x4*x5*x7*x8*x9*x10 + x1*x2*x4*x6*x7*x8*x9*x10 + x1*x2*x5*x6*x7*x8*x9*x10
+ x1*x3*x4*x5*x6*x7*x8*x9 + x1*x3*x4*x5*x6*x7*x8*x10 + x1*x3*x4*x5*x6*x7*x9*x10 + x1*x3*x4*x5*x6*x8*x9*x10 + x1*x3*x4*x5*x7*x8*x9*x10 + x1*x3*x4*x6*x7*x8*x9*x10 + x1*x3*x5*x6*x7*x8*x9*x10 + x1*x4*x5*x6*x7*x8*x9*x10 + x2*x3*x4*x5*x6*x7*x8*x9 + x2*x3*x4*x5*x6*x7*x8*x10 + x2*x3*x4*x5*x6*x7*x9*x10 + x2*x3*x4*x5*x6*x8*x9*x10 + x2*x3*x4*x5*x7*x8*x9*x10 + x2*x3*x4*x6*x7*x8*x9*x10 + x2*x3*x5*x6*x7*x8*x9*x10 + x2*x4*x5*x6*x7*x8*x9*x10 + x3*x4*x5*x6*x7*x8*x9*x10, x1*x2*x3*x4*x5*x6*x7*x8*x9 + x1*x2*x3*x4*x5*x6*x7*x8*x10 + x1*x2*x3*x4*x5*x6*x7*x9*x10 + x1*x2*x3*x4*x5*x6*x8*x9*x10 + x1*x2*x3*x4*x5*x7*x8*x9*x10 + x1*x2*x3*x4*x6*x7*x8*x9*x10 + x1*x2*x3*x5*x6*x7*x8*x9*x10 + x1*x2*x4*x5*x6*x7*x8*x9*x10 + x1*x3*x4*x5*x6*x7*x8*x9*x10 + x2*x3*x4*x5*x6*x7*x8*x9*x10, x1*x2*x3*x4*x5*x6*x7*x8*x9*x10 + 1}):

st := time[real]():
Basis(J, tdeg(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10)):
time[real]() - st;