Non-Linear Regression

by Muhammad Nachnoer Novatron Fitra Arss

A. Awalan

  1. Packages 

    2. lapply(c("MultiKink","ggplot2","dplyr","purrr","car",
         "hrbrthemes","MLmetrics","splines","ggcorrplot","ISLR","hrbrthemes"),
       library,character.only=T)[[1]]
    ## [1] "MultiKink" "stats"     "graphics"  "grDevices" "utils"     "datasets" 
## [7] "methods"   "base"

  2. Data 

    3. Au<-Auto[,c(1,4,8)];glimpse(Au)
    ## Rows: 392
## Columns: 3
## $ mpg        <dbl> 18, 15, 18, 16, 17, 15, 14, 14, 14, 15, 15, 14, 15, 14, 24,~
## $ horsepower <dbl> 130, 165, 150, 150, 140, 198, 220, 215, 225, 190, 170, 160,~
## $ origin     <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 3, 2,~

  3. Corrplot untuk menentukan 1 peubah dengan korelasi tertinggi yang akan dimasukkan ke dalam Regresi Linear Sederhana 

    4. ggcorrplot(cor(Au),type="lower",lab = T,lab_col = "white")+theme_tinyhand(axis_title_just = "center", axis_text_size = 12,
                  axis_title_size =13)+theme(plot.title= element_text(hjust=0.5,color="white"),plot.background=element_rect(fill="#000044",color="#000044"),
      axis.title = element_text(color="white"),axis.text = element_text(color="white"),legend.text = element_text(color="white"),legend.title = element_text(color="white"))

  4. Uji Korelasi Pearson 

    5. cor.test(Au$mpg,Au$horsepower)
    ## 
##  Pearson's product-moment correlation
## 
## data:  Au$mpg and Au$horsepower
## t = -24.489, df = 390, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.8146631 -0.7361359
## sample estimates:
##        cor 
## -0.7784268

B. Knots untuk Basis & Natural Spline Regression

  1. Grafik dasar penentuan knots dugaan untuk peubah origin 

    2. scatterplot(Au$origin,Au$mpg)

    • Interpretasi: Berdasarkan scatterplot di atas dapat diamati bahwa peubah origin terkesan patah pola di 1.5 dan 2.5, maka itulah knots dugaan awalnya

  2. Grafik dasar penentuan knots dugaan untuk peubah horsepower 

    3. scatterplot(Au$horsepower,Au$mpg)

    • Interpretasi: Berdasarkan scatterplot di atas dapat diamati bahwa peubah horsepower terkesan patah pola di 100, 150, dan 200, maka itulah knots dugaan awalnya

  3. Penentuan degree of freedom (df) berdasarkan knots dugaan 

    4. dim(bs(Au$origin,knots=c(1.5,2.5)))
    ## [1] 392   5
    dim(bs(Au$horsepower,knots=c(100,150,200)))
    ## [1] 392   6
    dim(ns(Au$origin,knots=c(1.5,2.5)))
    ## [1] 392   3
    dim(ns(Au$horsepower,knots=c(100,150,200)))
    ## [1] 392   4

  4. Knots auto berdasarkan df dari poin sebelumnya 

    5. c(attr(bs(Au$origin,df=5),"knots"))
    ## 33.33333% 66.66667% 
##         1         2
    c(attr(bs(Au$horsepower,df=6),"knots"))
    ##   25%   50%   75% 
##  75.0  93.5 126.0
    c(attr(ns(Au$origin,df=3),"knots"))
    ## 33.33333% 66.66667% 
##         1         2
    c(attr(ns(Au$horsepower,df=4),"knots"))
    ##   25%   50%   75% 
##  75.0  93.5 126.0

