mmavaesto.nb

Väkiluvun ennustaminen

Ennustetaan Suomen väkiluvun kehitystä sovittamalla vuosien 1910–2000 väkilukutilastoihin eriasteisia polynomeja pienimmän neliösumman menetelmällä.

Suomen väkiluku tuhansina kymmenen vuoden välein vuodesta 1910 vuoteen 2000:

In[1]:=

$\mathrm{tilastot}=\left\{\left\{1,2943.4\right\},\left\{2,3147.6\right\},\left\{3,3462.7\right\},\left\{4,3695.6\right\},\left\{5,4029.8\right\},\left\{6,4446.2\right\},\left\{7,4598.3\right\},\left\{8,4787.7\right\},\left\{9,4998.5\right\},\left\{10,5181.1\right\}\right\};$

Esitetään tilastot graafisesti.

In[2]:=

$\mathrm{vuodet}=\left\{\left\{\left\{1,1910\right\},\left\{2,1920\right\},\left\{3,1930\right\},\left\{4,1940\right\},\left\{5,1950\right\},\left\{6,1960\right\},\left\{7,1970\right\},\left\{8,1980\right\},\left\{9,1990\right\},\left\{10,2000\right\},\left\{11,2010\right\},\left\{12,2020\right\},\left\{13,2030\right\}\right\},\mathrm{Automatic}\right\};$

In[3]:=

$\mathrm{pisteet}=\mathrm{ListPlot}\left[\mathrm{tilastot},\mathrm{AxesOrigin}->\left\{0.8,2900\right\},\mathrm{PlotStyle}->\mathrm{PointSize}\left[0.015\right],\mathrm{Ticks}->\mathrm{vuodet},\mathrm{ImageSize}->\left\{500,\mathrm{Automatic}\right\}\right]$

Out[3]=

$⁃\mathrm{Graphics}⁃$

Kun polynomien sovitus tehdään käyttäen pienimmän neliösumman menetelmää, pyritään minimoimaan kunkin vuoden väkiluvun ja polynomin arvon erotuksen neliöiden summa.

Sovitetaan nyt aineistoon toisen asteen polynomi (vakiotermin kerroin $\mathrm{k0}$, ensimmäisen asteen termin kerroin $\mathrm{k1}$ ja toisen asteen termin kerroin $\mathrm{k2}$). Tehdään ensin matriisi $A$ ja vektori $b$ seuraavasti:

In[4]:=

$A=\mathrm{Table}\left[\mathrm{Table}\left[\mathrm{tilastot}\left[\left[i,1\right]\right]^j,\left\{j,0,2\right\}\right],\left\{i,1,10\right\}\right];$

$\mathrm{MatrixForm}\left[A\right]$

Out[5]//MatrixForm=

$\left(\begin{array}{ccc}1& 1& 1\\ 1& 2& 4\\ 1& 3& 9\\ 1& 4& 16\\ 1& 5& 25\\ 1& 6& 36\\ 1& 7& 49\\ 1& 8& 64\\ 1& 9& 81\\ 1& 10& 100\end{array}\right)$

In[6]:=

$b=\mathrm{tilastot}\left[\left[\mathrm{All},2\right]\right];$

$\mathrm{MatrixForm}\left[b\right]$

Out[7]//MatrixForm=

$\left(\begin{array}{c}2943.4\\ 3147.6\\ 3462.7\\ 3695.6\\ 4029.8\\ 4446.2\\ 4598.3\\ 4787.7\\ 4998.5\\ 5181.1\end{array}\right)$

In[8]:=

$k=\left\{\mathrm{k0},\mathrm{k1},\mathrm{k2}\right\};$

Pienin neliösumma saadaan minimoimalla normi $||\mathrm{Ak}-b||$.

In[9]:=

$\mathrm{Norm}\left[A.k-b\right]$

Out[9]=

$\surd \left({\mathrm{Abs}\left[-2943.4+\mathrm{k0}+\mathrm{k1}+\mathrm{k2}\right]}^2+{\mathrm{Abs}\left[-3147.6+\mathrm{k0}+2\mathrm{k1}+4\mathrm{k2}\right]}^2+{\mathrm{Abs}\left[-3462.7+\mathrm{k0}+3\mathrm{k1}+9\mathrm{k2}\right]}^2+{\mathrm{Abs}\left[-3695.6+\mathrm{k0}+4\mathrm{k1}+16\mathrm{k2}\right]}^2+{\mathrm{Abs}\left[-4029.8+\mathrm{k0}+5\mathrm{k1}+25\mathrm{k2}\right]}^2+{\mathrm{Abs}\left[-4446.2+\mathrm{k0}+6\mathrm{k1}+36\mathrm{k2}\right]}^2+{\mathrm{Abs}\left[-4598.3+\mathrm{k0}+7\mathrm{k1}+49\mathrm{k2}\right]}^2+{\mathrm{Abs}\left[-4787.7+\mathrm{k0}+8\mathrm{k1}+64\mathrm{k2}\right]}^2+{\mathrm{Abs}\left[-4998.5+\mathrm{k0}+9\mathrm{k1}+81\mathrm{k2}\right]}^2+{\mathrm{Abs}\left[-5181.1+\mathrm{k0}+10\mathrm{k1}+100\mathrm{k2}\right]}^2\right)$

