Data 624 Assignment 9

simulated$duplicate1 <- simulated$V1 + rnorm(200) * .1
cor(simulated$duplicate1, simulated$V1)

model1 <- randomForest(y ~ ., data = simulated,importance = TRUE, ntree = 1000)
rfImp1 <- varImp(model1, scale = FALSE)

rfImp1 %>% arrange(-Overall)

library(Cubist)
library(gbm)
Mboosted<-gbm(y~.,data =simulated,distribution = "gaussian")
Mcube<-cubist(simulated[,-11],simulated$y,data =simulated,committees=100)

varImp(Mboosted, numTrees = 100) %>% 
  arrange(-Overall)

varImp(Mcube) %>% 
  arrange(-Overall)

df <- data.frame(var1 = sample(0:10000000/10000000, 500, replace = TRUE),
                 var2 = sample(0:1000/1000, 500, replace = TRUE),
                 var3 = sample(0:100000/100000, 500, replace = TRUE),
                 var4 = sample(0:10/10, 500, replace = TRUE)) %>% 
  mutate(y = var1 + var4 + rnorm(500))


head(df)

library(rpart)
rp_model <- rpart(y~., data=df)
varImp(rp_model) %>% 
  arrange(-Overall)

rpart.plot::rpart.plot(rp_model)

data(ChemicalManufacturingProcess)

df<-
ChemicalManufacturingProcess %>% 
  recipe(~.) %>% 
  step_impute_knn(all_predictors()) %>% 
  prep() %>% 
  bake(ChemicalManufacturingProcess)

parsnip::show_engines("decision_tree")

library(rules)

# setup decision tree engine
engine_dtree<-decision_tree() %>% 
  set_engine("rpart") %>% 
  set_mode("regression")

# Setup random forest regression
engine_forest<-rand_forest() %>% 
  set_engine("randomForest") %>% 
  set_mode("regression")

# Setup logistic regression
engine_cubist<- cubist_rules() %>% 
  set_engine("Cubist") %>% 
  set_mode("regression")

set.seed(1)
dfsplit<-initial_split(df, prop = 0.75)

df_train<-training(dfsplit)

df_test<-testing(dfsplit)

rec<-df_train %>% recipe(Yield~., data = df_train) 

Q8_3<-
  function(engine,model){
    dt_wf<-
      workflow() %>% 
      add_recipe(rec) %>% 
      add_model(engine)%>% 
      fit(data = df_train)
    res<-
      bind_rows(
        dt_wf %>% 
          predict(df_train) %>% 
          mutate(actual = df_train$Yield) %>% 
          mutate(type = "Training"),
        
        dt_wf %>% 
          predict(df_test) %>% 
          mutate(actual = df_test$Yield) %>% 
          mutate(type = "Testing")
      ) %>% 
      mutate(model = model) 
    return(list(dt_wf,res))
  }

Results<-
  bind_rows(
  Q8_3(engine_dtree,"Decision Tree")[2],
  Q8_3(engine_forest,"Random Forest")[2],
  Q8_3(engine_cubist,"Cubist")[2]
  )
Results %>% 
  group_by(type, model) %>% 
  metrics( truth = actual,estimate = .pred) %>% 
  pivot_wider(names_from = .metric, values_from = .estimate) %>% 
  ungroup() %>% 
  group_by(type) %>% 
  arrange(-rsq, .by_group = T)

library(ggpmisc)
Results %>% 
  ggplot(aes(y = .pred, x = actual,color = type )) +
  geom_point()+
  geom_smooth(method = "lm") +
  facet_grid(model~type, scales = "free")+
  stat_poly_eq(aes(label = paste(..adj.rr.label.., sep = "~~~")), 
               label.x.npc = "left", label.y.npc = .9,
               formula = y~x, parse = TRUE, size = 4)+
  theme(panel.background = element_blank(),
        panel.grid = element_blank(),
        panel.border = element_rect(color = "black", fill = NA),
        legend.position = "top",
        legend.title = element_blank())+
  scale_color_brewer( palette = "Dark2")+
  labs(x = "Actual Observations",
       y = "Predicted Observatins",
       title = "Comparison of Tree Based Models")

m1<-Q8_3(engine_dtree,"Decision Tree")[[1]]
m2<-Q8_3(engine_forest,"Random Forest")[[1]]
m3<-Q8_3(engine_cubist,"Cubist")[[1]]


bind_rows(
  m1$fit$fit$fit %>% varImp() %>% 
    top_n(10) %>% 
    arrange(-Overall) %>% 
    mutate(model = "Decition Tree") %>% 
    rownames_to_column()
  ,
  
  m2$fit$fit$fit %>% varImp() %>% 
    top_n(10) %>% 
    arrange(-Overall) %>% 
    mutate(model = "Random Forest") %>% 
    rownames_to_column()
  ,
  
  m3$fit$fit$fit %>% varImp() %>% 
    top_n(1) %>% 
    arrange(-Overall) %>% 
    mutate(model = "Cubist") %>% 
    rownames_to_column()
) %>%  
  mutate(rowname = tidytext::reorder_within(rowname, Overall, model)) %>%
  ggplot(aes(x = Overall, y = rowname, fill = model))+
  geom_col()+
  facet_wrap(~model, scales = "free", ncol = 1)+
  scale_color_brewer(palette = "Dark2")+
  scale_fill_brewer(palette = "Dark2")+
  tidytext::scale_y_reordered()+
  theme_bw()

engine_dtree<-decision_tree(cost_complexity = tune(),
                            tree_depth = tune(),
                            min_n= tune()) %>% 
  set_engine("rpart") %>% 
  set_mode("regression")


datacv<- vfold_cv(df, v = 10)

tree_grid <- grid_regular(cost_complexity(), tree_depth(), min_n(), levels = 4)

tree_rs <- tune_grid(
  object =  engine_dtree,
  preprocessor = rec,
  resamples = datacv,
  grid = tree_grid,
  metrics = metric_set(rsq,rmse )
)

collect_metrics(tree_rs) %>% kable() %>% 
   kable_styling(
      full_width = F, position="center", bootstrap_options = c("hover")) %>% 
  scroll_box(height = "200px") %>% 
  kable_classic_2()

tree_rs %>% autoplot()+theme_light(base_family = "IBMPlexSans")

final_tree <- finalize_model(engine_dtree, select_best(tree_rs, "rsq"))

final_tree

final_wf<-
  workflow() %>% 
  add_model(final_tree) %>% 
  add_recipe(rec)

dtmodel<-
  final_wf %>% fit(data = df)

rpart.plot::rpart.plot(dtmodel$fit$fit$fit, roundint = F)