C. Regresi Linear Sederhana

  1. Basis-Spline Regression dengan knots manual 

    2. mods1<-lm(mpg~bs(horsepower,knots=c(100,150,200)),Au)
    marginalModelPlots(mods1)

  2. Basis-Spline Regresssion dengan knots auto 

    3. mods2<-lm(mpg~bs(horsepower,knots=c(75,93.5,126)),Au)
    marginalModelPlots(mods2)

  3. Natural-Spline Regresssion dengan knots manual 

    4. mods3<-lm(mpg~ns(horsepower,knots=c(100,150,200)),Au)
    marginalModelPlots(mods3)

  4. Natural-Spline Regresssion dengan knots auto 

    5. mods4<-lm(mpg~ns(horsepower,knots=c(75,93.5,126)),Au)
    marginalModelPlots(mods4)

    • Interpretasi: Berdasarkan keempat marginal plot dari model linear sederhana di atas, dapat diketahui bahwa garis dugaan model yang paling berhimpit dengan data aktual (minimum error secara eksploratif) adalah Model 2 yaitu Basis Spline Regression Model dengan knots auto (75,93.5,126)

D. Regresi Linear Berganda

  1. Basis-Spline Multiple Regresssion dengan knots dugaan 

    2. mods5<-lm(mpg~bs(horsepower,knots=c(100,150,200))+
            bs(origin,knots=c(1.5,2.5)),Au)
    marginalModelPlots(mods5)

  2. Basis-Spline Multiple Regresssion dengan knots auto 

    3. mods6<-lm(mpg~bs(horsepower,knots=c(75,93.5,126))+
            bs(origin,knots=c(1,2)),Au)
    marginalModelPlots(mods6)

  3. Natural-Spline Multiple Regresssion dengan knots dugaan 

    4. mods7<-lm(mpg~ns(horsepower,knots=c(100,150,200))+
            bs(origin,knots=c(1.5,2.5)),Au)
    marginalModelPlots(mods7)

  4. Basis-Spline Multiple Regresssion dengan knots auto 

    5. mods8<-lm(mpg~ns(horsepower,knots=c(75,93.5,126))+
            ns(origin,knots=c(1,2)),Au)
    marginalModelPlots(mods8)

    • Interpretasi: Berdasarkan keempat marginal plot dari model linear berganda di atas, dapat diketahui bahwa garis dugaan model yang paling berhimpit dengan data aktual (minimum error secara eksploratif) adalah Model 5 yaitu Basis-Spline Multiple Regresssion Model dengan knots dugaan (horsepower= (100,150,200), origin=(1.5,2.5)) dan Model 6 yaitu Basis-Spline Multiple Regresssion dengan knots auto (horsepower= (75,93.5,126), origin=(1,2))

E. Akhiran

  1. Metriks Kebaikan Model 

    2. ktg1<-tail(anova(mods1)[,3],1);rs1<-summary(mods1)$r.square
ktg2<-tail(anova(mods2)[,3],1);rs2<-summary(mods2)$r.square
ktg3<-tail(anova(mods3)[,3],1);rs3<-summary(mods3)$r.square
ktg4<-tail(anova(mods4)[,3],1);rs4<-summary(mods4)$r.square
ktg5<-tail(anova(mods5)[,3],1);rs5<-summary(mods5)$r.square
ktg6<-tail(anova(mods6)[,3],1);rs6<-summary(mods6)$r.square
ktg7<-tail(anova(mods7)[,3],1);rs7<-summary(mods7)$r.square
ktg8<-tail(anova(mods7)[,3],1);rs8<-summary(mods8)$r.square
met<-round(data.frame(KTG=c(ktg1,ktg2,ktg3,ktg4,ktg5,ktg6,ktg7,ktg8),
                 R.Square=c(rs1,rs2,rs3,rs4,rs5,rs6,rs7,rs8)),3);met
    ##      KTG R.Square
## 1 18.755    0.697
## 2 18.436    0.702
## 3 19.020    0.691
## 4 18.730    0.696
## 5 16.842    0.729
## 6 16.728    0.731
## 7 17.078    0.724
## 8 17.078    0.729

  2. Model Terbaik Berdasarkan R-Square & KTG 

    3. met[which.max(met$R.Square),]
    ##      KTG R.Square
