Newer
Older
notebooks / ccn2019 / ccn2019_diagrams.R
NB_avg %>%
  mutate(cluster = dbscan::dbscan(cbind(accuracy,rts), eps = 0.5, minPts = 3)$cluster) %>%
  ggplot(aes(targets, accuracy, color=factor(cluster))) +
  ggtitle("targets (window = 8 trials)", "NOTE: each point is a single participant") +
  geom_point(alpha=0.3) +
  #geom_smooth(method='lm', se = F) +
  facet_wrap(~condition)


NB_avg %>%
  ggplot(aes(lures, accuracy, color=condition)) +
  ggtitle("lures (window = 8 trials)", "NOTE: each point is a single participant") +
  geom_point(alpha=0.3) +
  geom_smooth(method='lm', se = F)

NB_avg %>%
  ggplot(aes(skewness, accuracy, color=condition)) +
  ggtitle("skewness (window = 8 trials)", "NOTE: each point is a single participant") +
  geom_point(alpha=0.3) +
  geom_smooth(method='lm', se = F)

NB_avg %>%
  ggplot(aes(lumpiness, accuracy, color=condition)) +
  ggtitle("lumpiness", "NOTE: each point is a single participant") +
  geom_point(alpha=0.3) +
  geom_smooth(method='lm', se = F)

NB_avg %>%
  ggplot(aes(lumpiness, rts, color=condition)) +
  ggtitle("lumpiness (window = 8 trials)", "NOTE: each point is a single participant") +
  xlab("lumpiness") +
  ylab("Average RT") +
  geom_point(alpha=0.3) +
  geom_smooth(method='lm', se = F)

nback <- NB_modified

nback %>%
  mutate(block=as.factor(block)) %>%
  mutate(trial=as.factor(trial)) %>%
  mutate(condition=ifelse(condition=='2-back',2,3)) %>%
  #filter(condition=='3-back') %>%
  #mutate(correct=as.numeric(correct)) %>%
  inspect_cor(show_plot = T)

averaged_nback <- NB_avg

averaged_nback %>%
  mutate(condition=ifelse(condition=='2-back',2,3)) %>%
  inspect_cor(show_plot = T)




base.df <- data.frame(x=100-base.roc$specificities,
                      y=base.roc$sensitivities,
                      auc = base.roc$auc[1],
                      model="base")

extd.df <- data.frame(x=100-extd.roc$specificities,
                      y=extd.roc$sensitivities,
                      auc = extd.roc$auc[1],
                      model="extended")

chance.df <- data.frame(x=1:100, y=1:100, model=" ", auc=50)

library(ggrepel)
dats <- rbind(extd.df, base.df, chance.df)

to_auc_label <- function(model, auc) {
  paste(model,
        "\nAUC=",
        format(auc, digits=4),
        sep = ""
  )
}

dats$label = NA
dats[174,]$label = to_auc_label("Extended Model", dats[174,]$auc)
dats[647,]$label = to_auc_label("Base Model", dats[647,]$auc)


dats %>%
  ggplot(aes(x=x, y=y,
             group=model,
             color = model,
             linetype = factor(model))) +
  geom_line() +
  labs(title="AUCs for the base and extended models") +
  geom_label_repel(aes(label=label), na.rm = TRUE, box.padding = 2) +
  xlab("100% - Specificity") +
  ylab("Sensitivity") +
  theme_linedraw() +
  #scale_x_continuous(labels = scales::percent) +
  #scale_y_continuous(labels = scales::percent) +
  scale_fill_brewer(palette = "Greens") +
  scale_color_manual(values=c("black", "#808080", "gray")) +
  theme(legend.position = "none")

ggsave("fig1.png", plot = last_plot(), width = 4, height = 4)

boruta_scores %>%
  mutate(feature = row.names(.)) %>%
  arrange(meanImp) %>%
  ggplot(aes(x=reorder(feature,-meanImp), y=meanImp, fill=decision)) +
  geom_bar(stat = "identity") +
  ylab("Relative Importance Score") +
  xlab("Feature") +
  theme_linedraw() +
  scale_fill_grey() +
  labs(fill = "Selection Decision") +
  theme(
    legend.position = c(.95, .95),
    legend.justification = c("right", "top"),
    legend.box.just = "right",
    legend.margin = margin(6, 6, 6, 6)
  )