Counting Real roots

Question

I'm interested on how to count the number of real roots of a random polynomials in an instant, how to put the result in a table and how to plot it in a graph.I generated 1 million random polynomials following Gaussian Distribution with mean 0 and variance 1. I used this command

r:=GaussianDistribution[0,1]
y=randompol[n_,i_]:=Sum[r x^{j},{j,0,n}]
Solve[y==0,x]
CountRoots[y,x]

But the command Countroots does not apply for it says that the above generated random polynomials is not univariate. But it seems awkward that when I manually paste the generated random polynomial to the CountRoots command instead of using link, it works!

But I want to do it in 1 million random polynomials and it is not practical for me to do so. I already used y//Tableform and Remove[{}] because I thought that the problem is braces since the random polynomials generated using this command y=randompol[n_,i_]:=Sum[r x^{j},{j,0,n}] is inside a brace while the CountRoots command does not require braces, but i Failed and it did not work.

please help me...

Answer 1

There are a number of issues with your code. First, GaussianDistribution is not a built-in function; I think you want to have NormalDistribution in combination with RandomVariate. Secondly, SetDelayed (:=) returns Null (or $Failed if something went wrong), so y has the value Null after your second line. Hence the lines after that don't work.

Allow me to propose a function that does more or less what you want:

RandomPolynomial[degree_Integer?Positive, distribution_:NormalDistribution[]] := 
  With[{functionbody = Sum[RandomVariate @ distribution #^i, {i, 0, degree}]},
    functionbody &
  ];

You can then define a random polynomial as follows:

randompol = RandomPolynomial[4]

1.75688 - 0.0960234 # + 0.762145 #^2 - 2.28435 #^3 + 1.34854 #^4 &

This is a so-called pure function; you can let it act on e.g. the variable x to get a function of x:

randompol[x]

1.75688 - 0.0960234 x + 0.762145 x^2 - 2.28435 x^3 + 1.34854 x^4

Counting real roots then works straightforwardly:

CountRoots[randompol[x], x]

0

Then, if you want to generate one million random polynomials, you can do:

randompolys = Table[RandomPolynomial[4], {10^6}]

Finally, the number of real roots can be found by:

numrealroots = CountRoots[#[x], x] & /@ randompolys

Note that this last command will take some time to compute!

Answer 2

ClearAll[myCount];
SetAttributes[myCount, Listable];

myCount[deg_, quant_] := (CountRoots[#, \[FormalX]] & /@ 
        ((Array[\[FormalX]^# &, deg + 1, 0].#) & /@ 
     RandomVariate[NormalDistribution[], {quant, deg + 1}]))

Needs["ErrorBarPlots`"];
ErrorListPlot[{Mean@#, StandardDeviation@#} & /@ myCount[Range@30, 100], PlotRange -> All]