Как установить метку для точки, которая больше их медианы по r?

Question

Я новичок в R, и у меня проблемы с настройкой своих меток, чтобы их координаты были больше их медианы. Вот мой фрейм данных:

dat <- data.frame(
  time = factor(c("Breakfast","Breakfast","Breakfast","Lunch","Lunch","Lunch","Dinner","Dinner","Dinner","Snack","Snack","Snack","Snack"), levels=c("Breakfast","Lunch","Dinner","Snack")),
  total_bill_x = c(12.75,14.89,20.5,17.23,30.3,27.8,20.7,32.3,25.4,14.5,13.7,14.2,15.7), total_bill_y= c(20.75,15.29,18.52,19.23,27.3,23.6,19.75,27.3,21.48,13.66,15.59,17.3,14.78)
)

Вот мой код:

library (dplyr)
library(ggplot2)

c<-dat %>%
  group_by(time) %>%
  summarise(
    x = sum(total_bill_x),
    y = sum(total_bill_y) 
  )
#visualiser  
ggplot(c,aes(x,y))+
  geom_point()+
  geom_vline(linetype="dashed",color="red",xintercept = median(c$x))+
  geom_hline(linetype="dashed",color="red",yintercept = median(c$y))+
  geom_text(aes(label=time),hjust=1, vjust=1.2)

В этом случае метки, которые я хочу отобразить, - это только Lunch и Dinner. Какое условие я должен добавить, чтобы достичь этого?

Любая помощь будет принята с благодарностью.

Answer 1

Попробуйте следующее:

library (dplyr)
library(ggplot2)

dat <- data.frame(
  time = factor(c("Breakfast","Breakfast","Breakfast","Lunch","Lunch","Lunch","Dinner","Dinner","Dinner","Snack","Snack","Snack","Snack"), levels=c("Breakfast","Lunch","Dinner","Snack")),
  total_bill_x = c(12.75,14.89,20.5,17.23,30.3,27.8,20.7,32.3,25.4,14.5,13.7,14.2,15.7), total_bill_y= c(20.75,15.29,18.52,19.23,27.3,23.6,19.75,27.3,21.48,13.66,15.59,17.3,14.78)
)


c<-dat %>%
  group_by(time) %>%
  summarise(x = sum(total_bill_x),
            y = sum(total_bill_y)) %>% 
  mutate(med_x = median(x),
         med_y = median(y),
         lab = case_when(x > med_x & y > med_y ~ as.character(time),
                         TRUE ~ NA_character_))

#visualiser  
ggplot(c,aes(x,y))+
  geom_point()+
  geom_vline(linetype="dashed",color="red",xintercept = median(c$x))+
  geom_hline(linetype="dashed",color="red",yintercept = median(c$y))+
  geom_text(aes(label=lab),hjust=1, vjust=1.2)

Что даст вам:

Answer 2

Может быть, что-то вроде этого сработает

library(tidyverse)

dat <- data.frame(
  time = factor(c("Breakfast","Breakfast","Breakfast","Lunch","Lunch","Lunch","Dinner","Dinner","Dinner","Snack","Snack","Snack","Snack"), levels=c("Breakfast","Lunch","Dinner","Snack")),
  total_bill_x = c(12.75,14.89,20.5,17.23,30.3,27.8,20.7,32.3,25.4,14.5,13.7,14.2,15.7), total_bill_y= c(20.75,15.29,18.52,19.23,27.3,23.6,19.75,27.3,21.48,13.66,15.59,17.3,14.78)
)

c<-dat %>%
  group_by(time) %>%
  summarise(
    x = sum(total_bill_x),
    y = sum(total_bill_y),
  ) %>% 
  mutate(median_x = median(x),median_y = median(y)) %>% 
  filter(x > median_x,y > median_y)

ggplot(data = c,aes(x,y))+
  geom_point()+
  geom_vline(linetype="dashed",color="red",xintercept = c$median_x)+
  geom_hline(linetype="dashed",color="red",yintercept = c$median_y)+
  geom_text(aes(label=time),hjust=1, vjust=1.2)

