plot( data.x,y,xlim=c(-2,5), ylim=c( -10,70), pch=16,col="orange")
abline(v=0,col="red", lty=2)
abline(v=2,col="red", lty=2)

hx1 <- ifelse( data.x>0,(data.x-0)^3,0)
hx2 <- ifelse( data.x>2,(data.x-2)^3,0)

cubspline.mod2 <- lm( y~data.x+I(data.x^2)+I(data.x^3)+hx1+hx2)
ix <- sort( data.x,index.return=T)$ix
lines( data.x[ix],cubspline.mod2$fitted.values[ix],col="blue", lwd=2)

Perbandingan 1 Knots dan 2 Knots dengan 5-fold CV

##1 knots
data.all <- cbind( y,data.x,hx)
set.seed(456)
ind <- sample(1:5,length( data.x),replace=T)
res <- c()
for( i in 1:5){
  dt.train <- data.all[ ind!=i,]
  x.test <- data.all[ ind==i, -1]
  y.test <- data.all[ ind==i,1]
  mod1 <- lm( dt.train[,1]~dt.train[,2]+I( dt.train[,2]^2)+I( dt.train[,2]^3)+dt.train[,3])
  x.test.olah <- cbind(1,x.test[,1], x.test[,1]^2,x.test[,1]^3,x.test[,2])
  beta <- coefficients(mod1)
  prediksi <- x.test.olah%*%beta
  res <- c( res,mean(( y.test-prediksi)^2))
}
res

## [1] 22.08767 21.39598 29.47677 29.68683 25.18070

mean(res)

## [1] 25.56559

##2 knots (knots = 0,2)
data.all2 <- cbind(y,data.x,hx1,hx2)
set.seed(456)
ind2 <- sample(1:5,length( data.x),replace=T)
res2 <- c()
for( i in 1:5){
  dt.train2 <- data.all2[ind2!=i,]
  x.test2 <- data.all2[ind2==i,-1]
  y.test2 <- data.all2[ind2==i,1]
  mod2 <- lm(dt.train2[,1]~dt.train2[,2]+I(dt.train2[,2]^2)+I(dt.train2[,2]^3)+dt.train2[,3]+dt.train2[,4])
  x.test.olah2 <- cbind(1,x.test2[,1],x.test2[,1]^2,x.test2[,1]^3,x.test2[,2],x.test2[,3])
  beta2 <- coefficients(mod2)
  prediksi2 <- x.test.olah2%*%beta2
  res2 <- c(res2,mean((y.test2-prediksi2)^2))
}
res2

## [1] 22.32898 21.33868 29.40459 29.79913 25.22047

mean(res2)

## [1] 25.61837

mod_linear <- lm(triceps~age,data=triceps)
summary(mod_linear)

## 
## Call:
## lm(formula = triceps ~ age, data = triceps)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -12.9512  -2.3965  -0.5154   1.5822  25.1233 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.19717    0.21244   29.17   <2e-16 ***
## age          0.21584    0.01014   21.28   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.007 on 890 degrees of freedom
## Multiple R-squared:  0.3372, Adjusted R-squared:  0.3365 
## F-statistic: 452.8 on 1 and 890 DF,  p-value: < 2.2e-16

Ringkasan Nilai R-squared dan AIC

ringkasan_linear <- summary(mod_linear)
ringkasan_linear$r.squared

## [1] 0.3372092

AIC(mod_linear)

## [1] 5011.515

tabel_data <- rbind(data.frame("Y_Aktual" = triceps$triceps,
                               "Y_Prediksi" = predict(mod_linear),
                               "Residuals" = residuals(mod_linear)))
kableExtra::kable(head(tabel_data) ,caption = 'Ringkasan Nilai R-Squared dan AIC')

Ringkasan Nilai R-Squared dan AIC

Y_Aktual	Y_Prediksi	Residuals
3.4	8.798074	-5.398074
4.0	8.336171	-4.336171
4.2	8.364231	-4.164231
4.2	8.677202	-4.477202
4.4	8.381498	-3.981498
4.4	8.759222	-4.359222

Scatter Plot

ggplot(triceps,aes(x=age, y=triceps)) +
                 geom_point(alpha=0.55, color="black") +
   stat_smooth(method = "lm", 
               formula = y~x,lty = 1,
               col = "purple",se = F)+
  theme_bw()

mod_polinomial2 <- lm(triceps ~ poly(age,2,raw = T),
                     data=triceps)
summary(mod_polinomial2)

## 
## Call:
## lm(formula = triceps ~ poly(age, 2, raw = T), data = triceps)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -12.5677  -2.4401  -0.4587   1.6368  24.9961 
## 
## Coefficients:
##                          Estimate Std. Error t value Pr(>|t|)    
## (Intercept)             6.0229191  0.3063806  19.658  < 2e-16 ***
## poly(age, 2, raw = T)1  0.2434733  0.0364403   6.681 4.17e-11 ***
## poly(age, 2, raw = T)2 -0.0006257  0.0007926  -0.789     0.43    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.008 on 889 degrees of freedom
## Multiple R-squared:  0.3377, Adjusted R-squared:  0.3362 
## F-statistic: 226.6 on 2 and 889 DF,  p-value: < 2.2e-16

Scatter Plot

ggplot(triceps,aes(x=age, y=triceps)) + 
  geom_point(alpha=0.55, color="black") +
  stat_smooth(method = "lm", 
               formula = y~poly(x,2,raw=T), 
               lty = 1, col = "purple",se = F)+
  theme_bw()

Scatter Plot dengan Standard Error

ggplot(triceps,aes(x=age, y=triceps)) + 
  geom_point(alpha=0.55, color="black") +
  stat_smooth(method = "lm", 
               formula = y~poly(x,2,raw=T), 
               lty = 1, col = "purple",se = T)+
  theme_bw()

mod_polinomial3 = lm(triceps ~ poly(age,3,raw = T),data=triceps)
summary(mod_polinomial3)

## 
## Call:
## lm(formula = triceps ~ poly(age, 3, raw = T), data = triceps)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11.5832  -1.9284  -0.5415   1.3283  24.4440 
## 
## Coefficients:
##                          Estimate Std. Error t value Pr(>|t|)    
## (Intercept)             8.004e+00  3.831e-01  20.893  < 2e-16 ***
## poly(age, 3, raw = T)1 -3.157e-01  7.721e-02  -4.089 4.73e-05 ***
## poly(age, 3, raw = T)2  3.101e-02  3.964e-03   7.824 1.45e-14 ***
## poly(age, 3, raw = T)3 -4.566e-04  5.612e-05  -8.135 1.38e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.868 on 888 degrees of freedom
## Multiple R-squared:  0.3836, Adjusted R-squared:  0.3815 
## F-statistic: 184.2 on 3 and 888 DF,  p-value: < 2.2e-16

Scatter Plot dengan Standard Error

ggplot(triceps,aes(x=age, y=triceps)) + 
  geom_point(alpha=0.55, color="black") +
  stat_smooth(method = "lm", 
               formula = y~poly(x,3,raw=T), 
               lty = 1, col = "purple",se = T)+
  theme_bw()

mod_tangga5 <- lm(triceps ~ cut(age,5),data=triceps)
summary(mod_tangga5)

## 
## Call:
## lm(formula = triceps ~ cut(age, 5), data = triceps)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -10.5474  -2.0318  -0.4465   1.3682  23.3759 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)              7.2318     0.1994  36.260  < 2e-16 ***
## cut(age, 5)(10.6,20.9]   1.6294     0.3244   5.023 6.16e-07 ***
## cut(age, 5)(20.9,31.2]   5.9923     0.4222  14.192  < 2e-16 ***
## cut(age, 5)(31.2,41.5]   7.5156     0.4506  16.678  < 2e-16 ***
## cut(age, 5)(41.5,51.8]   7.4561     0.5543  13.452  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.939 on 887 degrees of freedom
## Multiple R-squared:  0.3617, Adjusted R-squared:  0.3588 
## F-statistic: 125.7 on 4 and 887 DF,  p-value: < 2.2e-16

Scatter Plot

ggplot(triceps,aes(x=age, y=triceps)) +
       geom_point(alpha=0.55, color="black") +
       stat_smooth(method = "lm", 
               formula = y~cut(x,5), 
               lty = 1, col = "purple",se = F)+
  theme_bw()

mod_tangga7 <- lm(triceps ~ cut(age,7),data=triceps)
summary(mod_tangga7)

