Sovitus polynomi regressio R

. (Voit raportoida ongelman sisällöstä tällä sivulla täällä)Haluatko jakaa sisältöä R-bloggaajat?

lineaarinen suhde kahden muuttujan x ja y välillä on yksi yleisimmistä, tehokkaimmista ja helpoimmista oletuksista, joita tehdään, kun yritetään selvittää niiden suhdetta. Joskus todellinen taustalla oleva suhde on kuitenkin monimutkaisempi, ja tällöin apuun tulee polynomin regressio.

katsotaan esimerkki taloustieteestä: Oletetaan, että haluaisit ostaa tietyn määrän q tiettyä tuotetta. Jos yksikköhinta on p, maksaisi kokonaissumma y. Tämä on tyypillinen esimerkki lineaarisesta suhteesta. Kokonaishinta ja määrä ovat suoraan verrannollisia. Sen piirtämiseksi kirjoittaisimme jotain tällaista.:

p <- 0.5q <- seq(0,100,1)y <- p*qplot(q,y,type='l',col='red',main='Linear relationship')

juoni näyttää tältä:
linear-relationship

tämä on hyvä likiarvo todellisesta suhteesta y: n ja q: n välillä, mutta ostettaessa ja myytäessä kannattaa ottaa huomioon muitakin oleellisia tietoja, kuten: Ostaa merkittäviä määriä on todennäköistä, että voimme kysyä ja saada alennusta, tai ostaa enemmän ja enemmän tietyn hyvän saatamme työntää hintaa ylös.
tämä voi johtaa tämänkaltaiseen skenaarioon, jossa kokonaiskustannukset eivät ole enää määrän lineaarinen funktio:

y <- 450 + p*(q-10)^3plot(q,y,type='l',col='navy',main='Nonlinear relationship',lwd=3)

Rplot02
polynomiregression avulla voimme sovittaa aineistoon kertaluvun n > 1 malleja ja yrittää mallintaa epälineaarisia suhteita.

kuinka sovittaa polynomiregressio

ensin, muista aina käyttää set.seed(n) kun generoit pseudo-satunnaislukuja. Näin tekemällä satunnaislukugeneraattori tuottaa aina samat numerot.

set.seed(20)

Predikaattori (q). Käytä seq: ta tasavälisten sekvenssien tuottamiseen nopeasti

q <- seq(from=0, to=20, by=0.1)

ennustettava arvo (y):

y <- 500 + 0.4 * (q-10)^3

jonkin verran melua syntyy ja lisätään todellinen signaali (y):

noise <- rnorm(length(q), mean=10, sd=80)noisy.y <- y + noise

äänekkään signaalin juoni:

plot(q,noisy.y,col='deepskyblue4',xlab='q',main='Observed data')lines(q,y,col='firebrick1',lwd=3)

tämä on simuloidun havaintoaineiston juoni. Simuloidut datapisteet ovat sinisiä pisteitä, kun taas punainen viiva on signaali (signaali on tekninen termi, jota käytetään usein osoittamaan yleistä suuntausta, jonka havaitsemisesta olemme kiinnostuneita).
Rplot03
mallimme pitäisi olla jotain tällaista: y = a*q + b*q2 + c*q3 + cost

sovitetaanpa SE R: llä.sovittaessa polynomeja voi käyttää joko

model <- lm(noisy.y ~ poly(q,3))

tai

model <- lm(noisy.y ~ x + I(X^2) + I(X^3))

kuitenkin huomaa, että q, I(q^2) ja I(q^3) korreloivat ja korreloivat muuttujat voivat aiheuttaa ongelmia. Käyttämällä poly() voit välttää tämän tuottamalla ortogonaalisia polynomeja, joten aion käyttää ensimmäistä vaihtoehtoa.

summary(model)Call:lm(formula = noisy.y ~ poly(q, 3))Residuals: Min 1Q Median 3Q Max -212.326 -51.186 4.276 61.485 165.960 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 513.615 5.602 91.69 <2e-16 ***poly(q, 3)1 2075.899 79.422 26.14 <2e-16 ***poly(q, 3)2 -108.004 79.422 -1.36 0.175 poly(q, 3)3 864.025 79.422 10.88 <2e-16 ***---Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Residual standard error: 79.42 on 197 degrees of freedomMultiple R-squared: 0.8031,Adjusted R-squared: 0.8001 F-statistic: 267.8 on 3 and 197 DF, p-value: 0 

käyttämällä confint() funktiota saadaan mallimme parametrien luottamusvälit.
malliparametrien luottamusvälit:

confint(model, level=0.95) 2.5 % 97.5 %(Intercept) 502.5676 524.66261poly(q, 3)1 1919.2739 2232.52494poly(q, 3)2 -264.6292 48.62188poly(q, 3)3 707.3999 1020.65097

Plot of fitted vs residuals. Jäljelle jäävässä kuviossa ei saa näkyä selkeää kuviota, jos malli sopii hyvin

plot(fitted(model),residuals(model))

Rplot04
kaiken kaikkiaan malli vaikuttaa hyvältä istuvuudelta, kuten 0,8: n R-neliö osoittaa. Ensimmäisen ja kolmannen kertaluvun termien kertoimet ovat tilastollisesti merkitseviä, kuten odotimme. Nyt voimme käyttää predict() – funktiota saadaksemme sovitut arvot ja luottamusvälit, jotta voimme piirtää kaiken dataamme vastaan.

ennustetut arvot ja luottamusvälit:

predicted.intervals <- predict(model,data.frame(x=q),interval='confidence', level=0.99)

Lisää rivejä olemassa olevaan havaintoalaan:

lines(q,predicted.intervals,col='green',lwd=3)lines(q,predicted.intervals,col='black',lwd=1)lines(q,predicted.intervals,col='black',lwd=1)

lisää selitys:

legend("bottomright",c("Observ.","Signal","Predicted"), col=c("deepskyblue4","red","green"), lwd=3)

tässä on juoni:
Rplot05
voimme nähdä, että mallimme teki kunnollista työtä tietojen sovittamisessa, ja siksi voimme olla tyytyväisiä siihen.

varoituksen sana: Polynomit ovat tehokkaita työkaluja, mutta saattavat kostautua: tällöin tiesimme alkuperäisen signaalin syntyneen kolmannen asteen polynomin avulla, mutta reaalitietoa analysoitaessa tiedämme siitä yleensä vain vähän ja siksi meidän on oltava varovaisia, koska korkean kertaluvun polynomien (n > 4) käyttö voi johtaa ylisovitukseen. Ylisovitus tapahtuu, kun malli on poimien melua sijaan signaali: vaikka malli on saada paremmin ja paremmin sovittaa olemassa olevia tietoja, tämä voi olla huono, kun yrität ennustaa uusia tietoja ja johtaa harhaanjohtavia tuloksia.

tämän esimerkin koko koodi löytyy täältä.

kiitos tämän postauksen lukemisesta, jätä kommentti alle, jos sinulla on kysyttävää.

Vastaa

Sähköpostiosoitettasi ei julkaista.