In[10]:=

$\mathrm{FindMinimum}\left[\mathrm{Norm}\left[A.k-b\right],\left\{\left\{\mathrm{k0},1\right\},\left\{\mathrm{k1},1\right\},\left\{\mathrm{k2},1\right\}\right\}\right]$

Out[10]=

$\left\{187.53536179690244,\left\{\mathrm{k0}\to 2534.511855333278,\mathrm{k1}\to 342.87133423150124,\mathrm{k2}\to -7.564005519253746\right\}\right\}$

Siis parhaiten dataan sopiva toisen asteen polynomi on $-7.56401x^2+342.871x+2534.51$.

Tämän minimointitehtävän voi tehdä myös ratkaisemalla yhtälön $A^{T}Ak=A^{T}b$.

In[11]:=

$\mathrm{Solve}\left[\mathrm{Transpose}\left[A\right].A.k⩵\mathrm{Transpose}\left[A\right].b,k\right]$

Out[11]=

$\left\{\left\{\mathrm{k0}\to 2534.5116666666568,\mathrm{k1}\to 342.87143939394275,\mathrm{k2}\to -7.564015151515395\right\}\right\}$

Mathematicassa pienimmän neliösumman mukaisen sovituksen saa edellisiä tapoja helpommin komennon Fit avulla. Komennon ensimmäinen argumentti on aineisto, johon sovitetaan toisena argumenttina annettujen funktioiden lineaariyhdistely pienimmän neliösumman menetelmällä. Komennon viimeinen argumentti kertoo muuttujan.

In[12]:=

$\mathrm{fit0}=\mathrm{Fit}\left[\mathrm{tilastot},1,x\right]$

$\mathrm{fit1}=\mathrm{Fit}\left[\mathrm{tilastot},\left\{1,x\right\},x\right]$

$\mathrm{fit2}=\mathrm{Fit}\left[\mathrm{tilastot},\left\{1,x,x^2\right\},x\right]$

$\mathrm{fit3}=\mathrm{Fit}\left[\mathrm{tilastot},\left\{1,x,x^2,x^3\right\},x\right]$

$\mathrm{fit4}=\mathrm{Fit}\left[\mathrm{tilastot},\mathrm{Table}\left[x^i,\left\{i,0,4\right\}\right],x\right]$

$\mathrm{fit5}=\mathrm{Fit}\left[\mathrm{tilastot},\mathrm{Table}\left[x^i,\left\{i,0,5\right\}\right],x\right]$

$\mathrm{fit6}=\mathrm{Fit}\left[\mathrm{tilastot},\mathrm{Table}\left[x^i,\left\{i,0,6\right\}\right],x\right]$

$\mathrm{fit7}=\mathrm{Fit}\left[\mathrm{tilastot},\mathrm{Table}\left[x^i,\left\{i,0,7\right\}\right],x\right]$

$\mathrm{fit8}=\mathrm{Fit}\left[\mathrm{tilastot},\mathrm{Table}\left[x^i,\left\{i,0,8\right\}\right],x\right]$

Out[12]=

$4129.09$

Out[13]=

$2700.9200000000014\text{}+259.66727272727246x$

Out[14]=

$2534.511666666672\text{}+342.8714393939377x-7.56401515151503x^2$

Out[15]=

$2722.5900000000033\text{}+176.0560411810391x+28.60489510489514x^2-2.192055167055173x^3$

Out[16]=

$2933.575000000009\text{}-94.4375485625575x+127.58095862471065x^2-15.71673465423494x^3+0.6147581585081725x^4$

Out[17]=

$2701.346666666654\text{}+288.38734032635267x-73.38586829837388x^2+29.21322261072405x^3-3.8511713286715135x^4+0.1623974358974445x^5$

Out[18]=

$2365.859999999731\text{}+950.3283403268259x-525.0709617330076x^2+171.95634761081035x^3-26.603071581209896x^4+1.9366057692317495x^5-0.05376388888891574x^6$

Out[19]=

$4721.660000010411\text{}-4366.778848389146x+3890.765987757374x^2-1633.6098670888612x^3+375.2464853586272x^4-47.60892401981517x^5+3.1219468954383456x^6-0.08248599439811523x^7$

Out[20]=

$9047.480000048083\text{}-15210.619711093965x+14366.523745168723x^2-6853.4381042807545x^3+1868.6867698149429x^4-302.24563235297484x^5+28.65630106205376x^6-1.470908613441232x^7+0.03155505952367034x^8$

Piirretään polynomien kuvaajat.

In[21]:=

