Bab 6 Menyesuaikan fungsi ke data ketika memiliki ide tentang bentuk fungsi untuk sebuah model dan kita perlu memilih parameter yang akan membuat fungsi model cocok untuk observasi. nah proses pemilihan parameter inilah disebut dengan model fitting. Sebagai ilustrasi, data dalam file “utilities.csv” mencatat suhu rata-rata setiap bulan (dalam derajat F) serta penggunaan gas alam bulanan (dalam kaki kubik, ccf). Ada, seperti yang Anda duga, hubungan yang kuat antara keduanya.
library(mosaicCalc)
## Loading required package: mosaic
## Registered S3 method overwritten by 'mosaic':
## method from
## fortify.SpatialPolygonsDataFrame ggplot2
##
## The 'mosaic' package masks several functions from core packages in order to add
## additional features. The original behavior of these functions should not be affected by this.
##
## Attaching package: 'mosaic'
## The following objects are masked from 'package:dplyr':
##
## count, do, tally
## The following object is masked from 'package:Matrix':
##
## mean
## The following object is masked from 'package:ggplot2':
##
## stat
## The following objects are masked from 'package:stats':
##
## binom.test, cor, cor.test, cov, fivenum, IQR, median, prop.test,
## quantile, sd, t.test, var
## The following objects are masked from 'package:base':
##
## max, mean, min, prod, range, sample, sum
## Loading required package: mosaicCore
##
## Attaching package: 'mosaicCore'
## The following objects are masked from 'package:dplyr':
##
## count, tally
##
## Attaching package: 'mosaicCalc'
## The following object is masked from 'package:stats':
##
## D
Utils <- read.csv("http://www.mosaic-web.org/go/datasets/utilities.csv")
gf_point(ccf ~ temp, data = Utils) %>%
gf_labs(y = "Natural gas usage (ccf/month)",
x = "Average outdoor temperature (F)")
Dengan data utilitas, masukannya adalah suhu, suhu. Keluaran yang akan dimodelkan adalah ccf. Untuk menyesuaikan fungsi model dengan data, tuliskan rumus dengan nama input, parameter, dan output yang sesuai di tempat yang tepat:
f <- fitModel(ccf ~ A * temp + B, data = Utils)
data yang digunakan untuk pemasangan adalah variabel (di sini temp); hal-hal lain (di sini, A dan B) adalah parameter.
gf_point(ccf ~ temp, data = Utils) %>%
slice_plot(f(temp) ~ temp)
kita bisa menambahkan fungsi lain
f2 <- fitModel(
ccf ~ A * temp + B + C *sqrt(temp),
data = Utils)
gf_point(
ccf ~ temp, data = Utils) %>%
slice_plot(f2(temp) ~ temp)
contoh menggunakan banyak variabel. misal, data “used-honda.csv” harga mobil Honda bekas:
Hondas <- read.csv("http://www.mosaic-web.org/go/datasets/used-hondas.csv")
head(Hondas)
## Price Year Mileage Location Color Age
## 1 20746 2006 18394 St.Paul Grey 1
## 2 19787 2007 8 St.Paul Black 0
## 3 17987 2005 39998 St.Paul Grey 2
## 4 17588 2004 35882 St.Paul Black 3
## 5 16987 2004 25306 St.Paul Grey 3
## 6 16987 2005 33399 St.Paul Black 2
terlihat data di atas terdapat price, age, dan mileage. model menggunakan dua variabel:
carPrice1 <- fitModel(
Price ~ A + B * Age + C * Mileage, data = Hondas
)
atau
contour_plot(
carPrice1(Age = age, Mileage = miles) ~ age + miles,
domain(age=2:8, miles=range(0, 60000)))
di kontur seharga $17.000 Setiap kombinasi usia dan mil yang jatuh pada
kontur ini menghasilkan harga mobil yang sama: $17.000. Kemiringan
kontur memberitahukan bahwa pertukaran antara jarak tempuh dan usia.
Lihatlah dua titik pada kontur yang berbeda 10.000 mil. Perbedaan usia
yang sesuai adalah sekitar 1,5 tahun. Jadi, saat membandingkan dua mobil
dengan harga yang sama, penurunan jarak tempuh sebesar 10.000 diimbangi
dengan peningkatan usia 1,5 mil.
ini interaksi antara usia dan jarak tempuh, dengan menyadari bahwa pengaruh usia mungkin berbeda bergantung pada jarak tempuh.
carPrice2 <- fitModel(
Price ~ A + B * Age + C * Mileage + D * Age * Mileage,
data = Hondas)
bisa diplot dengan cara seperti ini:
contour_plot(
carPrice2(Age=age, Mileage=miles) ~ age + miles,
domain(age = range(0, 8), miles = range(0, 60000)))
Bentuk konturnya sedikit berbeda dengan di carPrice1(); mereka sedikit
menonjol ke atas. menafsirkan kontur seperti itu membutuhkan sedikit
latihan. Lihatlah wilayah kecil di salah satu kontur. Kemiringan kontur
memberi tahu Anda trade-offantara jarak tempuh dan usia. Untuk
melihatnya, lihat kontur $17.000 yang melewati usia = 6 tahun dan jarak
tempuh = 10.000 mil. Sekarang lihat kontur $ 17.000 dengan jarak tempuh
nol. Dalam bergerak sepanjang kontur, harga tetap konstan. (Begitulah
kontur didefinisikan: titik di mana harganya sama, dalam hal ini
$17.000.) Menurunkan jarak tempuh sejauh 10.000 mil diseimbangkan dengan
menambah usia kurang dari satu tahun. (Kontur $17.000 memiliki titik nol
jarak tempuh dan 6,8 tahun.) Cara lain untuk mengatakan ini adalah bahwa
efek peningkatan usia 0,8 tahun sama dengan penurunan jarak tempuh
10.000 mil.
Sekarang lihat kontur $17.000 yang sama pada usia nol (yaitu, di ujung kiri grafik). Penurunan jarak tempuh sebesar 10.000 peningkatansesuai dengan usia 1,6 tahun. Dengan kata lain, menurut model, untuk mobil yang lebih baru kepentingan relatif antara jarak tempuh vs. usia lebih rendah daripada mobil yang lebih tua. Untuk mobil berusia nol, 10.000 mil bernilai 1,6 tahun, tetapi untuk mobil berusia enam tahun, 10.000 mil hanya bernilai 0,8 tahun.
Interaksi yang ditambahkan priceFun2()inilah yang menghasilkan pengaruh yang berbeda terhadap harga jarak tempuh untuk mobil yang berbeda umur.
Operator fitModel()membuatnya sangat mudah untuk menemukan parameter dalam model apa pun yang membuat model mendekati data paling dekat. Pekerjaan dalam pemodelan adalah memilih bentuk model yang tepat (Istilah interaksi atau tidak? Apakah akan memasukkan variabel baru atau tidak?) dan menginterpretasikan hasilnya. Di bagian selanjutnya, kita akan melihat beberapa pilihan berbeda dalam bentuk model (linier vs. nonlinier) dan beberapa logika matematis di balik pemasangan.
6.0.1 Latihan 6.0.1.1 Latihan 1 Bagian ini menjelaskan model carPrice1() dengan umur dan jarak tempuh sebagai jumlah masukan dan harga (dalam USD) sebagai keluaran. Klaim dibuat bahwa harga dapat dilihat sebagai fungsi dari Age dan Mileage
contour_plot(
carPrice1(Age = age, Mileage = miles) ~ age + miles,
domain(age = range(0, 8), miles = range(0, 60000)))
Pada grafik di atas, konturnya vertikal.
Kedua grafik menunjukkan fungsi yang sama, jadi keduanya “benar”. Tapi grafik latihan itu menyesatkan secara visual. Tidak mengherankan jika harga tidak banyak berubah dari 0 mil menjadi 1 mil, tetapi harganya (agak) berubah dari 0 tahun menjadi 1 tahun.
pesan di sini: Perhatikan baik-baik sumbu dan rentang yang ditampilkannya. Saat Anda menggambar grafik, pastikan Anda mengatur rentang ke sesuatu yang relevan dengan masalah yang dihadapi.
6.0.1.2 latihan 2 Pertimbangkan model \(\log_10 \mbox{price}\) sebagai fungsi dari mil dan usia.
logPrice2 <- fitModel(
logPrice ~ A + B * Age + C * Mileage + D * Age * Mileage,
data = Hondas %>% mutate(logPrice = log10(Price)))
Model ini didefinisikan untuk memasukkan interaksi antara usia dan jarak tempuh.
Sesuaikan model dan lihat kontur harga kayu gelondongan. Apa yang dikatakan bentuk kontur kepada Anda tentang apakah data memberikan bukti interaksi dalam harga log?
contour_plot(
logPrice2(Age=age, Mileage=miles) ~ age + miles,
domain(age = range(0, 8), miles = range(0, 60000)))
Konturnya cukup lurus, yang menunjukkan bahwa ada sedikit interaksi.
Ketika menginterpretasikan harga log, kita dapat berpikir tentang
kenaikan, katakanlah, 0,05 dalam output yang sesuai dengan kenaikan
harga proporsional yang sama. Misalnya, peningkatan harga log dari 4,2
(yaitu \(10^{4,2}\) = 15.849) menjadi
4,25 (yaitu \(10^{4,25}\) = 17.783)
merupakan peningkatan sebesar 12% pada harga aktual harga. Kenaikan
lebih lanjut dalam harga log menjadi 4,3 (yaitu, dalam harga sebenarnya,
\(10^{4,3}\) = 19.953) adalah kenaikan
12% lebih lanjut dalam harga sebenarnya.
6.0.1.3 latihan 3 jika modelnya rumit:
carPrice3 <- fitModel(
Price ~ A + B * Age + C * Mileage + D * Age * Mileage +
E * Age^2 + F * Mileage^2 + G * Age^2 * Mileage +
H * Age * Mileage^2,
data = Hondas)
gf_point(Mileage ~ Age, data = Hondas, fill = NA) %>%
contour_plot(
carPrice3(Age=Age, Mileage=Mileage) ~ Age + Mileage)
Untuk mobil di bawah 3 tahun atau lebih tua dengan jarak tempuh sangat
tinggi atau sangat rendah. Apakah kontur memiliki bentuk yang diharapkan
oleh pikiran? JAWABAN: Di mana ada banyak data, bentuk lokal kontur
memang miring ke bawah dari kiri ke kanan, seperti yang diantisipasi
oleh pikiran.
6.1 kurva dan model linier Kata linier dalam “model linier” mengacu pada “kombinasi linier”, bukan “garis lurus”. Sebagai ilustrasi, data dalam file “utilities.csv”merekam suhu rata-rata setiap bulan (dalam derajat F) serta penggunaan gas alam bulanan (dalam kaki kubik, ccf).
Utilities = read.csv("http://www.mosaic-web.org/go/datasets/utilities.csv")
gf_point(ccf ~ temp, data = Utilities)
Dalam hal aljabar linier, ini adalah kombinasi linier dari fungsi \(f_1(T) = 1\) dan \(f_2(T) = T\) . Secara konvensional, tentu
saja, fungsi garis lurus ditulis \(f(T) = b +
m T\) .
project(ccf ~ temp + 1, data = Utilities)
## (Intercept) temp
## 253.098208 -3.464251
Operator project( )memberikan nilai skalar. Fungsi pemasangan terbaik itu sendiri dibangun dengan menggunakan nilai skalar ini untuk menggabungkan fungsi yang terlibat.
model_fun = makeFun( 253.098 - 3.464*temp ~ temp)
gf_point(ccf ~ temp, data=Utils) %>%
slice_plot(model_fun(temp) ~ temp)
bisa menambahkan fungsi lain seperti sqrt(T):
project(ccf ~ temp + sqrt(temp) + 1, data = Utils)
## (Intercept) temp sqrt(temp)
## 447.029273 1.377666 -63.208025
mod2 <- makeFun(447.03 + 1.378*temp - 63.21*sqrt(temp) ~ temp)
gf_point(ccf ~ temp, data=Utils) %>% # the data
slice_plot(mod2(temp) ~ temp) %>%
gf_labs(x = "Temperature (F)",
y = "Natural gas used (ccf)")
Operator project( )mengambil serangkaian vektor. Saat menyesuaikan
fungsi ke data, vektor ini berasal dari kumpulan data sehingga perintah
harus mengacu pada nama besaran seperti yang muncul di kumpulan data,
misalnya, ccf atau temp.
contoh menggunakan banyak variabel dalam sebuah proyeksi:
Hondas = read.csv("http://www.mosaic-web.org/go/datasets/used-hondas.csv")
head(Hondas)
## Price Year Mileage Location Color Age
## 1 20746 2006 18394 St.Paul Grey 1
## 2 19787 2007 8 St.Paul Black 0
## 3 17987 2005 39998 St.Paul Grey 2
## 4 17588 2004 35882 St.Paul Black 3
## 5 16987 2004 25306 St.Paul Grey 3
## 6 16987 2005 33399 St.Paul Black 2
Inilah model yang sangat sederhana yang menggunakan kedua variabel:
project(Price ~ Age + Mileage + 1, data = Hondas)
## (Intercept) Age Mileage
## 2.133049e+04 -5.382931e+02 -7.668922e-02
fungsi matematika:
car_price <- makeFun(21330-5.383e2*age-7.669e-2*miles ~ age & miles)
contour_plot(car_price(age, miles) ~ age + miles,
domain(age=range(2, 8), miles=range(0, 60000))) %>%
gf_labs(title = "Miles per gallon")
model yang lebih canggih:
project(Price ~ Age + Mileage + Age*Mileage + 1, data = Hondas)
## (Intercept) Age Mileage Age:Mileage
## 2.213744e+04 -7.494928e+02 -9.413962e-02 3.450033e-03
car_price2 <- makeFun(22137 - 7.495e2*age - 9.414e-2*miles +
3.450e-3*age*miles ~ age & miles)
contour_plot(
car_price2(Age, Mileage) ~ Age + Mileage,
domain(Age = range(0, 10), Mileage = range(0, 100000))) %>%
gf_labs(title = "Price of car (USD)")
6.1.1 latihan 6.1.1.1 latihan 1: pemasangan polinomial
inilah cara menyesuaikan model kuadrat dengan variabel ccfversus dalam file data:temp"utilities.csv”
Utilities = read.csv("http://www.mosaic-web.org/go/datasets/utilities.csv")
project(ccf ~ 1 + temp + I(temp^2), data = Utilities)
## (Intercept) temp I(temp^2)
## 317.58743630 -6.85301947 0.03609138
Koefisien memberi tahu kita bahwa model kuadrat yang paling pas dari ccfversus temp adalah:
ccfQuad <- makeFun(317.587 - 6.853*T + 0.0361*T^2 ~ T)
gf_point(ccf ~ temp, data = Utilities) %>%
slice_plot(ccfQuad(temp) ~ temp)
Untuk mencari nilai model ini pada temperatur tertentu, evaluasi saja
fungsinya. (Dan perhatikan bahwa ccfQuad( )didefinisikan dengan variabel
input T.)
ccfQuad(T=72)
## [1] 11.3134
project(ccf ~ 1 + temp + I(temp^2) + I(temp^3), data = Utils)
## (Intercept) temp I(temp^2) I(temp^3)
## 2.550709e+02 -1.427408e+00 -9.643482e-02 9.609511e-04
ccfCubic <-
makeFun(2.551e2 - 1.427*T -
9.643e-2*T^2 + 9.6095e-4*T^3 ~ T)
gf_point(ccf ~ temp, data = Utils) %>%
slice_plot(ccfCubic(temp) ~ temp)
ccfCubic(32)
## [1] 142.1801
project(ccf ~ 1 + temp + I(temp^2) + I(temp^3) + I(temp^4),
data = Utils)
## (Intercept) temp I(temp^2) I(temp^3) I(temp^4)
## 1.757579e+02 8.225746e+00 -4.815403e-01 7.102673e-03 -3.384490e-05
ccfQuad <- makeFun(1.7576e2 + 8.225*T -4.815e-1*T^2 +
7.103e-3*T^3 - 3.384e-5*T^4 ~ T)
gf_point(ccf ~ temp, data = Utils) %>%
slice_plot(ccfQuad(temp) ~ temp) %>%
gf_labs(y = "Natural gas use (ccf)", x = "Temperature (F)")
ccfQuad(32)
## [1] 143.1713
slice_plot(ccfQuad(temp) - ccfCubic(temp) ~ temp,
domain(temp = range(20, 60)))
Perbedaan antara kedua model selalu sekitar 4 ccf.
6.1.1.2 latihan 2: regresi berganda Pada tahun 1980, majalah Consumer Reports mempelajari mobil model 1978-79 untuk mengeksplorasi bagaimana berbagai faktor mempengaruhi penghematan bahan bakar. Pengukuran tersebut mencakup efisiensi bahan bakar dalam mil per galon, bobot trotoar dalam pound, tenaga mesin dalam tenaga kuda, dan jumlah silinder. Variabel ini disertakan dalam file “cardata.csv”.
Cars = read.csv("http://www.mosaic-web.org/go/datasets/cardata.csv")
head(Cars)
## mpg pounds horsepower cylinders tons constant
## 1 16.9 3967.60 155 8 2.0 1
## 2 15.5 3689.14 142 8 1.8 1
## 3 19.2 3280.55 125 8 1.6 1
## 4 18.5 3585.40 150 8 1.8 1
## 5 30.0 1961.05 68 4 1.0 1
## 6 27.5 2329.60 95 4 1.2 1
project(mpg ~ pounds + 1, data = Cars)
## (Intercept) pounds
## 43.188646127 -0.007200773
43.1886 - 0.00720*2000
## [1] 28.7886
project(mpg ~ pounds + horsepower + 1, data = Cars)
## (Intercept) pounds horsepower
## 46.932738241 -0.002902265 -0.144930546
mod_fun <- makeFun(46.933 - 0.00290*lbs - 0.1449*hp ~ lbs + hp)
mod_fun(lbs = 2000, hp = 50)
## [1] 33.888
Cars = read.csv("http://www.mosaic-web.org/go/datasets/cardata.csv")
head(Cars)
## mpg pounds horsepower cylinders tons constant
## 1 16.9 3967.60 155 8 2.0 1
## 2 15.5 3689.14 142 8 1.8 1
## 3 19.2 3280.55 125 8 1.6 1
## 4 18.5 3585.40 150 8 1.8 1
## 5 30.0 1961.05 68 4 1.0 1
## 6 27.5 2329.60 95 4 1.2 1
6.3 Fungsi dengan parameter nonlinier eknik aljabar linier dapat digunakan untuk mencari kombinasi linier terbaik dari suatu himpunan fungsi. Namun, seringkali, ada parameter dalam fungsi yang muncul secara nonlinier. Contohnya termasuk \(k\) di \(f(t) = A \exp( kt ) + C\) dan \(P\) di \(A \sin(\frac{2\pi}{P} t) +C\) . Menemukan parameter nonlinier ini tidak dapat dilakukan secara langsung menggunakan aljabar linier, meskipun metode aljabar linier memang membantu menyederhanakan situasi.
6.4 Fungsi eksponensial sebagai contoh, pertimbangkan “Income-Housing.csv”data yang menunjukkan hubungan eksponensial antara fraksi keluarga dengan dua mobil dan pendapatan:
Families <- read.csv("http://www.mosaic-web.org/go/datasets/Income-Housing.csv")
gf_point(TwoVehicles ~ Income, data = Families)
Pola data menunjukkan “pembusukan” eksponensial terhadap hampir 100%
keluarga yang memiliki dua kendaraan. Bentuk matematika dari fungsi
eksponensial ini adalah \(A exp(k Y) +
C\) . A dan C adalah parameter linier yang tidak diketahui. \(k\) adalah parameter nonlinear yang tidak
diketahui – ini akan menjadi negatif untuk peluruhan eksponensial.
Misalkan kita menebak \(k\) . Tebakan
tidak harus benar-benar acak; kita dapat melihat dari datanya sendiri
bahwa “waktu paruh” adalah sekitar $25.000. Parameter \(k\) sesuai dengan waktu paruh, itu \(\ln(0.5)/\mbox{half-life}\) , jadi di sini
tebakan yang bagus untuk \(k\) adalah
\(\ln( 0,5)/25000\) , yaitu:
kguess <- log(0.5) / 25000
kguess
## [1] -2.772589e-05
nilai terbaik dari parameter linier \(A\) dan \(C\) melalui teknik aljabar linier:
project( TwoVehicles ~ 1 + exp(Income*kguess), data = Families)
## (Intercept) exp(Income * kguess)
## 110.4263 -101.5666
fungsi yang merupakan kombinasi linier terbaik dengan menambahkan kedua fungsi secara eksplisit:
f <- makeFun( 110.43 - 101.57*exp(Income * k) ~ Income, k = kguess)
gf_point(TwoVehicles ~ Income, data = Families) %>%
slice_plot(f(Income) ~ Income)
Grafik berjalan sangat dekat dengan titik data. Tapi kita juga bisa
melihat nilai numerik dari fungsi untuk setiap pendapatan:
f(Income = 10000)
## [1] 33.45433
f(Income = 50000)
## [1] 85.0375
Sangat informatif untuk melihat nilai fungsi untuk Incomelevel tertentu dalam data yang digunakan untuk pemasangan, yaitu data frame Families:
Results <- Families %>%
dplyr::select(Income, TwoVehicles) %>%
mutate(model_val = f(Income = Income),
resids = TwoVehicles - model_val)
Results
## Income TwoVehicles model_val resids
## 1 3914 17.3 19.30528 -2.0052822
## 2 10817 34.3 35.17839 -0.8783904
## 3 21097 56.4 53.84097 2.5590313
## 4 34548 75.3 71.45680 3.8432013
## 5 51941 86.6 86.36790 0.2320981
## 6 72079 92.9 96.66273 -3.7627306
panjang kuadrat vektor adalah jumlah residu kuadrat:
sum(Results$resids^2)
## [1] 40.32358
Panjang persegi residsvektor ini merupakan cara penting untuk mengukur seberapa cocok model dengan data.
6.5 Mengoptimalkan tebakan membuat fungsi yang menghitung jumlah sisa kuadrat untuk nilai apa pun dari \(k\) .
sum_square_resids <- Vectorize(function(k) {
sum((Families$TwoVehicles - f(Income=Families$Income, k)) ^ 2)
})
slice_plot(
sum_square_resids(k) ~ k,
domain(k = range(log(0.5)/40000,log(0.5)/20000)))
Ini adalah perintah komputer yang agak rumit, tetapi grafiknya langsung.
kita dapat melihat bahwa nilai “terbaik” dari \(k\) , yaitu nilai \(k\) yang membuat jumlah residu kuadrat
sekecil mungkin, mendekati \(k=-2.8\times10^
{-5}\) — tidak terlalu jauh dari tebakan awal, seperti yang
terjadi. (Itu karena waktu paruh sangat mudah diperkirakan.)