UAS Matematika Aktuaria Lanjut

Analisa dan Visualisasi

Naftali Brigitta Gunawan

May 30, 2024


Kontak \(\downarrow\)
Email
Instagram https://www.instagram.com/nbrigittag/
RPubs https://rpubs.com/naftalibrigitta/
Nama Naftali Brigitta Gunawan
NIM 20214920002

Data yang digunakan

library(readxl)
data <- read_excel("datanya.xlsx")
head(data, 5) # panggil data

1. Logaritma Natural (ln) dari masing-masing variabel data

data$ln_Produktivitas <- log(data$Produktivitas)
data$ln_Suhu <- log(data$Suhu)
data$ln_Curah_Hujan <- log(data$Curah_Hujan)

data

Pada output diatas, sudah ada 3 kolom terbaru yaitu

  • Kolom ln_Produktivitas : Kolom yang berisi logaritma natural dari variabel Produktivitas.

  • Kolom ln_Suhu : Kolom yang berisi logaritma natural dari variabel Suhu.

  • Kolom ln_Curah_Hujan : Kolom yang berisi logaritma natural dari variabel Curah Hujan.

2. Model ekspetasi atau rata-rata dengan menggunakan fungsi logairtma natural (ln) Cobb-Douglas.

library(SciViews)
# Fit the linear regression model
model <- lm(ln(Produktivitas) ~ ln(Suhu) + ln(Curah_Hujan), data = data)

# View the summary of the model to see coefficients and statistics
summary(model)
## 
## Call:
## lm(formula = ln(Produktivitas) ~ ln(Suhu) + ln(Curah_Hujan), 
##     data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.75263 -0.06896  0.01269  0.09988  0.19079 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -19.1642     7.4161  -2.584 0.013422 *  
## ln(Suhu)          8.6217     2.2311   3.864 0.000389 ***
## ln(Curah_Hujan)  -0.1766     0.1194  -1.479 0.146726    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1744 on 41 degrees of freedom
## Multiple R-squared:  0.3161, Adjusted R-squared:  0.2827 
## F-statistic: 9.473 on 2 and 41 DF,  p-value: 0.0004149

Berdasarkan output model regresi linier dari data yang diberikan, model regresi yang diperoleh adalah sebagai berikut:

  • Produktivitas = -19.1642 + 8.6217 * Suhu - 0.1766 * Curah_Hujan

  • Multiple R-squared: 0.3161, yaitu hanya 31,61% data yang bisa dijelaskan

  • p-value sangat kecil (0.0004149), menunjukkan bahwa model secara keseluruhan signifikan secara statistik.

exp(model$coefficients)
##     (Intercept)        ln(Suhu) ln(Curah_Hujan) 
##    4.754572e-09    5.550955e+03    8.381157e-01
# Menggunakan model yang sudah ada untuk menghitung ekspektasi
E_G <- mean(predict(model, type = "response")) #  menghitung ekspektasi E[G]
E_G
## [1] 8.406432
# Menghitung standar deviasi dari model
std_dev_G <- sd(predict(model, type = "response")) #  menghitung standar deviasi G
std_dev_G
## [1] 0.1157838

3. Model variansi dengan menggunakan fungsi logaritma natural (ln) Cobb-Douglas.

beta_suhu = -10.88773
var_suhu = var(data$Suhu)
# Hitung dan cetak kontribusi variansi dari Suhu
variance_contribution_suhu <- beta_suhu^2 * var_suhu
cat("Kontribusi Variansi dari Suhu:", variance_contribution_suhu, "\n")
## Kontribusi Variansi dari Suhu: 12.23709
# Hitung dan cetak kontribusi variansi dari Curah Hujan
beta_curah_hujan = 0.15687
var_curah_hujan = var(data$Curah_Hujan)
variance_contribution_curah_hujan <- beta_curah_hujan^2 * var_curah_hujan
cat("Kontribusi Variansi dari Curah Hujan:", variance_contribution_curah_hujan, "\n")
## Kontribusi Variansi dari Curah Hujan: 3.82706
# Hitung dan cetak kontribusi kovarians
cov_suhu_curah_hujan = cov(data$Suhu,data$Curah_Hujan)
covariance_contribution <- 2 * beta_suhu * beta_curah_hujan * cov_suhu_curah_hujan
cat("Kontribusi Kovarians antara Suhu dan Curah Hujan:", covariance_contribution, "\n")
## Kontribusi Kovarians antara Suhu dan Curah Hujan: 1.786983
# Verifikasi total variansi
total_variance_verified <- variance_contribution_suhu + variance_contribution_curah_hujan + covariance_contribution
cat("Total Variansi yang Diverifikasi:", total_variance_verified, "\n")
## Total Variansi yang Diverifikasi: 17.85113
  • σ^2 Produktivitas = β1^2 σ^2 Suhu + β2^2 σ^2 Curah_Hujan + 2β1β2 Suhu, Curah_Hujan

  • σ^2 Produktivitas = 12.23709 + 3.82706 + 1.786983

  • σ^2 Produktivitas = 0.01979437