$\mathrm{Needs}\left[''Graphics`Colors`''\right];$

In[22]:=

$\mathrm{plot0}=\mathrm{Plot}\left[\left\{\mathrm{fit0}\right\},\left\{x,0,13\right\},\mathrm{Ticks}->\mathrm{vuodet},\mathrm{PlotStyle}->\mathrm{LightBlue},\mathrm{ImageSize}->\left\{500,\mathrm{Automatic}\right\}\right]$

Out[22]=

$⁃\mathrm{Graphics}⁃$

In[23]:=

$\mathrm{plot1}=\mathrm{Plot}\left[\left\{\mathrm{fit1}\right\},\left\{x,0,13\right\},\mathrm{Ticks}->\mathrm{vuodet},\mathrm{PlotStyle}->\mathrm{Red},\mathrm{ImageSize}->\left\{500,\mathrm{Automatic}\right\}\right]$

Out[23]=

$⁃\mathrm{Graphics}⁃$

In[24]:=

$\mathrm{plot2}=\mathrm{Plot}\left[\left\{\mathrm{fit2}\right\},\left\{x,0,13\right\},\mathrm{Ticks}->\mathrm{vuodet},\mathrm{PlotStyle}->\mathrm{Orange},\mathrm{ImageSize}->\left\{500,\mathrm{Automatic}\right\}\right]$

Out[24]=

$⁃\mathrm{Graphics}⁃$

In[25]:=

$\mathrm{plot3}=\mathrm{Plot}\left[\left\{\mathrm{fit3}\right\},\left\{x,0,13\right\},\mathrm{Ticks}->\mathrm{vuodet},\mathrm{PlotStyle}->\mathrm{Green},\mathrm{ImageSize}->\left\{500,\mathrm{Automatic}\right\}\right]$

Out[25]=

$⁃\mathrm{Graphics}⁃$

In[26]:=

$\mathrm{plot4}=\mathrm{Plot}\left[\left\{\mathrm{fit4}\right\},\left\{x,0,13\right\},\mathrm{Ticks}->\mathrm{vuodet},\mathrm{PlotStyle}->\mathrm{Blue},\mathrm{ImageSize}->\left\{500,\mathrm{Automatic}\right\}\right]$

Out[26]=

$⁃\mathrm{Graphics}⁃$

In[27]:=

$\mathrm{plot5}=\mathrm{Plot}\left[\left\{\mathrm{fit5}\right\},\left\{x,0,13\right\},\mathrm{Ticks}->\mathrm{vuodet},\mathrm{PlotStyle}->\mathrm{Magenta},\mathrm{ImageSize}->\left\{500,\mathrm{Automatic}\right\}\right]$

Out[27]=

$⁃\mathrm{Graphics}⁃$

In[28]:=

$\mathrm{plot6}=\mathrm{Plot}\left[\left\{\mathrm{fit6}\right\},\left\{x,0,13\right\},\mathrm{Ticks}->\mathrm{vuodet},\mathrm{PlotStyle}->\mathrm{Cyan},\mathrm{ImageSize}->\left\{500,\mathrm{Automatic}\right\}\right]$

Out[28]=

$⁃\mathrm{Graphics}⁃$

In[29]:=

$\mathrm{plot7}=\mathrm{Plot}\left[\left\{\mathrm{fit7}\right\},\left\{x,0,13\right\},\mathrm{Ticks}->\mathrm{vuodet},\mathrm{PlotStyle}->\mathrm{Black},\mathrm{ImageSize}->\left\{500,\mathrm{Automatic}\right\}\right]$

Out[29]=

$⁃\mathrm{Graphics}⁃$

In[30]:=

$\mathrm{plot8}=\mathrm{Plot}\left[\left\{\mathrm{fit8}\right\},\left\{x,0,13\right\},\mathrm{Ticks}->\mathrm{vuodet},\mathrm{PlotStyle}->\mathrm{Brown},\mathrm{ImageSize}->\left\{500,\mathrm{Automatic}\right\}\right]$

Out[30]=

$⁃\mathrm{Graphics}⁃$

In[31]:=

$\mathrm{Show}\left[\mathrm{pisteet},\mathrm{plot0},\mathrm{plot1},\mathrm{plot2},\mathrm{plot3},\mathrm{plot4},\mathrm{plot5},\mathrm{plot6},\mathrm{plot7},\mathrm{plot8}\right];$

Kuinka suuri on Suomen väkiluku vuonna 2050 toisen ja kolmannen asteen polynomien antamien ennusteiden mukaan?
Entä 7. asteen polynomin mukaan?
Kuinka hyvin polynomit sopivat väestön kehityksen ennustamiseen?

Linkkejä

Matriisi
Vektorit ja matriisit Mathematicassa
Vektorien laskutoimituksia Mathematicassa
Matriisien laskutoimituksia Maplessa
    Liite  Väkiluvun ennustaminen


Ossi Mauno 9.12.2004

Created by Mathematica  (December 9, 2004)