Подмножество фрейма данных на основе плотности

Question

Я ищу функцию, которая позволяла бы подбирать фрейм данных на основе плотности двумерных наблюдений.Например:

ggplot(iris, aes(x = Petal.Length, y = Sepal.Width, color = Species)) + 
  stat_density2d(geom = 'polygon', aes(fill = ..level..), n = 8) + 
  geom_point()

Здесь я хотел бы отобразить только те точки, которые являются выбросами, основанными на плотности точек в пределах Видов (т.е. показать только 3 точки из сетоса и 4 точки из вирджиники, которые лежатвне контуров).

Answer 1

Моя методология немного запутанная, поэтому потерпите меня, я объясню ниже:

library(data.table)
dt <- as.data.table(iris)[, .(Petal.Length, Sepal.Width, Species)]
dt[, sample := .I]
dt <- melt(dt, id.vars = c("Species", "sample"))
dt[, c("meanval", "sdval") := .(mean(value), sd(value)), .(Species, variable)]
dt[abs({value - meanval} / sdval) > 2, outlier := TRUE]
dt[, anyOutliers := sum(outlier, na.rm = T), sample]
dt[anyOutliers != 0, outlier := TRUE]
dt <- dcast(
  dt[, .(Species, variable, value, outlier, sample)],
  sample + outlier + Species ~ variable,
  value.var = "value"
)

Сначала мы назначаем dt в качестве набора данных и сохраняем только те столбцы, которые планируем построить.Затем мы назначаем фиктивный столбец, который будет важен для этого конкретного набора данных, чтобы дифференцировать строки позже.Тогда мы melt() набор данных для целесообразности.Затем для каждого вида мы вычисляем среднее и стандартное отклонение каждого значения.Это позволяет нам в строке ниже определить выбросы (вы можете изменить > 2 здесь, чтобы повлиять на количество используемых SD).

Затем для каждого цветка мы выясним, является ли он выбросом влюбой из выбранных нами метрик (в данном случае petal.length и sepal.width).Если это так, весь цветок помечается как выброс.Затем мы возвращаем таблицу обратно в ее исходную форму, только теперь есть столбец выброса, который показывает, был ли цветок выбросом в какой-либо из наших метрик.

Я не буду вдаваться в их построение, так какВы можете выяснить, как вы хотите сделать это самостоятельно, но это должно дать общее представление о том, как двигаться дальше.Надеюсь, это поможет.

Answer 2

Это довольно хакерское решение, но вы могли бы написать функцию для извлечения точек вне контурного графика и возврата фрейма данных только с этими точками:

plot_outliers_only <- function (original_plot) {
  require(ggplot2)
  require(sp)
  pb <- ggplot_build(original_plot)
  group_labels <- grep("001", levels(pb$data[[1]]$group), value=TRUE)
  outlier_points <- lapply(group_labels, function (gl) {
    contour_data <- filter(pb$data[[1]], as.character(group)==gl)
    original_data <- 
    group_id <- as.numeric(strsplit(gl, "-")[[1]][1])
    outlier_id <- pb$data[[2]] %>%
      filter(group==group_id) %>%
      select(c(x, y)) %>%
      apply(1, function (point) {
        point.in.polygon(point[1], point[2], contour_data$x, contour_data$y)==0
      }) %>%
      which()
    if (length(outlier_id)==0) return (outlier_id)
    grouping_name <- as.character(original_plot$mapping$colour)
    as.numeric(original_plot$data[, grouping_name]) %>%
      `==`(group_id) %>%
      which() %>%
      slice(original_plot$data, .) %>%
      `[`(., outlier_id, )
  })
  do.call(what=rbind, outlier_points)
}

P <- ggplot(iris, aes(x = Petal.Length, y = Sepal.Width, color = Species)) + 
    stat_density2d(geom = 'polygon', aes(fill = ..level..), n = 8) + 
    geom_point()

plot_outliers_only(P)