^{Создано 08.05.2020 с помощью пакета (v0. 3,0)}

devtools::session_info()
#> - Session info ---------------------------------------------------------------
#>  setting  value                       
#>  version  R version 3.6.3 (2020-02-29)
#>  os       Windows 10 x64              
#>  system   x86_64, mingw32             
#>  ui       RTerm                       
#>  language (EN)                        
#>  collate  English_United Kingdom.1252 
#>  ctype    English_United Kingdom.1252 
#>  tz       America/Sao_Paulo           
#>  date     2020-05-08                  
#> 
#> - Packages -------------------------------------------------------------------
#>  package     * version date       lib source        
#>  assertthat    0.2.1   2019-03-21 [1] CRAN (R 3.6.3)
#>  backports     1.1.6   2020-04-05 [1] CRAN (R 3.6.3)
#>  broom         0.5.5   2020-02-29 [1] CRAN (R 3.6.3)
#>  callr         3.4.3   2020-03-28 [1] CRAN (R 3.6.3)
#>  cellranger    1.1.0   2016-07-27 [1] CRAN (R 3.6.3)
#>  cli           2.0.2   2020-02-28 [1] CRAN (R 3.6.3)
#>  colorspace    1.4-1   2019-03-18 [1] CRAN (R 3.6.1)
#>  crayon        1.3.4   2017-09-16 [1] CRAN (R 3.6.3)
#>  curl          4.3     2019-12-02 [1] CRAN (R 3.6.3)
#>  DBI           1.1.0   2019-12-15 [1] CRAN (R 3.6.3)
#>  dbplyr        1.4.2   2019-06-17 [1] CRAN (R 3.6.3)
#>  desc          1.2.0   2018-05-01 [1] CRAN (R 3.6.3)
#>  devtools      2.3.0   2020-04-10 [1] CRAN (R 3.6.3)
#>  digest        0.6.25  2020-02-23 [1] CRAN (R 3.6.3)
#>  dplyr       * 0.8.5   2020-03-07 [1] CRAN (R 3.6.3)
#>  ellipsis      0.3.0   2019-09-20 [1] CRAN (R 3.6.3)
#>  evaluate      0.14    2019-05-28 [1] CRAN (R 3.6.3)
#>  fansi         0.4.1   2020-01-08 [1] CRAN (R 3.6.3)
#>  farver        2.0.3   2020-01-16 [1] CRAN (R 3.6.3)
#>  forcats     * 0.5.0   2020-03-01 [1] CRAN (R 3.6.3)
#>  fs            1.4.1   2020-04-04 [1] CRAN (R 3.6.3)
#>  generics      0.0.2   2018-11-29 [1] CRAN (R 3.6.3)
#>  ggplot2     * 3.3.0   2020-03-05 [1] CRAN (R 3.6.3)
#>  glue          1.4.0   2020-04-03 [1] CRAN (R 3.6.3)
#>  gtable        0.3.0   2019-03-25 [1] CRAN (R 3.6.3)
#>  haven         2.2.0   2019-11-08 [1] CRAN (R 3.6.3)
#>  highr         0.8     2019-03-20 [1] CRAN (R 3.6.3)
#>  hms           0.5.3   2020-01-08 [1] CRAN (R 3.6.3)
#>  htmltools     0.4.0   2019-10-04 [1] CRAN (R 3.6.3)
#>  httr          1.4.1   2019-08-05 [1] CRAN (R 3.6.3)
#>  jsonlite      1.6.1   2020-02-02 [1] CRAN (R 3.6.3)
#>  knitr         1.28    2020-02-06 [1] CRAN (R 3.6.3)
#>  labeling      0.3     2014-08-23 [1] CRAN (R 3.6.0)
#>  lattice       0.20-38 2018-11-04 [2] CRAN (R 3.6.3)
#>  lifecycle     0.2.0   2020-03-06 [1] CRAN (R 3.6.3)
#>  lubridate     1.7.8   2020-04-06 [1] CRAN (R 3.6.3)
#>  magrittr      1.5     2014-11-22 [1] CRAN (R 3.6.3)
#>  memoise       1.1.0   2017-04-21 [1] CRAN (R 3.6.3)
#>  mime          0.9     2020-02-04 [1] CRAN (R 3.6.2)
#>  modelr        0.1.6   2020-02-22 [1] CRAN (R 3.6.3)
#>  munsell       0.5.0   2018-06-12 [1] CRAN (R 3.6.3)
#>  nlme          3.1-144 2020-02-06 [2] CRAN (R 3.6.3)
#>  pillar        1.4.3   2019-12-20 [1] CRAN (R 3.6.3)
#>  pkgbuild      1.0.6   2019-10-09 [1] CRAN (R 3.6.3)
#>  pkgconfig     2.0.3   2019-09-22 [1] CRAN (R 3.6.3)
#>  pkgload       1.0.2   2018-10-29 [1] CRAN (R 3.6.3)
#>  prettyunits   1.1.1   2020-01-24 [1] CRAN (R 3.6.3)
#>  processx      3.4.2   2020-02-09 [1] CRAN (R 3.6.3)
#>  ps            1.3.2   2020-02-13 [1] CRAN (R 3.6.3)
#>  purrr       * 0.3.3   2019-10-18 [1] CRAN (R 3.6.3)
#>  R6            2.4.1   2019-11-12 [1] CRAN (R 3.6.3)
#>  Rcpp          1.0.4.6 2020-04-09 [1] CRAN (R 3.6.3)
#>  readr       * 1.3.1   2018-12-21 [1] CRAN (R 3.6.3)
#>  readxl        1.3.1   2019-03-13 [1] CRAN (R 3.6.3)
#>  remotes       2.1.1   2020-02-15 [1] CRAN (R 3.6.3)
#>  reprex        0.3.0   2019-05-16 [1] CRAN (R 3.6.3)
#>  rlang         0.4.5   2020-03-01 [1] CRAN (R 3.6.3)
#>  rmarkdown     2.1     2020-01-20 [1] CRAN (R 3.6.3)
#>  rprojroot     1.3-2   2018-01-03 [1] CRAN (R 3.6.3)
#>  rvest         0.3.5   2019-11-08 [1] CRAN (R 3.6.3)
#>  scales        1.1.0   2019-11-18 [1] CRAN (R 3.6.3)
#>  sessioninfo   1.1.1   2018-11-05 [1] CRAN (R 3.6.3)
#>  stringi       1.4.6   2020-02-17 [1] CRAN (R 3.6.2)
#>  stringr     * 1.4.0   2019-02-10 [1] CRAN (R 3.6.3)
#>  testthat      2.3.2   2020-03-02 [1] CRAN (R 3.6.3)
#>  tibble      * 3.0.0   2020-03-30 [1] CRAN (R 3.6.3)
#>  tidyr       * 1.0.2   2020-01-24 [1] CRAN (R 3.6.3)
#>  tidyselect    1.0.0   2020-01-27 [1] CRAN (R 3.6.3)
#>  tidyverse   * 1.3.0   2019-11-21 [1] CRAN (R 3.6.3)
#>  usethis       1.6.0   2020-04-09 [1] CRAN (R 3.6.3)
#>  vctrs         0.2.4   2020-03-10 [1] CRAN (R 3.6.3)
#>  withr         2.1.2   2018-03-15 [1] CRAN (R 3.6.3)
#>  xfun          0.13    2020-04-13 [1] CRAN (R 3.6.3)
#>  xml2          1.3.1   2020-04-09 [1] CRAN (R 3.6.3)
#>  yaml          2.2.1   2020-02-01 [1] CRAN (R 3.6.2)
#> 
#> [1] C:/Users/brunotc1/Documents/R/win-library/3.6
#> [2] C:/Program Files/R/R-3.6.3/library