성능 평가

가족 정보를 사용한 모델의 성능을 알아보자. 이 모델을 위해 설명한 내용이 길어 이해를 도우려고 전체 코드를 보였다.

family_result <- foreach(f=folds) %do% {
  f$train$type <- "T"
  f$validation$type <- "V"
  all <- rbind(f$train, f$validation)
  ctree_model <- ctree(
    survived ~ pclass + sex + age + sibsp + parch + fare + embarked,
    data=f$train)
  all$prob <- sapply(predict(ctree_model, type="prob", newdata=all),
                     function(result) { result[1] })

  # 티켓 번호를 사용한 family_id
  family_idx <- 0
  ticket_based_family_id <- ddply(all, .(ticket), function(rows) {
    family_idx <<- family_idx + 1
    return(data.frame(family_id=paste0("TICKET_", family_idx)))
  })
  all <- adply(all, 1,
    function(row) {
      family_id <- NA
      if (!is.na(row$ticket)) {
        family_id <- subset(ticket_based_family_id,
                            ticket == row$ticket)$family_id
      }
        return(data.frame(family_id=family_id))
      })

  # avg_prob
  all <- ddply(all,
               .(family_id),
               function(rows) {
                 rows$avg_prob <- mean(rows$prob)
                 return(rows)
               })

  # maybe_parent, may_be_child
  all <- ddply(all, .(family_id), function(rows) {
    rows$maybe_parent <- FALSE
    rows$maybe_child <- FALSE
    if (NROW(rows) == 1 ||
        sum(rows$parch) == 0 ||
        NROW(rows) == sum(is.na(rows$age))) {
      return(rows)
    }
    max_age <- max(rows$age, na.rm=TRUE)
    min_age <- min(rows$age, na.rm=TRUE)
    return(adply(rows, 1, function(row) {
      if (!is.na(row$age) && !is.na(row$sex)) {
        row$maybe_parent <- (max_age - row$age) < 10
        row$maybe_child <- (row$age - min_age) < 10
      }
      return(row)
    }))
  })

  # avg_parent_prob, avg_child_prob
  all <- ddply(all, .(family_id), function(rows) {
    rows$avg_parent_prob <- rows$avg_prob
    rows$avg_child_prob <- rows$avg_prob
    if (NROW(rows) == 1 || sum(rows$parch) == 0) {
      return(rows)
    }
    parent_prob <- subset(rows, maybe_parent == TRUE)[, "prob"]
    if (NROW(parent_prob) > 0) {
      rows$avg_parent_prob <- mean(parent_prob)
    }
    child_prob <- c(subset(rows, maybe_child == TRUE)[, "prob"])
    if (NROW(child_prob) > 0) {
      rows$avg_child_prob <- mean(child_prob)
    }
    return(rows)
  })

  # ctree 모델
  f$train <- subset(all, type == "T")
  f$validation <- subset(all, type == "V")
  (m <- ctree(survived ~ pclass + sex + age + sibsp + parch + fare + embarked + maybe_parent
              + maybe_child + age + sex + avg_prob + avg_parent_prob + avg_child_prob,
              data=f$train))
  print(m)
  predicted <- predict(m, newdata=f$validation)
  return(list(actual=f$validation$survived, predicted=predicted))
}

성능 평가 결과는 다음과 같다.

> family_accuracy <- evaluation(family_result)
[1] "MEAN +/- SD: 0.815 +/- 0.028"

ctree( )만 사용한 이전 모델의 경우 성능이 0.812 +/- 0.030이었으므로, 가족 정보를 사용해 정확도의 평균이 개선되었고 표준 편차가 줄어들어 서로 다른 데이터에 대해서도 성능이 좀 더 일관적으로 나옴을 알 수 있다.

이제 최종적으로 11.2.2절에서 분리해둔 테스트 데이터에 세 가지 알고리즘(rpart, ctree, family_id를 사용한 모델)을 적용해서 결과를 비교해볼 차례다. 이 부분은 독자의 연습 문제로 남겨둔다.