## 
## Call:
## lm(formula = triceps ~ cut(age, 7), data = triceps)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -10.8063  -1.7592  -0.4366   1.2894  23.1461 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)              7.5592     0.2219  34.060  < 2e-16 ***
## cut(age, 7)(7.62,15]    -0.6486     0.3326  -1.950   0.0515 .  
## cut(age, 7)(15,22.3]     3.4534     0.4239   8.146 1.27e-15 ***
## cut(age, 7)(22.3,29.7]   5.8947     0.4604  12.804  < 2e-16 ***
## cut(age, 7)(29.7,37]     7.8471     0.5249  14.949  < 2e-16 ***
## cut(age, 7)(37,44.4]     6.9191     0.5391  12.835  < 2e-16 ***
## cut(age, 7)(44.4,51.8]   6.3013     0.6560   9.606  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.805 on 885 degrees of freedom
## Multiple R-squared:  0.4055, Adjusted R-squared:  0.4014 
## F-statistic: 100.6 on 6 and 885 DF,  p-value: < 2.2e-16

Scatter Plot

ggplot(triceps,aes(x=age, y=triceps)) +
       geom_point(alpha=0.55, color="black") +
       stat_smooth(method = "lm", 
               formula = y~cut(x,7), 
               lty = 1, col = "purple",se = F)+
  theme_bw()

Regresi Linear

set.seed(123)
cross_val <- vfold_cv(triceps,v=10,strata = "triceps") #Biasanya menggunakan v = 5 atau 10 (batas wajar)
metric_linear <- map_dfr(cross_val$splits,
    function(x){
    mod <- lm(triceps ~ age,data=triceps[x$in_id,])
    pred <- predict(mod,newdata=triceps[-x$in_id,])
    truth <- triceps[-x$in_id,]$triceps
    rmse <- mlr3measures::rmse(truth = truth,response = pred)
    mae <- mlr3measures::mae(truth = truth,response = pred)
    metric <- c(rmse,mae)
    names(metric) <- c("rmse","mae") #mae diabsolutkan
    return(metric)
  }
)
metric_linear

## # A tibble: 10 x 2
##     rmse   mae
##    <dbl> <dbl>
##  1  3.65  2.82
##  2  4.62  3.22
##  3  4.38  3.00
##  4  3.85  2.80
##  5  3.08  2.36
##  6  3.83  2.81
##  7  3.59  2.78
##  8  4.66  3.06
##  9  3.50  2.56
## 10  4.59  2.93

#Menghitung rata-rata untuk 10 folds
mean_metric_linear <- colMeans(metric_linear)
mean_metric_linear

##     rmse      mae 
## 3.973249 2.833886

Regresi Polinomial Derajat 2

set.seed(123)
cross_val <- vfold_cv(triceps,v=10,strata = "triceps")
metric_poly2 <- map_dfr(cross_val$splits,
function(x){
  mod <- lm(triceps ~ poly(age,2,raw = T),data=triceps[x$in_id,])
  pred <- predict(mod,newdata=triceps[-x$in_id,])
  truth <- triceps[-x$in_id,]$triceps
  rmse <- mlr3measures::rmse(truth = truth,response = pred)
  mae <- mlr3measures::mae(truth = truth,response = pred)
  metric <- c(rmse,mae)
  names(metric) <- c("rmse","mae")
  return(metric)
  }
)
metric_poly2

## # A tibble: 10 x 2
##     rmse   mae
##    <dbl> <dbl>
##  1  3.64  2.82
##  2  4.62  3.26
##  3  4.39  3.02
##  4  3.85  2.81
##  5  3.10  2.38
##  6  3.82  2.81
##  7  3.62  2.83
##  8  4.65  3.07
##  9  3.50  2.57
## 10  4.59  2.94

#Menghitung rata-rata untuk 10 folds
mean_metric_poly2 <- colMeans(metric_poly2)
mean_metric_poly2

##     rmse      mae 
## 3.977777 2.851787

Regresi Polinomial Derajat 3

set.seed(123)
cross_val <- vfold_cv(triceps,v=10,strata = "triceps")

metric_poly3 <- map_dfr(cross_val$splits,
function(x){
  mod <- lm(triceps ~ poly(age,3,raw = T),data=triceps[x$in_id,])
  pred <- predict(mod,newdata=triceps[-x$in_id,])
  truth <- triceps[-x$in_id,]$triceps
  rmse <- mlr3measures::rmse(truth = truth,response = pred)
  mae <- mlr3measures::mae(truth = truth,response = pred)
  metric <- c(rmse,mae)
  names(metric) <- c("rmse","mae")
  return(metric)
  }
)
metric_poly3

## # A tibble: 10 x 2
##     rmse   mae
##    <dbl> <dbl>
##  1  3.49  2.60
##  2  4.48  2.99
##  3  4.21  2.85
##  4  4.02  2.75
##  5  3.03  2.09
##  6  3.63  2.59
##  7  3.53  2.52
##  8  4.54  2.91
##  9  3.27  2.33
## 10  4.27  2.68

#Menghitung rata-rata untuk 10 folds
mean_metric_poly3 <- colMeans(metric_poly3)
mean_metric_poly3

##     rmse      mae 
## 3.845976 2.632125

Regresi Fungsi Tangga

set.seed(123)
cross_val <- vfold_cv(triceps,v=10,strata = "triceps")
breaks <- 3:10 #titik cut data
best_tangga <- map_dfr(breaks, function(i){
    metric_tangga <- map_dfr(cross_val$splits,
    function(x){
        training <- triceps[x$in_id,]
        training$age <- cut(training$age,i)
        mod <- lm(triceps ~ age,data=training)
        labs_x <- levels(mod$model[,2])
        labs_x_breaks <- cbind(lower = as.numeric( sub("\\((.+),.*", "\\1", labs_x) ),
                  upper = as.numeric( sub("[^,]*,([^]]*)\\]", "\\1", labs_x) ))
        testing <- triceps[-x$in_id,]
        age_new <- cut(testing$age,c(labs_x_breaks[1,1],labs_x_breaks[,2]))
        pred <- predict(mod,newdata=list(age=age_new))
        truth <- testing$triceps
        data_eval <- na.omit(data.frame(truth,pred))
        rmse <- mlr3measures::rmse(truth = data_eval$truth,response = data_eval$pred)
        mae <- mlr3measures::mae(truth = data_eval$truth,response = data_eval$pred)
        metric <- c(rmse,mae)
        names(metric) <- c("rmse","mae")
        return(metric)
      }
    )
  metric_tangga
  #Menghitung rata-rata untuk 10 folds
  mean_metric_tangga <- colMeans(metric_tangga)
  mean_metric_tangga
  }
)

best_tangga <- cbind(breaks=breaks,best_tangga)
#Menampilkan hasil all breaks
best_tangga

##   breaks     rmse      mae
## 1      3 3.835357 2.618775
## 2      4 3.882932 2.651911
## 3      5 3.917840 2.724368
## 4      6 3.836068 2.622939
## 5      7 3.789715 2.555062
## 6      8 3.812789 2.555563
## 7      9 3.781720 2.518706
## 8     10 3.795877 2.529479

#Berdasarkan rmse terkecil
best_tangga %>% slice_min(rmse)

##   breaks    rmse      mae
## 1      9 3.78172 2.518706

#Berdasarkan mae terkecil
best_tangga %>% slice_min(mae)

##   breaks    rmse      mae
## 1      9 3.78172 2.518706

Perbandingan Model

nilai_metric <- rbind(mean_metric_linear,
                      mean_metric_poly2,
                      mean_metric_poly3,
                      best_tangga %>% dplyr::select(-1) %>% slice_min(mae))

nama_model <- c("Linear","Poly2","Poly3","Tangga (breaks=9)")
data.frame(nama_model,nilai_metric)

##          nama_model     rmse      mae
## 1            Linear 3.973249 2.833886
## 2             Poly2 3.977777 2.851787
## 3             Poly3 3.845976 2.632125
## 4 Tangga (breaks=9) 3.781720 2.518706

Berdasarkan nilai rmse dan mae terkecil, model regresi fungsi tangga dengan breaks sebesar 9 merupakan model terbaik dibandingkan model lainnya.

knot_value_manual_3 = c(10, 20,40)
mod_spline_1 = lm(triceps ~ bs(age, knots =knot_value_manual_3 ),data=triceps)
summary(mod_spline_1)