## 6 16.728    0.731
    met[which.min(met$KTG),]
    ##      KTG R.Square
## 6 16.728    0.731

    • Interpretasi: Didapatkan model terbaik berdasarkan R-Square tertinggi dan KTG terendah yaitu model 6 (Basis-Spline Multiple Regresssion Model dengan Knots auto (origin=(75,93.5,126),horsepower=(1,2))

F. Simulasi Pemodelan Polinomial dan Fungsi Tangga

  1. Data Bangkitan 

    2. set.seed(123)
x<-rnorm(1000,1,1)
res<-rnorm(1000)
y<-5+2*x+3*x^2+res

  2. Model Linear 

    3. mod<-lm(y~x);summary(mod)
    ## 
## Call:
## lm(formula = y ~ x)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -5.686 -2.574 -1.428  1.195 27.185 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   4.6056     0.1902   24.22   <2e-16 ***
## x             8.3790     0.1340   62.54   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.2 on 998 degrees of freedom
## Multiple R-squared:  0.7967, Adjusted R-squared:  0.7965 
## F-statistic:  3911 on 1 and 998 DF,  p-value: < 2.2e-16

  3. Model Polinomial 

    4. pmod<-lm(y~x+I(x^2));summary(pmod)
    ## 
## Call:
## lm(formula = y ~ x + I(x^2))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.0319 -0.6942  0.0049  0.7116  3.2855 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.95193    0.04568  108.41   <2e-16 ***
## x            2.10732    0.05861   35.95   <2e-16 ***
## I(x^2)       2.99081    0.02338  127.93   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.007 on 997 degrees of freedom
## Multiple R-squared:  0.9883, Adjusted R-squared:  0.9883 
## F-statistic: 4.221e+04 on 2 and 997 DF,  p-value: < 2.2e-16

  4. Step Function Regression 

    5. range(x)
    ## [1] -1.809775  4.241040
    c1<-as.factor(ifelse(x<=0,1,0))
c2<-as.factor(ifelse(x<=2 & x>0,1,0))
c3<-as.factor(ifelse(x>2,1,0))
cb<-data.frame(c1,c2,c3)
stepmod<-lm(y~c1+c2+c3);summary(stepmod)
    ## 
## Call:
## lm(formula = y ~ c1 + c2 + c3)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -10.395  -3.534  -0.530   2.527  36.876 
## 
## Coefficients: (1 not defined because of singularities)
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  30.4499     0.4087   74.50   <2e-16 ***
## c11         -25.2395     0.5710  -44.21   <2e-16 ***
## c21         -19.4184     0.4536  -42.81   <2e-16 ***
## c31               NA         NA      NA       NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5.121 on 997 degrees of freedom
## Multiple R-squared:  0.698,  Adjusted R-squared:  0.6974 
## F-statistic:  1152 on 2 and 997 DF,  p-value: < 2.2e-16

    • Interpretasi: Dari hasil summary, model terbaik berdasarkan R-Square adalah polinomial (R2=0.99). Hal ini sesuai dengan persamaan dari data bangkitan yang berupa pangkat

  5. Grafik Perbandingan 

    6. plot(x,y,xlim=c(-2,5),ylim=c(-10,70),col="navyblue",main="Grafik Simulasi Pemodelan")
abline(v=1,col="red",lty=2)
lines(x,mod$fitted.values,col="coral",lwd=2)
lines(x[order(x)],pmod$fitted.values[order(x)],col="red",lwd=2)
lines(x[order(x)],stepmod$fitted.values[order(x)],lwd=2,col="green")
legend("topleft",legend=c("Aktual","Linear","Polinomial","Step function"),fill=c("navyblue","coral","red","green"),lty=1)

    • Interpretasi: Dapat dilihat pada grafik, bahwa memang benar model yang paling sesuai dengan pola aktual adalah model polinomial