Total variansi yang dihitung dari model adalah 17.85113, yang cocok dengan total dari semua komponen variansi yang telah dihitung. Hal ini menunjukkan bahwa model variansi yang digunakan dapat menggambarkan dengan akurat bagaimana variabilitas dalam produktivitas didistribusikan, berdasarkan pengaruh Suhu, Curah Hujan, dan interaksi antara keduanya.

exp(total_variance_verified)
## [1] 56577919

4. Premi asuransi

Premi dengan Loading Faktor

\(𝛱𝐺 = (1+𝜃)𝐸[𝐺]\)

theta <- 0.1  # Loading faktor 10%
E_G <- mean(predict(model, type = "response")) #  menghitung ekspektasi E[G]
Pi_G_loading <- (1 + theta) * E_G

# Cetak premi dengan loading faktor
cat("Premi dengan Loading Faktor 10%:", exp(Pi_G_loading), "\n")
## Premi dengan Loading Faktor 10%: 10374.18
teta = c( 0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08,0.09,0.1)
premi = data.frame(teta)
premi$p_load = NA

for (i in c(1:10)){
  premi$p_load[i] <- (1+premi$teta[i]) * E_G
}

premi$p_load_unlog <- exp(premi$p_load)
library(data.table)
## Warning: package 'data.table' was built under R version 4.1.3
data.table(premi)

Premi Standar Deviasi

\(𝛱𝐺 = (𝐸[𝐺] + 𝜃*SQRT Var[G]\)

Pi_G_std_dev <- std_dev_G + E_G

# Cetak premi standar deviasi
cat("Premi Standar Deviasi:", exp(Pi_G_std_dev), "\n")
## Premi Standar Deviasi: 5025.175
premi_sd = data.frame(teta)
premi_sd$p_load =  (std_dev_G * premi_sd$teta) + E_G

premi_sd$p_load_unlog <- (premi_sd$p_load)
library(data.table)
data.table(premi_sd)

5. Model 3 Dimensi dari ketiga variabel

library(reshape2)
library(tidyverse)
library(tidymodels)
library(plotly)
library(kernlab)
library(pracma) #For meshgrid()

mesh_size <- .02
margin <- 0
X <- data %>% select(Suhu, Curah_Hujan)
y <- data %>% select(Produktivitas)

model <- svm_rbf(cost = 1.0) %>% 
  set_engine("kernlab") %>% 
  set_mode("regression") %>% 
  fit(Produktivitas ~ Suhu + Curah_Hujan, data = data)

x_min <- min(X$Suhu) - margin
x_max <- max(X$Suhu) - margin
y_min <- min(X$Curah_Hujan) - margin
y_max <- max(X$Curah_Hujan) - margin
xrange <- seq(x_min, x_max, mesh_size)
yrange <- seq(y_min, y_max, mesh_size)
xy <- meshgrid(x = xrange, y = yrange)
xx <- xy$X
yy <- xy$Y
dim_val <- dim(xx)
xx1 <- matrix(xx, length(xx), 1)
yy1 <- matrix(yy, length(yy), 1)
final <- cbind(xx1, yy1)
pred <- model %>%
  predict(final)

pred <- pred$.pred
pred <- matrix(pred, dim_val[1], dim_val[2])

fig <- plot_ly(data, x = ~Suhu, y = ~Curah_Hujan, z = ~Produktivitas ) %>% 
  add_markers(size = 5) %>% 
  add_surface(x=xrange, y=yrange, z=pred, alpha = 0.65, type = 'mesh3d', name = 'pred_surface')
fig