## 
## Call:
## lm(formula = triceps ~ bs(age, knots = knot_value_manual_3), 
##     data = triceps)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -11.385  -1.682  -0.393   1.165  22.855 
## 
## Coefficients:
##                                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                            8.22533    0.61873  13.294  < 2e-16 ***
## bs(age, knots = knot_value_manual_3)1 -0.06551    1.14972  -0.057    0.955    
## bs(age, knots = knot_value_manual_3)2 -4.30051    0.72301  -5.948 3.90e-09 ***
## bs(age, knots = knot_value_manual_3)3  7.80435    1.17793   6.625 6.00e-11 ***
## bs(age, knots = knot_value_manual_3)4  6.14890    1.27439   4.825 1.65e-06 ***
## bs(age, knots = knot_value_manual_3)5  5.56640    1.42225   3.914 9.78e-05 ***
## bs(age, knots = knot_value_manual_3)6  7.90178    1.54514   5.114 3.87e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.76 on 885 degrees of freedom
## Multiple R-squared:  0.4195, Adjusted R-squared:  0.4155 
## F-statistic: 106.6 on 6 and 885 DF,  p-value: < 2.2e-16

Scatter Plot

ggplot(triceps,aes(x=age, y=triceps)) +
                 geom_point(alpha=0.55, color="black") +
  stat_smooth(method = "lm", 
               formula = y~bs(x, knots = knot_value_manual_3), 
               lty = 1,se = F)

knot_value_pc_df_6 = attr(bs(triceps$age, df=6),"knots")
mod_spline_1 = lm(triceps ~ bs(age, knots =knot_value_pc_df_6 ),data=triceps)
summary(mod_spline_1)

## 
## Call:
## lm(formula = triceps ~ bs(age, knots = knot_value_pc_df_6), data = triceps)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11.0056  -1.7556  -0.2944   1.2008  23.0695 
## 
## Coefficients:
##                                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                            6.5925     0.8770   7.517 1.37e-13 ***
## bs(age, knots = knot_value_pc_df_6)1   3.7961     1.5015   2.528  0.01164 *  
## bs(age, knots = knot_value_pc_df_6)2  -2.0749     0.8884  -2.335  0.01974 *  
## bs(age, knots = knot_value_pc_df_6)3   1.5139     1.1645   1.300  0.19391    
## bs(age, knots = knot_value_pc_df_6)4  11.6394     1.3144   8.855  < 2e-16 ***
## bs(age, knots = knot_value_pc_df_6)5   5.9680     1.5602   3.825  0.00014 ***
## bs(age, knots = knot_value_pc_df_6)6   8.9127     1.4053   6.342 3.60e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.757 on 885 degrees of freedom
## Multiple R-squared:  0.4206, Adjusted R-squared:  0.4167 
## F-statistic: 107.1 on 6 and 885 DF,  p-value: < 2.2e-16

Scatter Plot

ggplot(triceps,aes(x=age, y=triceps)) +
                 geom_point(alpha=0.55, color="black") +
  stat_smooth(method = "lm", 
               formula = y~bs(x, knots = knot_value_pc_df_6), 
               lty = 1,se = F)

knot_value_manual_3 = c(10, 20,40)
mod_spline3ns = lm(triceps ~ ns(age, knots = knot_value_manual_3),data=triceps)
summary(mod_spline3ns)

## 
## Call:
## lm(formula = triceps ~ ns(age, knots = knot_value_manual_3), 
##     data = triceps)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -10.7220  -1.7640  -0.3985   1.1908  22.9684 
## 
## Coefficients:
##                                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                             8.8748     0.3742  23.714  < 2e-16 ***
## ns(age, knots = knot_value_manual_3)1   7.0119     0.6728  10.422  < 2e-16 ***
## ns(age, knots = knot_value_manual_3)2   6.0762     0.8625   7.045 3.72e-12 ***
## ns(age, knots = knot_value_manual_3)3   2.0780     1.0632   1.954    0.051 .  
## ns(age, knots = knot_value_manual_3)4   8.8616     0.9930   8.924  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.762 on 887 degrees of freedom
## Multiple R-squared:  0.4176, Adjusted R-squared:  0.415 
## F-statistic:   159 on 4 and 887 DF,  p-value: < 2.2e-16

Scatter Plot

ggplot(triceps,aes(x=age, y=triceps)) +
                 geom_point(alpha=0.55, color="black")+
      stat_smooth(method = "lm", 
                 formula = y~ns(x, knots = knot_value_manual_3), 
                 lty = 1,se=F)

model_sms <- with(data = triceps,smooth.spline(age,triceps))
model_sms 

## Call:
## smooth.spline(x = age, y = triceps)
## 
## Smoothing Parameter  spar= 0.5162704  lambda= 1.232259e-06 (13 iterations)
## Equivalent Degrees of Freedom (Df): 50.00639
## Penalized Criterion (RSS): 8591.581
## GCV: 13.77835

Scatter Plot

pred_data <- broom::augment(model_sms)

ggplot(pred_data,aes(x=x,y=y))+
  geom_point(alpha=0.55, color="black")+
  geom_line(aes(y=.fitted),col="blue",
            lty=1)+
  xlab("age")+
  ylab("triceps")+
  theme_bw()

Pengaruh parameter lambda terhadap tingkat smoothness kurva bisa dilihat dari ilustrasi berikut:

model_sms_lambda <- data.frame(lambda=seq(0,5,by=0.5)) %>% 
  group_by(lambda) %>% 
  do(broom::augment(with(data = triceps,smooth.spline(age,triceps,lambda = .$lambda))))

p <- ggplot(model_sms_lambda,
       aes(x=x,y=y))+
  geom_line(aes(y=.fitted),
            col="blue",
            lty=1
            )+
  facet_wrap(~lambda)
p

Jika kita tentukan df=7, maka hasil kurva model smooth.spline akan lebih merepresentasikan data.

model_sms <- with(data = triceps,smooth.spline(age,triceps,df=7))
model_sms

## Call:
## smooth.spline(x = age, y = triceps, df = 7)
## 
## Smoothing Parameter  spar= 1.049874  lambda= 0.008827582 (11 iterations)
## Equivalent Degrees of Freedom (Df): 7.000747
## Penalized Criterion (RSS): 10112.16
## GCV: 14.20355

Scatter Plot

pred_data <- broom::augment(model_sms)

ggplot(pred_data,aes(x=x,y=y))+
  geom_point(alpha=0.55, color="black")+
  geom_line(aes(y=.fitted),col="blue",
            lty=1)+
  xlab("age")+
  ylab("triceps")+
  theme_bw()

model_loess <- loess(triceps~age,
                     data = triceps)
summary(model_loess)

## Call:
## loess(formula = triceps ~ age, data = triceps)
## 
## Number of Observations: 892 
## Equivalent Number of Parameters: 4.6 
## Residual Standard Error: 3.777 
## Trace of smoother matrix: 5.01  (exact)
## 
## Control settings:
##   span     :  0.75 
##   degree   :  2 
##   family   :  gaussian
##   surface  :  interpolate      cell = 0.2
##   normalize:  TRUE
##  parametric:  FALSE
## drop.square:  FALSE

model_loess_span <- data.frame(span=seq(0.1,5,by=0.5)) %>% 
  group_by(span) %>% 
  do(broom::augment(loess(triceps~age,
                     data = triceps,span=.$span)))

p2 <- ggplot(model_loess_span,
       aes(x=age,y=triceps))+
  geom_line(aes(y=.fitted),
            col="blue",
            lty=1
            )+
  facet_wrap(~span)
p2

ggplot(triceps, aes(age,triceps)) +
  geom_point(alpha=0.5,color="black") +
  stat_smooth(method='loess',
               formula=y~x,
              span = 0.75,
              col="blue",
              lty=1,
              se=F)

set.seed(123)
cross_val <- vfold_cv(triceps,v=10,strata = "triceps")

span <- seq(0.1,1,length.out=50)

best_loess <- map_dfr(span, function(i){
metric_loess <- map_dfr(cross_val$splits,
    function(x){
mod <- loess(triceps ~ age,span = i,
         data=triceps[x$in_id,])
pred <- predict(mod,
               newdata=triceps[-x$in_id,])
truth <- triceps[-x$in_id,]$triceps

data_eval <- na.omit(data.frame(pred=pred,
                                truth=truth))


rmse <- mlr3measures::rmse(truth = data_eval$truth,
                           response = data_eval$pred
                           )
mae <- mlr3measures::mae(truth = data_eval$truth,
                           response = data_eval$pred
                           )
metric <- c(rmse,mae)
names(metric) <- c("rmse","mae")
return(metric)
}
)

head(metric_loess,20)

#Menghitung rata-rata untuk 10 folds
mean_metric_loess <- colMeans(metric_loess)

mean_metric_loess
}
)

