我有以下数据框:

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))
}

My Question:我希望我的代码正在做它应该做的事情.但我想知道在R中是否有一个方法可以做同样的事情?

Bonus Question:我不明白我的最终数据没有针对date列进行排序

推荐答案

ordercatdata,而不是catval.(应该也适用于dplyr::arrange,但我不想加载dplyr.)

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

您可以使用ave,其中第一个参数是值val,第二个参数是类别cat.aveFUN应用于每个类别中的值.为了得到最高和最低的2%,我们可以使用quantile,然后比较它们的值.实际上它是布尔型的,但是由于val是数值,所以我们使用as.logical来获得所需的布尔值,用它我们可以生成ss来对数据框进行子集.

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

Data:

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")

R相关问答推荐

从字符载体创建函数参数

如何创建构成多个独立列条目列表的收件箱框列?

从多个前置日期中获取最长日期

无法在我的情节中表现出显着的差异

带有gplot 2的十字舱口

从开始时间和结束时间导出时间

在发布到PowerBI Service时,是否可以使用R脚本作为PowerBI的数据源?

从R导出全局环境中的所有sf(numrames)对象

如何写一个R函数来旋转最后n分钟?

如何在所有绘图中保持条件值的 colored颜色 相同?

将. xlsx内容显示为HTML表

2个Rscript.exe可执行文件有什么区别?

有没有可能用shiny 的书签恢复手风琴面板?

为什么我对圆周率图的蒙特卡罗估计是空的?

为R中的16组参数生成10000个样本的有效方法是什么?

使用geom_sf跨越日期线时的闭合边界

整理曲线图、曲线图和点图

随机将数据帧中特定列上的某些行设置为NA

为什么不能使用lApply在包装函数中调用子集

R-找出存在其他变量的各种大小的所有组合