R语言 如何修剪数据框顶部和底部的X%(基于列)?

flmtquvp  于 2023-10-13  发布在  其他
关注(0)|答案(2)|浏览(115)

我有以下 Dataframe :

set.seed(3994)
val <- round(runif(n=30, min = 5, max= 300), digits=0)
cat <- rep(c("A", "B", "C"), each= 10)
date <- as.Date(sample(seq(as.Date('2000/01/01'), as.Date('2020/01/01'), by="day"), 30))

df <- data.frame(val, cat, date)
df <- df %>%  
  arrange(cat, val)

我想根据列cat为每个类别修剪顶部X%和底部X%的数据。例如,我想删除类别“A”、“B”和“C”的顶部2%和底部2%。当数据基于val列排序时。
我写了下面的代码:

trimTopBottomByCategory <- function(dataframe, category_col, numeric_col, date_column,  x) {
  trimmed_dataframes <- list()
  
  categories <- unique(dataframe[[category_col]])
  for (category in categories) {
    subset_df <- dataframe[dataframe[[category_col]] == category, ]
    
    n <- nrow(subset_df)
    num_to_trim <- ceiling(x / 100 * n)
    
    sorted_subset <- subset_df[order(subset_df[[numeric_col]]), ]
    trimmed_df <- sorted_subset[(num_to_trim + 1):(n - num_to_trim), ]
    trimmed_dataframes[[category]] <- trimmed_df
  }

  trimmed_combined <- do.call(rbind, trimmed_dataframes)
  return(trimmed_combined <- trimmed_combined %>% 
             arrange(category_col, date_column))
}

**我的问题:**我希望我的代码正在做它应该做的事情。但是我想知道R中是否有一个方法可以做到同样的事情?
**附加问题:**我不明白我的最终数据没有为date列排序

fcg9iug3

fcg9iug31#

order通过 catdata,而不是通过 cat 和 * 瓦尔 *。(应该也可以使用dplyr::arrange,但我不想加载dplyr

df <- df[with(df, order(cat, date)), ]

可以使用ave,其中第一个参数是value val,第二个参数是类别 cataveFUN应用于每个类别中的值。为了得到最高和最低的2%,我们可以使用quantile,然后比较这些值。实际上它是布尔值,但由于val是数值型的,我们得到的是数值型的,所以我们使用as.logical来得到所需的布尔值,然后我们可以生成ss来子集化 Dataframe 。

ss <- with(df, as.logical(ave(val, cat, FUN=\(x) {
  q <- quantile(x, probs=c(.02, 1 - .02))
  x >= q[1] & x <= q[2]
})))

df[ss, ]
#    val cat       date
# 3   81   A 2000-08-10
# 10 188   A 2000-11-03
# 4  171   A 2006-11-26
# 2  182   A 2009-07-05
# 7  173   A 2010-09-12
# 6   54   A 2012-06-01
# 1  227   A 2014-08-05
# 9   95   A 2016-09-13
# 17 219   B 2002-12-29
# 14 221   B 2004-07-28
# 18 225   B 2011-06-29
# 19 191   B 2013-03-05
# 16 236   B 2013-09-27
# 12 117   B 2015-11-30
# 15 131   B 2017-11-22
# 13  92   B 2019-02-09
# 27 251   C 2000-03-13
# 30 160   C 2001-03-12
# 28 112   C 2002-02-19
# 29 174   C 2005-07-19
# 22 248   C 2006-12-23
# 21 176   C 2012-01-25
# 26  85   C 2016-08-06
# 24  56   C 2017-12-12
  • 数据:*
df <- structure(list(val = c(81, 188, 171, 12, 264, 182, 173, 54, 227, 
95, 219, 221, 274, 78, 225, 191, 236, 117, 131, 92, 251, 160, 
112, 265, 174, 248, 176, 42, 85, 56), cat = c("A", "A", "A", 
"A", "A", "A", "A", "A", "A", "A", "B", "B", "B", "B", "B", "B", 
"B", "B", "B", "B", "C", "C", "C", "C", "C", "C", "C", "C", "C", 
"C"), date = structure(c(11179, 11264, 13478, 13910, 14119, 14430, 
14864, 15492, 16287, 17057, 12050, 12627, 14565, 14605, 15154, 
15769, 15975, 16769, 17492, 17936, 11029, 11393, 11737, 12467, 
12983, 13505, 15364, 15472, 17019, 17512), class = "Date")), row.names = c(3L, 
10L, 4L, 5L, 8L, 2L, 7L, 6L, 1L, 9L, 17L, 14L, 20L, 11L, 18L, 
19L, 16L, 12L, 15L, 13L, 27L, 30L, 28L, 23L, 29L, 22L, 21L, 25L, 
26L, 24L), class = "data.frame")
aoyhnmkz

aoyhnmkz2#

下面是一个dupiter选项:

library(dplyr)
df %>%
group_by(cat) %>%
mutate(proc = (row_number()-1)/(n()-1)*100) %>% #modify here if you need to adjust code 
# for instance to remove rows by value not row_number order use rank()
filter(between(proc, 2, 98)) %>%
ungroup %>%
select(-proc) %>%
arrange(date)

相关问题