best_loess <- cbind(span=span,best_loess)
#Menampilkan hasil all breaks
best_loess

##         span     rmse      mae
## 1  0.1000000 3.773822 2.495752
## 2  0.1183673 3.771342 2.493506
## 3  0.1367347 3.766450 2.487557
## 4  0.1551020 3.757385 2.480571
## 5  0.1734694 3.749539 2.473494
## 6  0.1918367 3.746288 2.470915
## 7  0.2102041 3.742741 2.467990
## 8  0.2285714 3.740397 2.465388
## 9  0.2469388 3.737724 2.463311
## 10 0.2653061 3.737105 2.462252
## 11 0.2836735 3.735645 2.460514
## 12 0.3020408 3.734522 2.459225
## 13 0.3204082 3.733298 2.457694
## 14 0.3387755 3.732538 2.456280
## 15 0.3571429 3.732082 2.455452
## 16 0.3755102 3.731261 2.454642
## 17 0.3938776 3.730882 2.454293
## 18 0.4122449 3.730585 2.454291
## 19 0.4306122 3.730351 2.454869
## 20 0.4489796 3.730717 2.456222
## 21 0.4673469 3.730831 2.456768
## 22 0.4857143 3.731387 2.458307
## 23 0.5040816 3.732091 2.460189
## 24 0.5224490 3.732392 2.461811
## 25 0.5408163 3.733609 2.464543
## 26 0.5591837 3.734393 2.467180
## 27 0.5775510 3.735554 2.470517
## 28 0.5959184 3.736679 2.473012
## 29 0.6142857 3.738227 2.476519
## 30 0.6326531 3.741401 2.476887
## 31 0.6510204 3.742660 2.479842
## 32 0.6693878 3.744336 2.483581
## 33 0.6877551 3.746651 2.488792
## 34 0.7061224 3.748708 2.492180
## 35 0.7244898 3.750734 2.495218
## 36 0.7428571 3.752815 2.498359
## 37 0.7612245 3.753998 2.504175
## 38 0.7795918 3.755981 2.511421
## 39 0.7979592 3.756794 2.514375
## 40 0.8163265 3.759456 2.522994
## 41 0.8346939 3.767892 2.543250
## 42 0.8530612 3.777168 2.557863
## 43 0.8714286 3.782407 2.566972
## 44 0.8897959 3.788428 2.578042
## 45 0.9081633 3.797002 2.595698
## 46 0.9265306 3.803259 2.609852
## 47 0.9448980 3.809478 2.623386
## 48 0.9632653 3.824192 2.655691
## 49 0.9816327 3.835596 2.679155
## 50 1.0000000 3.860514 2.718911

#Berdasarkan nilai rmse terkecil
best_loess %>% slice_min(rmse)

##        span     rmse      mae
## 1 0.4306122 3.730351 2.454869

#Berdasarkan nilai mae terkecil
best_loess %>% slice_min(mae)

##        span     rmse      mae
## 1 0.4122449 3.730585 2.454291

Scatter Plot

ggplot(triceps, aes(age,triceps)) +
  geom_point(alpha=0.5,color="black") +
  stat_smooth(method='loess',
              formula=y~x,
              span = 0.4306122,
              col="blue",
              lty=1,
              se=F)

Regresi Linear V1

lin.mod.1 <- lm(origin ~ mpg, data=autodt)
plot(mpg, origin, pch=19)
lines(mpg, lin.mod.1$fitted.values, col="purple")

summary(lin.mod.1)

## 
## Call:
## lm(formula = origin ~ mpg, data = autodt)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.48384 -0.40469 -0.08386  0.34740  1.74114 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.208871   0.106520   1.961   0.0506 .  
## mpg         0.058333   0.004311  13.531   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6654 on 390 degrees of freedom
## Multiple R-squared:  0.3195, Adjusted R-squared:  0.3177 
## F-statistic: 183.1 on 1 and 390 DF,  p-value: < 2.2e-16

Regresi Linear V2

lin.mod.2 <- lm(horsepower ~ mpg, data=autodt)
plot(mpg, horsepower, pch=19)
lines(mpg, lin.mod.2$fitted.values, col="purple")

summary(lin.mod.2)

## 
## Call:
## lm(formula = horsepower ~ mpg, data = autodt)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -64.892 -15.716  -2.094  13.108  96.947 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 194.4756     3.8732   50.21   <2e-16 ***
## mpg          -3.8389     0.1568  -24.49   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 24.19 on 390 degrees of freedom
## Multiple R-squared:  0.6059, Adjusted R-squared:  0.6049 
## F-statistic: 599.7 on 1 and 390 DF,  p-value: < 2.2e-16

Regresi Polinomial

#Penentuan derajat polinomial terbaik dibatasi hingga derajat ke-17
df.list.pol <- data.frame("df" = c(rep(NA, 10)), "AIC1" = c(rep(NA, 10)), "MSE1" = c(rep(NA, 10)), "AIC2" = c(rep(NA, 10)), "MSE2" = c(rep(NA, 10)))
for(j in 2:3){
  for(i in 2:17){
    pol.mod <- lm(autodt[,j] ~ poly(mpg,i,raw = T), data=autodt)
    AIC.pol <- AIC(pol.mod)
    MSE.pol <- mean((predict(pol.mod)-autodt[,j])^2)
    if(j == 3){
      df.list.pol[i-1,1:3] <- c(i, AIC.pol, MSE.pol)}else{
        df.list.pol[i-1, 4:5] <- c(AIC.pol, MSE.pol)
      }
  }
}
knitr::kable(df.list.pol)

df	AIC1	MSE1	AIC2	MSE2
2	797.6568	0.4389163	3485.217	416.7871
3	796.2795	0.4351511	3454.949	383.8523
4	797.3754	0.4341486	3456.813	383.7195
5	799.2506	0.4340104	3455.310	380.3060
6	800.0427	0.4326751	3455.135	378.2017
7	801.2607	0.4318129	3455.139	376.2801
8	802.3611	0.4308230	3454.849	374.0890
9	804.3474	0.4308080	3455.295	372.6086
10	803.5020	0.4276922	3456.768	372.1082
11	805.3653	0.4275430	3455.520	369.0375
12	805.3653	0.4275430	3455.520	369.0375
13	800.9718	0.4206264	3455.558	367.1956
14	800.9718	0.4206264	3455.558	367.1956
15	798.6931	0.4160602	3457.551	367.1889
16	798.6931	0.4160602	3457.551	367.1889
17	799.4754	0.4147698	3458.900	366.5791

Berdasarkan hasil looping yang tersedia pada tabel di atas, diketahui bahwa derajat bebas polinomial yang terpilih untuk korelasi model origin ~ mpg adalah tiga dan untuk korelasi model horsepower ~ mpg adalah depalan berdasarkan nilai AIC terkecil.

Scatter Plot Model origin ~ mpg

ggplot(autodt, aes(x=mpg, y=origin)) + geom_point(color="black") + stat_smooth(method="lm", formula=y~poly(x,3, raw=T), col="purple", se=F)

Scatter Plot Model horsepower ~ mpg

ggplot(autodt, aes(x=mpg, y=horsepower)) + geom_point(color="black") + stat_smooth(method="lm", formula=y~poly(x,8, raw=T), col="purple", se=F)

Regresi Fungsi Tangga

#Penentuan derajat fungsi tangga terbaik dibatasi hingga derajat ke-17
df.list.step <- data.frame("df" = c(rep(NA, 10)), "AIC1" = c(rep(NA, 10)), "MSE1" = c(rep(NA, 10)), "AIC2" = c(rep(NA, 10)), "MSE2" = c(rep(NA, 10)))
for(j in 2:3){
  for(i in 3:17){
    step.mod <- lm(autodt[,j] ~ cut(mpg,i), data=autodt)
    AIC.step <- AIC(step.mod)
    MSE.step <- mean((predict(step.mod)-autodt[,j])^2)
    if(j == 3){
      df.list.step[i-2,1:3] <- c(i, AIC.step, MSE.step)}else{
        df.list.step[i-2, 4:5] <- c(AIC.step, MSE.step)
      }
  }
}
knitr::kable(df.list.step)

df	AIC1	MSE1	AIC2	MSE2
3	825.4751	0.4711959	3722.514	763.5092
4	816.3085	0.4579626	3605.549	563.6549
5	812.0036	0.4506557	3526.845	458.7770
6	812.9059	0.4493955	3554.364	489.6366
7	800.0531	0.4326866	3521.117	447.5318
8	809.4147	0.4408891	3551.701	481.3840
9	807.4994	0.4365074	3494.485	413.8924
10	805.2416	0.4317918	3478.747	395.5813
11	802.1242	0.4261916	3499.380	414.8383
12	792.2372	0.4134617	3496.674	409.8881
13	802.4971	0.4222663	3468.818	379.8288
14	800.3072	0.4177769	3463.291	372.6051
15	796.4998	0.4116333	3468.751	375.9084
16	803.3598	0.4167684	3490.100	394.9285
17	796.7535	0.4077180	3470.907	374.1436

Berdasarkan hasil looping yang tersedia pada tabel di atas, diketahui bahwa derajat bebas (breaks) fungsi tangga yang terpilih untuk korelasi model origin ~ mpg adalah dua belas dan untuk korelasi model horsepower ~ mpg adalah sepuluh berdasarkan nilai AIC terkecil.

Scatter Plot Model origin ~ mpg

ggplot(autodt, aes(x=mpg, y=origin)) + geom_point(color="black") + stat_smooth(method="lm", formula=y~cut(x,12), col="purple", se=F)

Scatter Plot Model horsepower ~ mpg

ggplot(autodt, aes(x=mpg, y=horsepower)) + geom_point(color="black") + stat_smooth(method="lm", formula=y~cut(x,10), col="purple", se=F)

Perbandingan Akurasi Model V1

pol.mod.1 <- lm(origin ~ poly(mpg,3,raw = T), data=autodt)
pol.mod.2 <- lm(horsepower ~ poly(mpg,8,raw = T), data=autodt)
step.mod.1 <- lm(origin ~ cut(mpg,12), data=autodt)
step.mod.2 <- lm(horsepower ~ cut(mpg,10), data=autodt)
model.auto1 <- data.frame("Model" = c("Linear (mpg~origin)", "Linear (mpg~horsepower)", "Polinomial(3) (mpg~origin)", "Polinomial(8) (mpg~horsepower)", "Fungsi Tangga(12) (mpg~origin)", "Fungsi Tangga(10) (mpg~horsepower)"), "AIC" = c(AIC(lin.mod.1), AIC(lin.mod.2), AIC(pol.mod.1), AIC(pol.mod.2), AIC(step.mod.1), AIC(step.mod.2)), "MSE" = c(MSE(predict(lin.mod.1),autodt$origin), MSE(predict(lin.mod.2),autodt$horsepower), MSE(predict(pol.mod.1),autodt$origin), MSE(predict(pol.mod.2),autodt$horsepower), MSE(predict(step.mod.1),autodt$origin), MSE(predict(step.mod.2),autodt$horsepower)))
kableExtra::kable(head(model.auto1) ,caption = 'Perbandingan Akurasi Model V1')

Perbandingan Akurasi Model V1

Model	AIC	MSE
Linear (mpg~origin)	797.0222	0.4404478
Linear (mpg~horsepower)	3614.3235	582.3256764
Polinomial(3) (mpg~origin)	796.2795	0.4351511
Polinomial(8) (mpg~horsepower)	3454.8494	374.0890447
Fungsi Tangga(12) (mpg~origin)	792.2372	0.4134617
Fungsi Tangga(10) (mpg~horsepower)	3478.7475	395.5813018

Berdasarkah perbandingan akurasi model, diketahui bahwa untuk korelasi model origin ~ mpg lebih baik menggunakan model regresi fungsi tangga dengan breaks 12. Sementara itu, untuk korelasi model horsepower ~ mpg lebih baik menggunakan model polinomial dengan derajat bebas 3. Kedua model terbaik ini masih bersifat sementara karena masih dapat dianalisis dengan metode pemulusan.

Regresi Spline

Penentuan banyaknya knots dengan menggunakan bantuan komputer.

knots.val.auto <- attr(bs(autodt$mpg, df=6), "knots")
knots.val.auto

##   25%   50%   75% 
## 17.00 22.75 29.00

Regresi B-Spline

Regresi B-Spline origin ~ mpg

spline.mod.auto1 <- lm(origin ~ bs(mpg, knots=knots.val.auto), data=autodt)
summary(spline.mod.auto1)

## 
## Call:
## lm(formula = origin ~ bs(mpg, knots = knots.val.auto), data = autodt)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.39803 -0.38041 -0.02476  0.33868  1.81900 
## 
## Coefficients:
##                                  Estimate Std. Error t value Pr(>|t|)  
## (Intercept)                       1.04633    0.44800   2.336   0.0200 *
## bs(mpg, knots = knots.val.auto)1 -0.09890    0.64164  -0.154   0.8776  
## bs(mpg, knots = knots.val.auto)2 -0.07956    0.42992  -0.185   0.8533  
## bs(mpg, knots = knots.val.auto)3  0.57546    0.49774   1.156   0.2483  
## bs(mpg, knots = knots.val.auto)4  1.14229    0.49623   2.302   0.0219 *
## bs(mpg, knots = knots.val.auto)5  1.53577    0.64019   2.399   0.0169 *
## bs(mpg, knots = knots.val.auto)6  1.30545    0.61946   2.107   0.0357 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6649 on 385 degrees of freedom
## Multiple R-squared:  0.3292, Adjusted R-squared:  0.3187 
## F-statistic: 31.49 on 6 and 385 DF,  p-value: < 2.2e-16

scatter Plot B-Spline origin ~ mpg

ggplot(autodt, aes(x=mpg, y=origin)) + geom_point(color="brown") + stat_smooth(method="lm", formula=y~bs(x, knots=knots.val.auto), lty=1, se=F)

Regresi B-Spline horsepower ~ mpg

spline.mod.auto2 <- lm(horsepower ~ bs(mpg, knots=knots.val.auto), data=autodt)
summary(spline.mod.auto2)

## 
## Call:
## lm(formula = horsepower ~ bs(mpg, knots = knots.val.auto), data = autodt)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -74.043 -10.103  -0.818   8.075  95.778 
## 
## Coefficients:
##                                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                       195.012     13.181  14.795  < 2e-16 ***
## bs(mpg, knots = knots.val.auto)1    2.792     18.879   0.148    0.882    
## bs(mpg, knots = knots.val.auto)2  -80.488     12.649  -6.363 5.62e-10 ***
## bs(mpg, knots = knots.val.auto)3 -103.774     14.645  -7.086 6.62e-12 ***
## bs(mpg, knots = knots.val.auto)4 -126.115     14.600  -8.638  < 2e-16 ***
## bs(mpg, knots = knots.val.auto)5 -127.143     18.836  -6.750 5.45e-11 ***
## bs(mpg, knots = knots.val.auto)6 -141.413     18.226  -7.759 7.77e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 19.56 on 385 degrees of freedom
## Multiple R-squared:  0.7457, Adjusted R-squared:  0.7417 
## F-statistic: 188.1 on 6 and 385 DF,  p-value: < 2.2e-16

Scatter Plot B-Spline horsepower ~ mpg

ggplot(autodt, aes(x=mpg, y=horsepower)) + geom_point(color="brown") + stat_smooth(method="lm", formula=y~bs(x, knots=knots.val.auto), lty=1, se=F)

Natural Spline origin ~ mpg

ns.spline.auto1 <- lm(origin ~ ns(mpg, knots=knots.val.auto), data=autodt)
summary(ns.spline.auto1)

## 
## Call:
## lm(formula = origin ~ ns(mpg, knots = knots.val.auto), data = autodt)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.36121 -0.36897 -0.03639  0.34308  1.82256 
## 
## Coefficients:
##                                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                        0.9776     0.2295   4.261 2.56e-05 ***
## ns(mpg, knots = knots.val.auto)1   0.6192     0.2188   2.830  0.00489 ** 
## ns(mpg, knots = knots.val.auto)2   1.2993     0.2091   6.215 1.33e-09 ***
## ns(mpg, knots = knots.val.auto)3   1.4244     0.5348   2.663  0.00806 ** 
## ns(mpg, knots = knots.val.auto)4   1.5339     0.2913   5.265 2.33e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6633 on 387 degrees of freedom
## Multiple R-squared:  0.3288, Adjusted R-squared:  0.3218 
## F-statistic: 47.39 on 4 and 387 DF,  p-value: < 2.2e-16

Scatter Plot Natural Spline origin ~ mpg

ggplot(autodt, aes(x=mpg, y=origin)) + geom_point(color="brown") + stat_smooth(method="lm", formula=y~ns(x, knots=knots.val.auto), lty=1,se=F)

Natural Spline horsepower ~ mpg

ns.spline.auto2 <- lm(horsepower ~ ns(mpg, knots=knots.val.auto), data=autodt)
summary(ns.spline.auto2)

