Wstęp

Dane dotyczą indywidualnych kosztów medycznych (charges) pacjentów, powiązanych z cechami demograficznymi (wiek, płeć, region) oraz czynnikami zdrowotnymi (BMI, palenie tytoniu, liczba dzieci). Dane zostały pobrane ze strony Kaggle. Głównym celem analizy jest zbudowanie modelu predykcyjnego, który dokładnie oszacuje wysokość kosztów medycznych na podstawie tych zmiennych.

Załadowanie bibliotek oraz import danych

library(randomForest)
## Warning: pakiet 'randomForest' został zbudowany w wersji R 4.2.3
## randomForest 4.7-1.1
## Type rfNews() to see new features/changes/bug fixes.
library(ggplot2)
## 
## Dołączanie pakietu: 'ggplot2'
## Następujący obiekt został zakryty z 'package:randomForest':
## 
##     margin
#import danych
insurance <- read.csv("C:/Users/Kucha/OneDrive/Pulpit/insurance.csv")

Wstępna analiza danych

summary(insurance)
##       age            sex                 bmi           children    
##  Min.   :18.00   Length:1338        Min.   :15.96   Min.   :0.000  
##  1st Qu.:27.00   Class :character   1st Qu.:26.30   1st Qu.:0.000  
##  Median :39.00   Mode  :character   Median :30.40   Median :1.000  
##  Mean   :39.21                      Mean   :30.66   Mean   :1.095  
##  3rd Qu.:51.00                      3rd Qu.:34.69   3rd Qu.:2.000  
##  Max.   :64.00                      Max.   :53.13   Max.   :5.000  
##     smoker             region             charges     
##  Length:1338        Length:1338        Min.   : 1122  
##  Class :character   Class :character   1st Qu.: 4740  
##  Mode  :character   Mode  :character   Median : 9382  
##                                        Mean   :13270  
##                                        3rd Qu.:16640  
##                                        Max.   :63770
str(insurance)
## 'data.frame':    1338 obs. of  7 variables:
##  $ age     : int  19 18 28 33 32 31 46 37 37 60 ...
##  $ sex     : chr  "female" "male" "male" "male" ...
##  $ bmi     : num  27.9 33.8 33 22.7 28.9 ...
##  $ children: int  0 1 3 0 0 0 1 3 2 0 ...
##  $ smoker  : chr  "yes" "no" "no" "no" ...
##  $ region  : chr  "southwest" "southeast" "southeast" "northwest" ...
##  $ charges : num  16885 1726 4449 21984 3867 ...
#missing values
colSums(is.na(insurance))
##      age      sex      bmi children   smoker   region  charges 
##        0        0        0        0        0        0        0
#zamiana zmiennych kategorycznych na numeryczne
insurance$sex <- as.factor(insurance$sex)
insurance$region <- as.factor(insurance$region)
insurance$smoker <- as.factor(insurance$smoker)

Podział danych na treningowe i testowe

train_size <- floor(0.7 * nrow(insurance))
train_indices <- sample(seq_len(nrow(insurance)), size = train_size)
train_data <- insurance[train_indices, ]
test_data <- insurance[-train_indices, ]

Tworzenie modelu Random Forest

1. Podstawowe informacje o modelu

  • Typ modelu: Regresja (przewidywanie ciągłej zmiennej charges)

  • Liczba drzew: 600

  • Zmienne na podział: 3

2. Jakość modelu

  • Wyjaśniona wariancja (R²): 83.01%

  • Mean absolute error (MSE): 24,647,288

3. Ważność zmiennych

% wzrost MSE (%IncMSE):

  • Smoker: 213.77
    Najważniejszy predyktor - usunięcie tej zmiennej najbardziej pogarsza model

  • Wiek (age): 114.06

  • BMI: 113.60
    Obie zmienne mają bardzo podobny i wysoki wpływ

  • Liczba dzieci (children): 35.37
    Znacznie mniejszy wpływ niż pozostałe

model_rf <- randomForest(charges ~ age + bmi + children + smoker + region,
                         data = train_data,
                         ntree = 600,
                         mtry = 3,
                         importance = TRUE,
                         do.trace = 100)
##      |      Out-of-bag   |
## Tree |      MSE  %Var(y) |
##  100 | 2.335e+07    15.81 |
##  200 | 2.333e+07    15.80 |
##  300 | 2.324e+07    15.74 |
##  400 | 2.317e+07    15.70 |
##  500 | 2.31e+07    15.65 |
##  600 | 2.312e+07    15.66 |
#Podstawowe informacje
print(model_rf)
## 
## Call:
##  randomForest(formula = charges ~ age + bmi + children + smoker +      region, data = train_data, ntree = 600, mtry = 3, importance = TRUE,      do.trace = 100) 
##                Type of random forest: regression
##                      Number of trees: 600
## No. of variables tried at each split: 3
## 
##           Mean of squared residuals: 23119443
##                     % Var explained: 84.34
#Importance zmiennych
varImpPlot(model_rf, main = "Ważność zmiennych")

importance(model_rf)
##             %IncMSE IncNodePurity
## age      103.074959   19472822209
## bmi      105.731831   23655999049
## children  17.097306    2749753946
## smoker   220.134350   85414321876
## region     9.033279    2519716888
#predykcje
predictions_rf <- predict(model_rf, newdata = test_data)

residuals_rf <- test_data$charges - predictions_rf

mae_rf <- mean(abs(residuals_rf))
rmse_rf <- sqrt(mean(residuals_rf^2))
rsq_rf <- cor(test_data$charges, predictions_rf)^2

Wizualizacja

1. Wykres rzeczywistych vs przewidywanych wartości

Pozytywy:

  • Bardzo wysokie R² (0.83) - model wyjaśnia 83% wariancji danych, co wskazuje na dobre dopasowanie

  • Widoczna liniowa zależność - punkty układają się wzdłuż linii y=x (czerwona linia), co potwierdza trafność predykcji

  • Dobrze odwzorowany zakres wartości - model radzi sobie zarówno z niskimi, jak i wysokimi wartościami charges

Obszary do poprawy:

  • Lekkie niedoszacowanie dla wysokich wartości
  • Możliwe wartości odstające

2. Wykres rozkładu błędów predykcji

Pozytywy:

  • Rozkład zbliżony do symetrycznego wokół zera - brak systematycznego błędu

  • Większość błędów skupiona wokół zera - dobre dopasowanie dla większości przypadków

Obszary do poprawy:

  • Lekka prawostronna skośność - więcej błędów dodatnich (model częściej niedoszacowuje)

  • Długie ogony rozkładu - występują pojedyncze przypadki z bardzo dużymi błędami (>20,000 USD)

  • Szerszy rozrzut dla ujemnych błędów (większe przeszacowania niż niedoszacowania)

# Rzeczywiste vs przewidywane
ggplot(data.frame(Actual = test_data$charges, Predicted = predictions_rf),
       aes(x = Actual, y = Predicted)) +
  geom_point(alpha = 0.6) +
  geom_abline(slope = 1, intercept = 0, color = "red") +
  labs(title = "Random Forest: rzeczywiste vs przewidywane wartości",
       subtitle = paste("R² =", round(rsq_rf, 2))) +
  theme_minimal()

# Rozkład błędów
ggplot(data.frame(Residuals = residuals_rf), aes(x = Residuals)) +
  geom_histogram(bins = 30, fill = "steelblue") +
  labs(title = "Rozkład błędów predykcji") +
  theme_minimal()

Podsumowanie

Model wykazuje dobrą ogólną wydajność (R²=0.83), ale warto: