Arno's nonconjugable map

\(\(var5 = Array[x\_#&, {5}]; \)\)

\(\(arno
       = {x\_1 + x\_2\ x\_5\^2, 
		
        x\_2 + \(x\_1\^2\) x\_5 - \(x\_4\) x\_5\^2, 
		
        x\_3 + \(x\_2\^2\) x\_5, 
		
        x\_4 + 2 \( x\_1\) \(x\_2\) x\_5 - \(x\_3\) x\_5\^2, 
		x\_5};
    \)\)

Inverse

The inverse of Arno's map:

\(arnoinversa =
      Array[x\_#&, {5}] /. 
			
          \(Solve[arno == Array[y\_#&, {5}], 
				Array[x\_#&, {5}]]
              \)[[1]] // Expand\)

arnoinversa

Collecting terms with respect to degree:

Collect[arnoinversa /. (Subscript[y, i])_ :> t (Subscript[y, i]), t]

Exponent[%, t]

Separation of the degrees:

inversagrado[n_] :=
      Coefficient[Collect[arnoinversa /. (Subscript[y, i])_ :> t (Subscript[y, i]), t],
        (t^n)];

inversagrado[1]

inversagrado[3]

inversagrado[5]

inversagrado[7]

inversagrado[9]

inversagrado[11]

inversagrado[13]

inversagrado[15]

Trasforming the map into a combination of cubes

This function turns third degree monomials into a linear combination of cubes:

SetAttributes[combinazionedicubi, Listable];

combinazionedicubi[a_ + b_] :=
      combinazionedicubi[a] + combinazionedicubi[b];

combinazionedicubi[num_] := num /; NumberQ[num];

combinazionedicubi[num_.*a_Symbol] := num*a /; NumberQ[num];

combinazionedicubi[num_.*a_Subscript] := num*a /; NumberQ[num];

combinazionedicubi[num_.  a_ b_ c_] :=
      (num/24) (((a + b + c))^3) + (num/24) (((a - b - c))^3) -
          (num/24) (((a + b - c))^3) - (num/24) (((a - b + c))^3) /;
        NumberQ[num] && ! NumberQ[a] && ! NumberQ[b] &&
          ! NumberQ[c];

\(\(combinazionedicubi[num_.  a_\ b_\^2] :=
      num\/6\ \((a + b)\)\^3 + num\/6\ \((a - b)\)\^3 - num  a\^3\/3 /;
        NumberQ[num] && \(! NumberQ[a]\) && \(! NumberQ[b]\); \)\)

\(\(combinazionedicubi[num_.  a_\^3] :=
      num*a^3 /; NumberQ[num] && \(! NumberQ[a]\); \)\)

We turn Arno's map into a combination of cubes:

arnoricombinato = combinazionedicubi[arno - var5]

arno - var5 - arnoricombinato // Expand

The single terms of the sum as a list:

addendi = Apply[List, arnoricombinato, 1] // Flatten

The list of all linear terms whose cubes make up the map:

\(combinazioni =
      Select[addendi, MatchQ[#1, a_.\ b_\^3]&] /.
          a_.\ b_\^3 :> b /; NumberQ[a] // Union\)

Length[combinazioni]

A technical trick:

temp =
      arnoricombinato /.
        Table[combinazioni[[i]]^3 -> (Subscript[comb, i]), {i, Length[combinazioni]}]

Calculating d0, b0

d0 =
      Table[Coefficient[combinazioni[[i]], (Subscript[x, j])], {i,
          Length[combinazioni]}, {j, Length[arno]}];

d0 // MatrixForm

d0.var5 == combinazioni

b0 =
      -Table[Coefficient[temp[[i]],
            (Subscript[comb, j])], {i, 5}, {j, Length[combinazioni]}];

b0 // MatrixForm

arno == (var5 - b0.(d0.var5)^3 // Expand)

Calculating b,d

b = Transpose[Join[Transpose[b0], {{0, 0, 0, 0, 1}}]];

b // MatrixForm

{Length[b], Length[b[[1]]]}

Length[NullSpace[b]]

d = Join[d0, {{0, 0, 0, 0, 0}}];

d // MatrixForm

Length[NullSpace[d]]

Calculating c

\(\(c =
      Module[{c, mat}, 
		mat = Array[c, {Length[b[\([1]\)]], Length[b]}];
        
		\(mat /.
            \(Solve[b.mat == IdentityMatrix[Length[b]], 
				
                Flatten[mat]]\)[\([1]\)]\) /. c[i_, j_] -> 0]; \)\)

c // MatrixForm

b.c == IdentityMatrix[5]

Kernel of b

NullSpace[b] // MatrixForm

m = Transpose[ 4  NullSpace[b]];

m // MatrixForm

Length[m // First]

Calculating a

cm = (Transpose[c]~Join~Transpose[m]) // Transpose;

cm // MatrixForm

m // NullSpace // Length

dAnd0 =
      (Transpose[d]~Join~
            Transpose[Table[0, {i, Length[d]}, {j, Length[m // First]}]])
           // Transpose;

dAnd0 // MatrixForm

a = dAnd0.Inverse[cm];

a // MatrixForm

12  a // MatrixForm

Verification

a.c == d

arno == (var5 - b.(d.var5)^3 // Expand)

\(\(nilpotentQ[mat_\  /; \ MatrixQ[mat]] := 
		
      Module[{iterate, i}, 
			
        For[i = 1; iterate = mat // Expand, 
				
          i <= Length[mat]\  && 
				Union[iterate // Flatten] =!= {0},
          
				\(i++\); 
				iterate\  = \ mat.iterate // Expand];
        
			If[
          i > Length[mat], {False, "not nilpotent"}, {True,
            "nilponency index="<>ToString[i]}]]; \)\)

nilpotentQ[a]

\(\(DruzkowskiQ[mat_\  /; \ MatrixQ[mat]] := 
	
      Module[{x = Table[x[i], {i, Length[mat]}], m}, 
		
        m = DiagonalMatrix[\((mat.x)\)^2].mat; 
		answer = nilpotentQ[m];
        
		If[answer[\([1]\)], answer[\([2]\)], 

          			{False, "not a Druzkowski matrix"}]]; \)\)

This is meant to calculate the nilpotency index of the derivative of (Ax)^3, but it seems to take a long time, so we aborted the evaluation. You may try it at night.

DruzkowskiQ[a]