Probability a polynomial has a root which is a root of unity Consider a degree $n$ polynomial $P(x)$ with coefficients $c_i \in \{-1,0,1\}$ chosen uniformly and independently.

What is the probability that $P(x)$ has a root which is a root of
  unity?

Previously asked at https://math.stackexchange.com/questions/798082/probability-a-polynomial-has-a-root-which-is-a-root-of-unity
 A: As discussed in comments, I think for large $n$ the probability that it has a root which is a root of unity is double the probability that 1 is a root. For large $n$, $P(1)$ is a random variable whose distribution is approximately normal and whose variance is $\sigma^2=2n/3$. The probability that $P(1)=0$ is then approximately $1/\sigma\sqrt{2\pi}$. Doubling this gives a probability $\sqrt{3/\pi n}\approx 0.98 n^{-1/2}$. This seems to agree quite well with the final two values in Matt F.'s list:
$$\frac{263}{729}=0.361 \qquad \sqrt{\frac{3}{7\pi}}=0.369$$
$$\frac{2267}{6561}=0.346 \qquad \sqrt{\frac{3}{8\pi}}=0.345$$
A: I get $$\left\{\frac{2}{3},\frac{2}{3},\frac{4}{9},\frac{35}{81},\frac{94}{243},\frac{275}{729}
   ,\frac{263}{729},\frac{2267}{6561}\right\}$$
for the monic polynomials of degree 1 to 8, using Mathematica:
f[a_, b_] := a x^(b - 1)

PolysOfDegree[n_] := First /@ Table[ x^n + Plus @@
                     MapIndexed[f, IntegerDigits[i, 3, n] - 1], {i, 0, 3^n - 1}]

TestFactors[n_] := Table[FactorList[x^i - 1], {i, 1, 2 n + 2}]
                   // Flatten // Union // Rest

HasRootOfUnityAsRoot[poly_] := Or @@ Map[ PolynomialMod[poly , #] === 0 &,
                                          TestFactors[Exponent[poly, x]]]

Prob[n_] := Count[Map[HasRootOfUnityAsRoot, PolysOfDegree[n]], True]/3^n

Table[Prob[n], {n,1,8}]

I've enumerated the polynomials of degree $n$, and enumerated the characteristic polynomials of roots of unity of degree up to $2n+2$.  Then it's just a matter of testing which are divisible by which.
