Create algebraic function with finite power expansions?

[aheight]

How would I design a non-trivial algebraic function of degree 4 containing a branch at the origin with the (finite) power expansion:

$w(z)=1+0.5 z-1/4 z^{1/2}+3/4 z^{1/4}$?

having the form

$f(z,w)=a_0+a_1 w+a_2 w^2+a_3 w^3+a_4 w^4=0$

with the $a_i$ ( preferably not fractional) polynomials? And if that is possible, can I design any function $w(z)$ with a finite power expansion with $f$ of any degree?

I don't know.

 

[aheight]

I figured out it's easy to design one using fractional polynomials. Just substitute $w(z)$ into $f(z,w)=a_0+w+w^2+w^3+w^4=0$ for example and solve for $a_0$ to get:

$w^4+w^3+w^2+w-\frac{1}{128} 237 z^{3/2}+\frac{z^{5/2}}{8}+\frac{z^{7/2}}{8}+\frac{105 z^{3/4}}{64}-\frac{249 z^{5/4}}{32}+\frac{129 z^{7/4}}{64}-\frac{99 z^{9/4}}{32}+\frac{9 z^{11/4}}{16}-\frac{3 z^{13/4}}{8}-\frac{z^4}{16}-\frac{23 z^3}{32}-\frac{545 z^2}{256}-\frac{15 \sqrt[4]{z}}{2}-\frac{981 z}{256}-\frac{25 \sqrt{z}}{8}-4=0$

but I think that introduces 12 more cycles into the function: for each root of $z^{1/4}$ we have four values of $w$ or maybe we just have a reducible function $w$ made up of four factors each of degree four. Not sure.

 

[aheight]

Here is a solution in Mathematica (see https://www.physicsforums.com/threa...ary-constants-with-solve.899472/#post-5660255 for some background) .

For example, given $\text{myw}=z^{3/4}+z^{5/4}+\sqrt{z}+\sqrt[4]{z}+z+1$, the code produces:

$15 w^6+w^5 (-60 z-55)+w^4 \left(30 z^2+70 z+71\right)+w^3 \left(-50 z^2-34 z-34\right)+w^2 \left(-15 z^5-15 z^4-15 z^3-3 z^2+z+1\right)+w \left(-5 z^5-5 z^4-5 z^3+z^2+z+1\right)-z^5-z^4-z^3+z^2+z+1$

What remains is to prove the following hypothesis:

Given any fractional polynomial $u(z)$, there exists a bivariate polynomial $f(z,w)$ (with integer powers of z and w) such that $f(z,u)=0$. I believe this statement is true. Would anyone here suggest a means of proving this?

Thanks!

myw = 1 + z^(1/4) + z^(1/2) + z^(3/4) + z + z^(5/4)
fExponents = Exponent[myw, z, List]
fdegree = Length[fExponents];
matrixFlag = False;
While[! matrixFlag && fdegree < 10,
  {
 
   pdegree = fdegree;
   Quiet[Table[
     Subscript[s, n] =., {k, 0, fdegree}, {n, 20 k, 20 k + pdegree}]];
 
   theCoefficients =
    Table[Subscript[s, n], {k, 0, fdegree}, {n, 20 k, 20 k + pdegree}];
   thePolyTerms =
    Table[theCoefficients[[i, j]] z^(j - 1), {i, 1, fdegree + 1}, {j,
      1, pdegree + 1}];
   thePolys = (Plus @@ # &) /@ thePolyTerms;
   theFunctionForm =
    Plus @@ Flatten[
      Table[thePolys[[i]] w^(i - 1), {i, 1, fdegree + 1}]];
 
   expandedForm = Expand[theFunctionForm /. w -> myw];
   elist = Exponent[expandedForm, z, List];
   theEquations =
    Table[Coefficient[expandedForm, z, elist[[i]]], {i, 1,
      Length[elist]}];
   theSolution =
    Solve[Table[
      Coefficient[expandedForm, z, elist[[i]]] == 0, {i, 1,
       Length[elist]}], Flatten[theCoefficients], Method -> "Reduce"];
   val1 = theSolution // Flatten;
   val2 = Association[val1];
   clist = Flatten[theCoefficients];
   iList = Intersection[Flatten[theCoefficients], Keys[val2]];
   theNormalForm =
    Normal[CoefficientArrays[#, Flatten[theCoefficients]]] & /@
     theEquations;
   theCMatrix = #[[2]] & /@ theNormalForm;
   theMRank = MatrixRank[theCMatrix];
   Print["number of equations", Length[theEquations]];
   Print["number of variables: ", Length[Flatten[theCoefficients]]];
   Print["Matrix Rank: ", MatrixRank[theCMatrix]];
   If[theMRank < Length[Flatten[theCoefficients]],
    {
     Print[
      "Rank less than number of variables.  Computing function . . . \
"];
     theFreeVals = Complement[clist, iList];
     Print["free vars: ", theFreeVals];
     For[i = 1, i <= Length[theFreeVals], i++,
      Subscript[theFreeVals[[i, 1]], theFreeVals[[i, 2]]] = 1;
      ];
     Print["Function: ",
      polyForm[(theFunctionForm /. theSolution)[[1]], w]];
     matrixFlag = True;
     }
    ,
    fdegree++;
    ];
   }
  ];