simulation/spike_function.r

In sooyongl/ESS:

evalInconsistency <- function(true_data, d_alpha =0, cut_level, cut_score) {
  # true_data = new_data; cut_level = 2; cut_score = 50 # cut_candi[1]
  true_data$OOD <- 1:dim(true_data)[1]

  above <- true_data %>%
    filter(Loc_RP50 < cut_score & ALD >= cut_level) %>%
    mutate(
      incon_position = "above",
      distance = abs(Loc_RP50 - cut_score)^d_alpha
      )
  below <- true_data %>%
    filter(Loc_RP50 >= cut_score & ALD < cut_level) %>%
    mutate(
      incon_position = "below",
      # distance = Loc_RP50 - (cut_score-1)
      distance = abs(Loc_RP50 - cut_score)^d_alpha
    )

  incon_data <- bind_rows(above, below)

  counts <- length(incon_data$distance)
  # weights <- round(sum(abs(incon_data$distance)), 2)
  D <- sum(incon_data$distance)

  # res <- list(incon_data = incon_data,
  #             cut_info = c(cut_level=cut_level, cut_score=cut_score, counts = counts, weights = weights)
  #             )

  res <- list(incon_data = incon_data,
              cut_info = c(cut_level=cut_level, cut_score=cut_score, counts = counts, weights = D)
  )

  return(res)
}

spikePlot <- function(incon_data, xaxix_con = F, point_size = 3, font_size = 14) {
# incon_data = incon_lv2

  geom.text.size = font_size * (5/14)

  plot_data <- incon_data$incon_data
  cut_info <- round(incon_data$cut_info,2)
  cut_info_name <- names(cut_info)

  cut_info <-
    glue("Cut Lv & Score = {cut_info[1]}, {cut_info[2]}\nCount & Weight = {cut_info[3]}, {cut_info[4]}\n")

  id_level <- as.character(plot_data$Item_ID)
  plot_data <- plot_data %>%
    mutate(
      distance = abs(distance),
      Loc_RP50 = round(Loc_RP50,0),
      x_name = paste0(Loc_RP50),
      Item_ID = factor(Item_ID, levels = id_level))

  # ano_x <- min(plot_data$Loc_RP50) + 2*sd(plot_data$Loc_RP50)
  ano_x <- round(length(plot_data$x_name)/4, 0)
  ano_y <- max(plot_data$distance) - sd(plot_data$distance)

  x_breaks_inx <- unique(sort(c(which.min(plot_data$distance), seq(1, length(plot_data$x_name), by = round(length(plot_data$x_name) * .1,0)))))
  x_breaks <- plot_data$Item_ID[x_breaks_inx]
  x_labels <- plot_data$x_name[x_breaks_inx]

if(xaxix_con) {

  counts_RP <- plot_data %>% count(Loc_RP50)
  plot_data <-
    plot_data %>%
    left_join(., counts_RP, by = "Loc_RP50") %>%
    mutate(distance_col = distance/n)

  ano_x <- round(min(plot_data$Loc_RP50) + sd(plot_data$Loc_RP50), 0)

  x_breaks_inx <- unique(

    c(which.min(plot_data$distance), seq(1, length(plot_data$x_name), by = round(length(plot_data$x_name) * .1,0)),length(plot_data$distance)))

  x_breaks <- plot_data$Loc_RP50[x_breaks_inx]

  p1<-plot_data %>%
    ggplot() +

    geom_col(aes(x = Loc_RP50, y = distance_col,
                 fill = incon_position, colour = incon_position),
             width = .025, alpha = 0.7) +

    geom_jitter(aes(x = Loc_RP50, y = distance, colour = incon_position),
               size = point_size, alpha = 0.5) +

    annotate(geom='text', x = ano_x, y = ano_y, label = cut_info, size = geom.text.size) +
    scale_y_continuous(breaks = pretty(plot_data$distance, n=10)) +
    labs(colour = "", fill = "") +

    theme_bw(base_size = font_size)

  p1 <- p1 + scale_x_continuous(name ="Loc",
                                breaks=x_breaks,
                                guide = guide_axis(n.dodge=2))
}
  if(!xaxix_con) {
  p1<-plot_data %>%
    ggplot() +

    geom_col(aes(x = Item_ID, y = distance,
                 fill = incon_position, colour = incon_position),
             width = .025, alpha = 0.7) +

    geom_point(aes(x = Item_ID, y = distance, colour = incon_position),
               size = point_size, alpha = 0.5) +

    annotate(geom='text', x = ano_x, y = ano_y, label = cut_info, size = geom.text.size) +
    scale_y_continuous(breaks = pretty(plot_data$distance, n=10)) +
    labs(colour = "", fill = "") +

    theme_bw(base_size = font_size)


    p1 <- p1 + scale_x_discrete(name ="Loc",
                     breaks=x_breaks,
                     labels = x_labels,
                     guide = guide_axis(n.dodge=2))

  }

  return(p1)
}