## 
## Call:
## lm(formula = horsepower ~ ns(mpg, knots = knots.val.auto), data = autodt)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -72.461 -10.731  -1.433   8.759  95.650 
## 
## Coefficients:
##                                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                       218.000      6.786   32.13   <2e-16 ***
## ns(mpg, knots = knots.val.auto)1 -130.511      6.470  -20.17   <2e-16 ***
## ns(mpg, knots = knots.val.auto)2 -109.368      6.183  -17.69   <2e-16 ***
## ns(mpg, knots = knots.val.auto)3 -237.134     15.815  -14.99   <2e-16 ***
## ns(mpg, knots = knots.val.auto)4 -115.116      8.615  -13.36   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 19.62 on 387 degrees of freedom
## Multiple R-squared:  0.7429, Adjusted R-squared:  0.7403 
## F-statistic: 279.6 on 4 and 387 DF,  p-value: < 2.2e-16

Scatter PLot Natural Spline origin ~ mpg

ggplot(autodt, aes(x=mpg, y=horsepower)) + geom_point(color="brown") + stat_smooth(method="lm", formula=y~ns(x, knots=knots.val.auto), lty=1,se=F)

Smoothing Spline

Smoothing Spline origin ~ mpg

ss.auto1 <- with(data=autodt, smooth.spline(mpg, origin))
ss.auto1

## Call:
## smooth.spline(x = mpg, y = origin)
## 
## Smoothing Parameter  spar= 0.6891065  lambda= 0.0002244654 (11 iterations)
## Equivalent Degrees of Freedom (Df): 12.93154
## Penalized Criterion (RSS): 61.61513
## GCV: 0.4385944

Scatter Plot Smoothing Spline origin ~ mpg

pred.ss1 <- broom::augment(ss.auto1)
ggplot(pred.ss1, aes(x=x, y=y)) + geom_point(color="brown") + geom_line(aes(y=.fitted), col="orange", lty=1) + xlab("mpg") + ylab("origin")

Smoothing Spline horsepower ~ mpg

ss.auto2 <- with(data=autodt, smooth.spline(mpg, horsepower))
ss.auto2

## Call:
## smooth.spline(x = mpg, y = horsepower)
## 
## Smoothing Parameter  spar= 0.8528728  lambda= 0.003422279 (12 iterations)
## Equivalent Degrees of Freedom (Df): 6.989153
## Penalized Criterion (RSS): 35962.53
## GCV: 386.3516

Scatter Plot Smoothing Spline horsepower ~ mpg

pred.ss2 <- broom::augment(ss.auto2)
ggplot(pred.ss2, aes(x=x, y=y)) + geom_point(color="brown") + geom_line(aes(y=.fitted), col="orange", lty=1) + xlab("mpg") + ylab("horsepower")

LOESS Functin

LOESS Functin origin ~ mpg

loess.auto1 <- loess(origin~mpg, data=autodt)
summary(loess.auto1)

## Call:
## loess(formula = origin ~ mpg, data = autodt)
## 
## Number of Observations: 392 
## Equivalent Number of Parameters: 4.8 
## Residual Standard Error: 0.6627 
## Trace of smoother matrix: 5.24  (exact)
## 
## Control settings:
##   span     :  0.75 
##   degree   :  2 
##   family   :  gaussian
##   surface  :  interpolate      cell = 0.2
##   normalize:  TRUE
##  parametric:  FALSE
## drop.square:  FALSE

Scatter Plot with Standard Erorr LOESS Functin origin ~ mpg

ggplot(autodt, aes(x=mpg, y=origin)) + geom_point(color="red") + stat_smooth(method="loess", formula=y~x, col="purple", show.legend=T)

LOESS Functin horsepower ~ mpg

loess.auto2 <- loess(horsepower~mpg, data=autodt)
summary(loess.auto2)

## Call:
## loess(formula = horsepower ~ mpg, data = autodt)
## 
## Number of Observations: 392 
## Equivalent Number of Parameters: 4.8 
## Residual Standard Error: 19.58 
## Trace of smoother matrix: 5.24  (exact)
## 
## Control settings:
##   span     :  0.75 
##   degree   :  2 
##   family   :  gaussian
##   surface  :  interpolate      cell = 0.2
##   normalize:  TRUE
##  parametric:  FALSE
## drop.square:  FALSE

Scatter Plot with Standard Erorr LOESS Functin horsepower ~ mpg

ggplot(autodt, aes(x=mpg, y=horsepower)) + geom_point(color="red") + stat_smooth(method="loess", formula=y~x, col="purple", show.legend=T)

Eksploratif: Perbandingan Model V2 origin ~ mpg

ggplot(autodt, aes(x=mpg, y=origin)) + geom_point(color="black") + stat_smooth(method="lm", formula=y~poly(x,3,raw=T), col="blue", lwd=1.2, se=F) + stat_smooth(method="lm", formula=y~cut(x,12), col="purple", lwd=1.2, se=F) + stat_smooth(method="lm", formula=y~bs(x, knots=knots.val.auto), col="green", lwd=1.2, se=F) + stat_smooth(method="lm", formula=y~ns(x, knots=knots.val.auto), col="brown", lwd=1.2, se=F) + stat_smooth(method="loess", formula=y~x, col="orange", lwd=1.2, se=F) + stat_smooth(method="lm", formula=y~x, col="red", lwd=1.2, se=F)

Legend plot:
—–: Model regresi linear
—–: Model regresi polinomial
—–: Model regresi fungsi tangga
—–: Model regresi spline
—–: Model regresi natural spline
—–: Model regresi fungsi LOESS

Perbandingan Akurasi Model V2 origin ~ mpg

model.auto2a <- data.frame(Model = c("Linear", "Polinomial(3)", "Fungsi Tangga(12)", "Regresi Spline", "Natural Spline", "Fungsi LOESS"), MSE = c(MSE(predict(lin.mod.1), autodt$origin), MSE(predict(pol.mod.1), autodt$origin), MSE(predict(step.mod.1), autodt$origin), MSE(predict(spline.mod.auto1), autodt$origin), MSE(predict(ns.spline.auto1), autodt$origin), MSE(predict(loess.auto1), autodt$origin)))
kableExtra::kable(head(model.auto2a) ,caption = 'Perbandingan Akurasi Model V2 (origin ~ mpg)')

Perbandingan Akurasi Model V2 (origin ~ mpg)

Model	MSE
Linear	0.4404478
Polinomial(3)	0.4351511
Fungsi Tangga(12)	0.4134617
Regresi Spline	0.4341514
Natural Spline	0.4344177
Fungsi LOESS	0.4328007

Berdasarkah perbandingan akurasi model dengan nilai MSE terkecil, diketahui bahwa model regresi fungsi tangga dengan breaks sebesar 12 merupakan model terbaik untuk korelasi model origin ~ mpg.

Eksploratif: Perbandingan Model V2 horsepower ~ mpg

ggplot(autodt, aes(x=mpg, y=horsepower)) + geom_point(color="black") +  stat_smooth(method="lm", formula=y~bs(x, knots=knots.val.auto), col="green", lwd=4, se=F) + stat_smooth(method="loess", formula=y~x, col="orange", lwd=2.5, se=F) + stat_smooth(method="lm", formula=y~cut(x,10), col="purple", lwd=1.2, se=F) + stat_smooth(method="lm", formula=y~poly(x,8,raw=T), col="blue", lwd=1.2, se=F) + stat_smooth(method="lm", formula=y~ns(x, knots=knots.val.auto), col="brown", lwd=1.2, se=F) + stat_smooth(method="lm", formula=y~x, col="red", lwd=1.2, se=F)

Legend plot:
—–: Model regresi linear
—–: Model regresi polinomial
—–: Model regresi fungsi tangga
—–: Model regresi spline
—–: Model regresi natural spline
—–: Model regresi fungsi LOESS

Perbandingan Akurasi Model V2 horsepower ~ mpg

model.auto2b <- data.frame(Model = c("Linear", "Polinomial(8)", "Fungsi Tangga(10)", "Regresi Spline", "Regresi Natural Spline", "LOESS Function"), MSE = c(MSE(predict(lin.mod.2), autodt$horsepower), MSE(predict(pol.mod.2), autodt$horsepower), MSE(predict(step.mod.2), autodt$horsepower), MSE(predict(spline.mod.auto2), autodt$horsepower), MSE(predict(ns.spline.auto2), autodt$horsepower), MSE(predict(loess.auto2), autodt$horsepower)))
kableExtra::kable(head(model.auto2a) ,caption = 'Perbandingan Akurasi Model V2 (horsepower ~ mpg)')

