Berikut adalah analisis mengenai data Buah-buahan dari proses pengolahan,packing sampai dengan harga yang disediakan oleh kaggle.
Menggunakan linear regression analysis, akan dibuat suatu model untuk memprediksi faktor-faktor yang menjadikan hasil dari setiap proses menjadi suatu aspek yang penting terhadap hasil dan harga jual.
Secara khusus, kami ingin memahami faktor-faktor yang mempengaruhi harga jual dalam setiap cup sampai dengan harga ecerannya:
fruit_prices <- read.csv("data_input/fruit_prices.csv", stringsAsFactors = TRUE)glimpse(fruit_prices)## Rows: 62
## Columns: 8
## $ Fruit <fct> "Apples", "Apples, applesauce", "Apples, ready-to-d…
## $ Form <fct> Fresh, Canned, Juice, Juice, Fresh, Canned, Canned,…
## $ RetailPrice <dbl> 1.5193, 1.0660, 0.7804, 0.5853, 2.9665, 1.6905, 2.0…
## $ RetailPriceUnit <fct> per pound, per pound, per pint, per pint, per pound…
## $ Yield <dbl> 0.90, 1.00, 1.00, 1.00, 0.93, 1.00, 0.65, 1.00, 0.6…
## $ CupEquivalentSize <dbl> 0.2425, 0.5401, 8.0000, 8.0000, 0.3638, 0.5401, 0.4…
## $ CupEquivalentUnit <fct> pounds, pounds, fluid ounces, fluid ounces, pounds,…
## $ CupEquivalentPrice <dbl> 0.4094, 0.5758, 0.3902, 0.2926, 1.1603, 0.9131, 1.3…
Berikut adalah keterangan dari setiap kolom:
Fruit: nama buah-buahan
Form: bentuk olahan dari buah-buahan
RetailPrice: harga eceran
RetailPriceUnit: Satuan Harga Eceran
Yield: hasil
CupEquivalentSize: ukuran dalam satuan cup
CupEquivalentUnit: satuan dalam satuan cup
CupEquivalentPrice: harga dalam satuan cup
head(fruit_prices)# subsetting data
h <- fruit_prices[,-c(1:2)]
# menguji keberadaan missing value
anyNA(h)## [1] FALSE
table(is.na(h))##
## FALSE
## 372
# melihat korelasi antar variabel
library(GGally)## Warning: package 'GGally' was built under R version 4.3.1
## Loading required package: ggplot2
## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
ggcorr(h, label = TRUE, label_size = 2.9, hjust = 1, layout.exp = 2)## Warning in ggcorr(h, label = TRUE, label_size = 2.9, hjust = 1, layout.exp =
## 2): data in column(s) 'RetailPriceUnit', 'CupEquivalentUnit' are not numeric
## and were ignored
Pada grafik korelasi, terlihat bahwa ada variabel yang memiliki pengaruh negatif terhadap CupEquivalentPrice dimana faktor yang memiliki pangaruh negatif adalah CupEquivalentSize dan RetailPrice memiliki korelasi positif yang paling tinggi dibandingkan faktor-faktor lain.
Berikut adalah distribusi nilai dari masing-masing variabel.
boxplot(h)Berdasarkan visualisasi boxplot, ditemukan adanya outlier pada beberapa kolom.
Selanjutnya dapat dibuat model regresi linear dengan variabel prediktor RetailPrice karena variabel tersebut memiliki korelasi positif tertinggi terhadap variabel CupEquivalentPrice.
m <- lm(RetailPrice ~ CupEquivalentPrice, h)
m##
## Call:
## lm(formula = RetailPrice ~ CupEquivalentPrice, data = h)
##
## Coefficients:
## (Intercept) CupEquivalentPrice
## 0.4056 2.4033
summary(m)##
## Call:
## lm(formula = RetailPrice ~ CupEquivalentPrice, data = h)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.2581 -0.9038 -0.5549 0.2899 6.9701
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.4056 0.4636 0.875 0.385
## CupEquivalentPrice 2.4033 0.4453 5.397 1.21e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.711 on 60 degrees of freedom
## Multiple R-squared: 0.3268, Adjusted R-squared: 0.3156
## F-statistic: 29.13 on 1 and 60 DF, p-value: 1.214e-06
plot(h$RetailPrice, h$CupEquivalentPrice)
abline(m$coefficients[1],m$coefficients[2])Dapat dilihat bahwa adjusted R-squared memiliki nilai 0.3156
Selanjutnya akan dicoba pemilihan variabel prediktor secara automatis menggunakan step-wise regression dengan metode backward elimination.
m1 <- lm(CupEquivalentPrice ~ ., h)
step(m1, direction = "backward")## Start: AIC=-156.02
## CupEquivalentPrice ~ RetailPrice + RetailPriceUnit + Yield +
## CupEquivalentSize + CupEquivalentUnit
##
##
## Step: AIC=-156.02
## CupEquivalentPrice ~ RetailPrice + RetailPriceUnit + Yield +
## CupEquivalentSize
##
## Df Sum of Sq RSS AIC
## <none> 4.2606 -156.019
## - Yield 1 1.0798 5.3404 -144.014
## - CupEquivalentSize 1 4.6976 8.9582 -111.943
## - RetailPriceUnit 1 4.7116 8.9722 -111.846
## - RetailPrice 1 8.4528 12.7133 -90.238
##
## Call:
## lm(formula = CupEquivalentPrice ~ RetailPrice + RetailPriceUnit +
## Yield + CupEquivalentSize, data = h)
##
## Coefficients:
## (Intercept) RetailPrice RetailPriceUnitper pound
## -27.7451 0.2974 27.4315
## Yield CupEquivalentSize
## -0.9634 3.6166
summary(lm(formula = CupEquivalentPrice ~ RetailPrice + RetailPriceUnit + Yield +
CupEquivalentSize + CupEquivalentUnit, data = h))##
## Call:
## lm(formula = CupEquivalentPrice ~ RetailPrice + RetailPriceUnit +
## Yield + CupEquivalentSize + CupEquivalentUnit, data = h)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.99262 -0.13763 -0.02066 0.17282 1.06932
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -27.74509 3.64608 -7.610 3.07e-10 ***
## RetailPrice 0.29740 0.02797 10.634 3.76e-15 ***
## RetailPriceUnitper pound 27.43145 3.45511 7.939 8.67e-11 ***
## Yield -0.96342 0.25348 -3.801 0.000353 ***
## CupEquivalentSize 3.61664 0.45621 7.928 9.06e-11 ***
## CupEquivalentUnitpounds NA NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2734 on 57 degrees of freedom
## Multiple R-squared: 0.7114, Adjusted R-squared: 0.6912
## F-statistic: 35.13 on 4 and 57 DF, p-value: 8.827e-15
# membuat formula model regresi yang baru menjadi objek
m1 <- lm(formula = CupEquivalentPrice ~ RetailPrice + Yield + CupEquivalentSize, data = h)
m1##
## Call:
## lm(formula = CupEquivalentPrice ~ RetailPrice + Yield + CupEquivalentSize,
## data = h)
##
## Coefficients:
## (Intercept) RetailPrice Yield CupEquivalentSize
## 1.163506 0.156975 -0.740292 -0.003419
Metode step-wise regression ini akan menghasilkan formula optimum berdasarkan nilai AIC yang terendah, dimana semakin rendah nilai AIC tersebut, maka nilai observasi yang tidak tertangkap semakin kecil.
Bila dibandingkan dengan model awal yang hanya menggunakan variabel CupEquivalentPrice, model regresi yang menggunakan variabel prediktor CupEquivalentPrice, RetailPrice, RetailPriceUnit, Yield, CupEquivalentSize, CupEquivalentUnit memiliki adjusted R-squared 0.6912. lebih tinggi dibandingkan model sebelumnya yaitu 0.3156.
Kandidat Model:
CupEquivalentPrice = 0.156975(RetailPrice) + -0.740292(Yield) + -0.003419(CupEquivalentSize) + 1.163506
Akan dicoba prediksi nilai RetailPriceUnit berdasarkan nilai variabel prediktor, dan hasilnya akan dibandingkan dengan data aktual yang kita miliki.
# prediksi nilai CupEquivalentSize berdasarkan model `m`
predict(m, data.frame(CupEquivalentPrice = 0), interval = "confidence", level = 0.95)## fit lwr upr
## 1 0.405625 -0.5217418 1.332992
# prediksi nilai CupEquivalentSize berdasarkan model `m1`
predict(m1, data.frame(RetailPrice = 2,Yield = 5, CupEquivalentSize = 0), interval = "confidence", level = 0.95)## fit lwr upr
## 1 -2.224002 -5.277601 0.829597
# menghitung error m
sqrt((27-0.405625)^2)## [1] 26.59437
# menghitung error m1
sqrt((27--2.224002)^2)## [1] 29.224
Analisis penghitungan RSE menghasilkan model m memiliki nilai RSE yang lebih kecil sehingga lebih baik dibandingkan model m1.
Normalitas
hist(m$residuals, breaks = 20)hist(m1$residuals, breaks = 20)shapiro.test(m$residuals)##
## Shapiro-Wilk normality test
##
## data: m$residuals
## W = 0.80742, p-value = 1.463e-07
shapiro.test(m1$residuals)##
## Shapiro-Wilk normality test
##
## data: m1$residuals
## W = 0.91867, p-value = 0.0005441
Untuk kedua model, P-value tidak sama sehingga H0 ditolak. Hal ini juga berarti residual menyebar tidak normal dan model kita memiliki error disekitar mean-nya.
library(lmtest)## Warning: package 'lmtest' was built under R version 4.3.1
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 4.3.1
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
plot(h$Yield, m$residuals)
abline(h = 0, col = "red")bptest(m)##
## studentized Breusch-Pagan test
##
## data: m
## BP = 3.3768, df = 1, p-value = 0.06612
plot(h$Yield, m1$residuals)
abline(h = 0, col = "red")bptest(m1)##
## studentized Breusch-Pagan test
##
## data: m1
## BP = 14.149, df = 3, p-value = 0.00271
Untuk kedua model, P-value tidak sama sehingga H0 ditolak. Hal ini juga berarti residual tidak menyebar dengan normal.
library(car)## Warning: package 'car' was built under R version 4.3.1
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.3.1
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
# untuk model m yang hanya menggunakan satu variabel prediktor, tidak dapat digunakan `vif()` untuk analisis Multicollinearity
vif(m1)## RetailPrice Yield CupEquivalentSize
## 1.638093 1.585709 1.586097
Tidak ada nilai yang sama dengan atau lebih dari 10 sehingga tidak ditemukan Multicollinearity antar variabel (antar variabel prediktor saling independen).
Berdasarkan hasil analisis, kedua model memiliki kriteria yang baik sebagai model linear regression. Kemudian, bila dibandingkan RSE antara kedua model, model m memberikan nilai RSE yang lebih rendah. Oleh karena itu model m dipilih sebagai model yang lebih baik.
Model m yang didapatkan memiliki R-square 0.3156 dan memiliki RSE sebesar 26.59437. Selain itu setelah dilakukan uji analisis, model memiliki kriteria yang sudah baik.
Berdasarkan model ini,nilai RetailPrice berkorelasi positif dengan nilai CupEquivalentPrice. Dalam kata lain, untuk RetailPrice sangat mempengaruhi terhadap peningkatan CupEquivalentPrice yang didapatkan.