Wilkinson Polynomial Condition Number
Purpose
To work on concepts related to Chapter 11
Wilkinson Polynomial
> library(polynom) > p <- polynomial(1) > for (i in 1:20) { + p <- p * polynomial(c(-i, 1)) + } > wilk <- as.function(p) > print(p) 2432902008176640000 - 8752948036761600000*x + 13803759753640699904*x^2 - 1.2870931245151e+19*x^3 + 8037811822645052416*x^4 - 3599979517947607040*x^5 + 1206647803780372992*x^6 - 311333643161390720*x^7 + 63030812099294896*x^8 - 10142299865511450*x^9 + 1307535010540395*x^10 - 135585182899530*x^11 + 11310276995381*x^12 - 756111184500*x^13 + 40171771630*x^14 - 1672280820*x^15 + 53327946*x^16 - 1256850*x^17 + 20615*x^18 - 210*x^19 + x^20 |
Perturb coefficient of x^19
> p <- polynomial(1) > delta <- 10^(-10) > for (i in 1:20) { + p <- p * polynomial(c(-i, 1)) + } > coefs <- coef(p) > coefs[20] <- coefs[20] + delta > q <- polynomial(coefs) > roots <- solve(q) > num <- (as.real(roots) - 1:20)/(1:20) > denom <- delta/210 > print(abs(round(num/denom))) [1] 0 2 64 688 6023 21113 [7] 740827 13409515 112938531 604315082 2382813387 6615177797 [13] 17187871827 26228890219 46778830844 45372718091 25027432627 14144780190 [19] 3418301551 473250162 > print(which.max(abs(round(num/denom)))) [1] 15 |
Perturb coefficient of x^15
> p <- polynomial(1) > delta <- 10^(-10) > for (i in 1:20) { + p <- p * polynomial(c(-i, 1)) + } > coefs <- coef(p) > coefs[16] <- coefs[16] + delta > q <- polynomial(coefs) > roots <- solve(q) > num <- (as.real(roots) - 1:20)/(1:20) > denom <- delta/210 > print(abs(round(num/denom))) [1] 0 6 275 4502 37013 188876 [7] 798259 4087109 23229309 108196501 371447471 948653199 [13] 1770324181 2524013797 2641062547 2022974705 1124210309 411491811 [19] 92387368 9377744 > print(which.max(abs(round(num/denom)))) [1] 15 |
Most sensitive root for the polynomial is x = 15. It is most sensitive to the coefficient a15.
4th order Wilkinson
> p <- polynomial(1) > for (i in 1:4) { + p <- p * polynomial(c(-i, 1)) + } > p 24 - 50*x + 35*x^2 - 10*x^3 + x^4 > wilk <- as.function(p) > print(wilk(1:4)) [1] 0 0 0 0 |
18th order Wilkinson
> p <- polynomial(1) > for (i in 1:16) { + p <- p * polynomial(c(-i, 1)) + } > p 20922789888000 - 70734282393600*x + 102992244837120*x^2 - 87077748875904*x^3 + 48366009233424*x^4 - 18861567058880*x^5 + 5374523477960*x^6 - 1146901283528*x^7 + 185953177553*x^8 - 23057159840*x^9 + 2185031420*x^10 - 156952432*x^11 + 8394022*x^12 - 323680*x^13 + 8500*x^14 - 136*x^15 + x^16 > wilk <- as.function(p) > print(wilk(1:16)) [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 |
19th order Wilkinson
> p <- polynomial(1) > for (i in 1:19) { + p <- p * polynomial(c(-i, 1)) + } > p -121645100408832000 + 431565146817638400*x - 668609730341153280*x^2 + 610116075740491776*x^3 - 371384787345228032*x^4 + 161429736530119008*x^5 - 52260903362512720*x^6 + 12953636989943900*x^7 - 2503858755467550*x^8 + 381922055502195*x^9 - 46280647751910*x^10 + 4465226757381*x^11 - 342252511900*x^12 + 20692933630*x^13 - 973941900*x^14 + 34916946*x^15 - 920550*x^16 + 16815*x^17 - 190*x^18 + x^19 > wilk <- as.function(p) > print(wilk(1:19)) [1] 0 0 0 8192 38400 82944 150528 393216 [9] 839808 1280000 1874048 3317760 5494528 7375872 9734400 14680064 [17] 21381376 26873856 33362176 |
You see that once you get in to 19th order polynomial ,
errors start creeping in Basically machine epsilon is closely related to this.