Perbandingan Akurasi Model V2 (horsepower ~ mpg)

Model	MSE
Linear	0.4404478
Polinomial(3)	0.4351511
Fungsi Tangga(12)	0.4134617
Regresi Spline	0.4341514
Natural Spline	0.4344177
Fungsi LOESS	0.4328007

Berdasarkan nilai MSE terkecil pada perbandingan akurasi model di atas, model terbaik yang diperoleh adalah model regresi fungsi tangga dengan breaks 12.

Regresi Linear

lin.met1 <- map_dfr(cross.val1$splits, function(x){
    mod <- lm(origin ~ mpg,data=autodt[x$in_id,])
    pred <- predict(mod,newdata=autodt[-x$in_id,])
    truth <- autodt[-x$in_id,]$origin
    rmse <- mlr3measures::rmse(truth = truth,response = pred)
    mae <- mlr3measures::mae(truth = truth,response = pred)
    metric <- c(rmse,mae)
    names(metric) <- c("rmse","mae")
    return(metric)
  }
)
m_lin.met1 <- colMeans(lin.met1)
m_lin.met1

##      rmse       mae 
## 0.6631052 0.5147590

Regresi Polinomial Ordo 3

pol.met1 <- map_dfr(cross.val1$splits,
function(x){
  mod <- lm(origin ~ poly(mpg,3,raw = T),data=autodt[x$in_id,])
  pred <- predict(mod,newdata=autodt[-x$in_id,])
  truth <- autodt[-x$in_id,]$origin
  rmse <- mlr3measures::rmse(truth = truth,response = pred)
  mae <- mlr3measures::mae(truth = truth,response = pred)
  metric <- c(rmse,mae)
  names(metric) <- c("rmse","mae")
  return(metric)
  }
)
m_pol.met1 <- colMeans(pol.met1)
m_pol.met1

##      rmse       mae 
## 0.6623899 0.5033983

Regresi Fungsi Tangga

breaks <- 3:17
best.step1 <- map_dfr(breaks, function(i){
    step.met1 <- map_dfr(cross.val1$splits,
    function(x){
        training <-autodt[x$in_id,]
        training$mpg <- cut(training$mpg,i)
        mod <- lm(origin ~ mpg, data=training)
        labs_x <- levels(mod$model[,2])
        labs_x_breaks <- cbind(lower = as.numeric(sub("\\((.+),.*", "\\1", labs_x)), upper = as.numeric(sub("[^,]*,([^]]*)\\]", "\\1", labs_x)))
        testing <- autodt[-x$in_id,]
        newdt <- cut(testing$mpg, c(labs_x_breaks[1,1], labs_x_breaks[,2]))
        pred <- predict(mod, newdata=list(mpg=newdt))
        truth <- testing$origin
        data_eval <- na.omit(data.frame(truth,pred))
        rmse <- mlr3measures::rmse(truth = data_eval$truth, response = data_eval$pred)
        mae <- mlr3measures::mae(truth = data_eval$truth, response = data_eval$pred)
        metric <- c(rmse,mae)
        names(metric) <- c("rmse","mae")
        return(metric)
      }
    )
  step.met1
  #Menghitung rata-rata untuk 10 folds
  m_step.met1 <- colMeans(step.met1)
  m_step.met1
  }
)

best.step1 <- cbind(breaks=breaks, best.step1)

best.step1 %>% slice_min(rmse, n=5)

##   breaks      rmse       mae
## 1     12 0.6588186 0.4904860
## 2     17 0.6613277 0.4861881
## 3     14 0.6622931 0.4954355
## 4      7 0.6638867 0.5061256
## 5     15 0.6657763 0.4867893

best.step1 %>% slice_min(mae, n=1)

##   breaks      rmse       mae
## 1     17 0.6613277 0.4861881

Best step yang digunakan, yaitu breaks = 17 berdasarkan nilai mae terkecil.

Regresi Spline

spline.met1 <- map_dfr(cross.val1$splits,
function(x){
  mod <- lm(origin ~ bs(mpg,knots=knots.val.auto),data=autodt[x$in_id,])
  pred <- predict(mod,newdata=autodt[-x$in_id,])
  truth <- autodt[-x$in_id,]$origin
  rmse <- mlr3measures::rmse(truth = truth,response = pred)
  mae <- mlr3measures::mae(truth = truth,response = pred)
  metric <- c(rmse,mae)
  names(metric) <- c("rmse","mae")
  return(metric)
  }
)

## Warning in bs(mpg, degree = 3L, knots = c(`25%` = 17, `50%` = 22.75, `75%` = 29:
## some 'x' values beyond boundary knots may cause ill-conditioned bases

## Warning in bs(mpg, degree = 3L, knots = c(`25%` = 17, `50%` = 22.75, `75%` = 29:
## some 'x' values beyond boundary knots may cause ill-conditioned bases

m_spline.met1 <- colMeans(spline.met1)
m_spline.met1

##      rmse       mae 
## 0.6687020 0.4995128

Regresi Natural Spline

nspl.met1 <- map_dfr(cross.val1$splits,
function(x){
  mod <- lm(origin ~ ns(mpg,knots=knots.val.auto),data=autodt[x$in_id,])
  pred <- predict(mod,newdata=autodt[-x$in_id,])
  truth <- autodt[-x$in_id,]$origin
  rmse <- mlr3measures::rmse(truth = truth,response = pred)
  mae <- mlr3measures::mae(truth = truth,response = pred)
  metric <- c(rmse,mae)
  names(metric) <- c("rmse","mae")
  return(metric)
  }
)
m_nspl.met1 <- colMeans(nspl.met1)
m_nspl.met1

##      rmse       mae 
## 0.6641734 0.4962609

Regresi: LOESS

span <- seq(0.1, 1, length.out=91)
best.loess1 <- map_dfr(span, function(i){
  loess.met1 <- map_dfr(cross.val1$splits, function(x){
    mod <- loess(origin ~ mpg, span=i, data=autodt[x$in_id,])
    pred <- predict(mod, newdata=autodt[-x$in_id,])
    truth <- autodt[-x$in_id,]$origin
    data_eval <- na.omit(data.frame(pred=pred, truth=truth))
    rmse <- mlr3measures::rmse(truth=data_eval$truth, response=data_eval$pred)
    mae <- mlr3measures::mae(truth=data_eval$truth, response=data_eval$pred)
    metric <- c(rmse,mae)
    names(metric) <- c("rmse","mae")
    return(metric)
    }
)

  head(loess.met1,20)

  #Menghitung rata-rata untuk 10 folds
  m_loess.met1 <- colMeans(loess.met1)
  m_loess.met1
  }
)

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.6592e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.6453e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 2.7908e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 7.0291e-017

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 5.6179e-017

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.6592e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 2.2038e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.6592e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1236e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 5.4554e-017

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 5.6336e-017

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1277e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 5.5701e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0996e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 2.2038e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0996e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.6453e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 3.8633e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0996e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 5.5701e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 3.8633e-016

best.loess1 <- cbind(span=span,best.loess1)
#Menampilkan hasil all breaks
best.loess1 %>% slice_min(rmse, n=1)

##   span      rmse       mae
## 1 0.28 0.6609029 0.4945192

best.loess1 %>% slice_min(mae, n=1)

##   span      rmse       mae
## 1 0.11 0.6677179 0.4876461

Berdasarkan nilai rmse terkecil, best LOESS pada span 0.28, sedangkan best LOESS pada span 0.11 berdasarkan nilai mae terkecil.

Perbandingan Akurasi Model

df.cv1 <- rbind(m_lin.met1, m_pol.met1, best.step1[9,2:3], m_spline.met1, m_nspl.met1, best.loess1[35,-1])
rownames(df.cv1) <- c("Linear", "Polinomial(3)", "Fungsi Tangga(17)", "Spline", "Natural Spline", "Fungsi LOESS(0.11)")
kableExtra::kable(head(df.cv1) ,caption = 'Perbandingan Akurasi Model dengan *Cross Validation Evaluation* (origin ~ mpg)')

Perbandingan Akurasi Model dengan Cross Validation Evaluation (origin ~ mpg)

	rmse	mae
Linear	0.6631052	0.5147590
Polinomial(3)	0.6623899	0.5033983
Fungsi Tangga(17)	0.6725749	0.5016854
Spline	0.6687020	0.4995128
Natural Spline	0.6641734	0.4962609
Fungsi LOESS(0.11)	0.6622263	0.4951171

Berdasarkan nilai rmse dan mae terkecil, dengan menggunakan cross-validation evaluation 10 folds, model regresi fungsi LOESS dengan span sebesar 0.11 merupakan model terbaik untuk korelasi model origin ~ mpg dibandingkan model lainnya.

Regresi Linier

lin.met2 <- map_dfr(cross.val2$splits, function(x){
    mod <- lm(horsepower ~ mpg,data=autodt[x$in_id,])
    pred <- predict(mod,newdata=autodt[-x$in_id,])
    truth <- autodt[-x$in_id,]$horsepower
    rmse <- mlr3measures::rmse(truth = truth,response = pred)
    mae <- mlr3measures::mae(truth = truth,response = pred)
    metric <- c(rmse,mae)
    names(metric) <- c("rmse","mae")
    return(metric)
  }
)
m_lin.met2 <- colMeans(lin.met2)
m_lin.met2

##     rmse      mae 
## 24.07495 18.46422

Regresi Polinomial Ordo 8

pol.met2 <- map_dfr(cross.val2$splits,
function(x){
  mod <- lm(horsepower ~ poly(mpg,8,raw = T),data=autodt[x$in_id,])
  pred <- predict(mod,newdata=autodt[-x$in_id,])
  truth <- autodt[-x$in_id,]$horsepower
  rmse <- mlr3measures::rmse(truth = truth,response = pred)
  mae <- mlr3measures::mae(truth = truth,response = pred)
  metric <- c(rmse,mae)
  names(metric) <- c("rmse","mae")
  return(metric)
  }
)
m_pol.met2 <- colMeans(pol.met2)
m_pol.met2

##     rmse      mae 
## 20.50232 14.37619

Regresi Fungsi Tangga

breaks <- 3:12
best.step2 <- map_dfr(breaks, function(i){
    step.met2 <- map_dfr(cross.val2$splits,
    function(x){
        training <- autodt[x$in_id,]
        training$mpg <- cut(training$mpg,i)
        mod <- lm(horsepower ~ mpg, data=training)
        labs_x <- levels(mod$model[,2])
        labs_x_breaks <- cbind(lower = as.numeric(sub("\\((.+),.*", "\\1", labs_x)), upper = as.numeric(sub("[^,]*,([^]]*)\\]", "\\1", labs_x)))
        testing <- autodt[-x$in_id,]
        newdt <- cut(testing$mpg, c(labs_x_breaks[1,1], labs_x_breaks[,2]))
        pred <- predict(mod, newdata=list(mpg=newdt))
        truth <- testing$horsepower
        data_eval <- na.omit(data.frame(truth,pred))
        rmse <- mlr3measures::rmse(truth = data_eval$truth, response = data_eval$pred)
        mae <- mlr3measures::mae(truth = data_eval$truth, response = data_eval$pred)
        metric <- c(rmse,mae)
        names(metric) <- c("rmse","mae")
        return(metric)
      }
    )
  step.met2
  # menghitung rata-rata untuk 10 folds
  m_step.met2 <- colMeans(step.met2)
  m_step.met2
  }
)

best.step2 <- cbind(breaks=breaks, best.step2)
# menampilkan hasil all breaks
best.step2 %>% slice_min(rmse, n=5)

##   breaks     rmse      mae
## 1     10 19.94188 14.00930
## 2     12 20.20257 14.48694
## 3     11 20.23586 14.67526
## 4      9 20.78474 14.44107
## 5      5 21.23067 15.23984

best.step2 %>% slice_min(mae, n=5)

##   breaks     rmse      mae
## 1     10 19.94188 14.00930
## 2      9 20.78474 14.44107
## 3     12 20.20257 14.48694
## 4     11 20.23586 14.67526
## 5      5 21.23067 15.23984

Regresi Spline

spline.met2 <- map_dfr(cross.val2$splits,
function(x){
  mod <- lm(horsepower ~ bs(mpg, knots=knots.val.auto),data=autodt[x$in_id,])
  pred <- predict(mod, newdata=autodt[-x$in_id,])
  truth <- autodt[-x$in_id,]$horsepower
  rmse <- mlr3measures::rmse(truth = truth,response=pred)
  mae <- mlr3measures::mae(truth = truth,response = pred)
  metric <- c(rmse,mae)
  names(metric) <- c("rmse","mae")
  return(metric)
  }
)

## Warning in bs(mpg, degree = 3L, knots = c(`25%` = 17, `50%` = 22.75, `75%` = 29:
## some 'x' values beyond boundary knots may cause ill-conditioned bases

## Warning in bs(mpg, degree = 3L, knots = c(`25%` = 17, `50%` = 22.75, `75%` = 29:
## some 'x' values beyond boundary knots may cause ill-conditioned bases

m_spline.met2 <- colMeans(spline.met2)
m_spline.met2

##     rmse      mae 
## 19.53639 14.09720

Regresi Natural Spline

nspl.met2 <- map_dfr(cross.val2$splits,
function(x){
  mod <- lm(horsepower ~ ns(mpg,knots=knots.val.auto),data=autodt[x$in_id,])
  pred <- predict(mod,newdata=autodt[-x$in_id,])
  truth <- autodt[-x$in_id,]$horsepower
  rmse <- mlr3measures::rmse(truth = truth,response = pred)
  mae <- mlr3measures::mae(truth = truth,response = pred)
  metric <- c(rmse,mae)
  names(metric) <- c("rmse","mae")
  return(metric)
  }
)
m_nspl.met2 <- colMeans(nspl.met2)
m_nspl.met2

##     rmse      mae 
## 19.53694 14.16507

Regresi: LOESS

span <- seq(0.1, 1, length.out=91)
best.loess2 <- map_dfr(span, function(i){
  loess.met2 <- map_dfr(cross.val1$splits, function(x){
    mod <- loess(horsepower ~ mpg, span=i, data=autodt[x$in_id,])
    pred <- predict(mod, newdata=autodt[-x$in_id,])
    truth <- autodt[-x$in_id,]$horsepower
    data_eval <- na.omit(data.frame(pred=pred, truth=truth))
    rmse <- mlr3measures::rmse(truth=data_eval$truth, response=data_eval$pred)
    mae <- mlr3measures::mae(truth=data_eval$truth, response=data_eval$pred)
    metric <- c(rmse,mae)
    names(metric) <- c("rmse","mae")
    return(metric)
    }
  )
  head(loess.met2,20)
  #Menghitung rata-rata untuk 10 folds
  m_loess.met2 <- colMeans(loess.met2)
  m_loess.met2
  }
)

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.6592e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.6453e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 2.7908e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 7.0291e-017

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 5.6179e-017

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.6592e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 2.2038e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.6592e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1236e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 5.4554e-017

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 5.6336e-017

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1277e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 5.5701e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0996e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 2.2038e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0996e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0975e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.6453e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 3.8633e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.0996e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 5.5701e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.099e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 1.1005e-016

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 14

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 1

## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 3.8633e-016

best.loess2 <- cbind(span=span,best.loess2)

best.loess2 %>% slice_min(rmse, n=1)

##   span     rmse      mae
## 1 0.33 19.26358 13.82094

best.loess2 %>% slice_min(mae, n=1)

##   span     rmse    mae
## 1 0.32 19.27623 13.813

Berdasarkan nilai rmse terkecil, best LOESS pada span 0.33, sedangkan best LOESS pada span 0.32 berdasarkan nilai mae terkecil.

Perbandingan Akurasi Model

df.cv2 <- rbind(m_lin.met2, m_pol.met2, best.step2[8,2:3], m_spline.met2, m_nspl.met2, best.loess2[47,-1])
rownames(df.cv2) <- c("Linear", "Polinomial(8)", "Fungsi Tangga(10)", "Spline", "Natural Spline", "Fungsi LOESS(0.32)")
kableExtra::kable(head(df.cv2) ,caption = 'Perbandingan Akurasi Model dengan *Cross Validation Evaluation* (horsepower ~ mpg)')

Perbandingan Akurasi Model dengan Cross Validation Evaluation (horsepower ~ mpg)

	rmse	mae
Linear	24.07495	18.46422
Polinomial(8)	20.50232	14.37619
Fungsi Tangga(10)	19.94188	14.00930
Spline	19.53639	14.09720
Natural Spline	19.53694	14.16507
Fungsi LOESS(0.32)	19.26656	13.86220

Berdasarkan nilai rmse dan mae terkecil, dengan menggunakan cross-validation evaluation 10 folds, model regresi fungsi LOESS dengan span sebesar 0.32 merupakan model terbaik untuk korelasi model horsepower ~ mpg dibandingkan model lainnya.