Question

我有一个问题，我很难用MRE来解释。回答的方式，主要是因为我不完全了解问题所在我。因此，我对序言不清表示抱歉。

我想对许多样本和参考测量进行细微的修改对每个样本进行一些线性插值。我现在通过取出来做到这一点所有参考测量，使用以下方法将它们重新缩放为样本测量 approx，然后再将其修补。但是由于我先将其取出，所以我不能以group_by dplyr管道的方式很好地完成它。现在我用一个真的很丑陋的解决方法，我将新创建的空（NA）列添加到样本小标题，然后使用for循环进行。

所以我的问题确实是：如何在小组中实施大约部分进入管道，以便我可以在小组内做所有事情？我尝试过与dplyr::do()，并在“用dplyr编程”中遇到小插图，但是搜索主要为我提供了broom::augment和lm我认为可以操作的内容不同...（例如，参见 Using approx() with groups in dplyr）。该线程似乎也很有前途：How do you use approx() inside of mutate_at()?

irc上的某人建议使用带有条件case_when的条件突变，但是我还不完全了解这种情况下的位置和方式。

我认为问题在于我想过滤掉部分数据对于以下mutate操作，但mutate操作依赖于对我刚刚过滤掉的数据进行分组（如果有任何意义的话）。

这是MWE：

library(tidyverse) # or just dplyr, tibble

# create fake data
data <- data.frame(
  # in reality a dttm with the measurement time
  timestamp = c(rep("a", 7), rep("b", 7), rep("c", 7)),
  # measurement cycle, normally 40 for sample, 41 for reference
  cycle = rep(c(rep(1:3, 2), 4), 3),
  # wheather the measurement is a reference or a sample
  isref = rep(c(rep(FALSE, 3), rep(TRUE, 4)), 3),
  # measurement intensity for mass 44
  r44 = c(28:26, 30:26, 36, 33, 31, 38, 34, 33, 31, 18, 16, 15, 19, 18, 17)) %>%
  # measurement intensity for mass 45, normally also masses up to mass 49
  mutate(r45 = r44 + rnorm(21, 20))
# of course this could be tidied up to "intensity" with a new column "mass"
# (44, 45, ...), but that would make making comparisons even harder...

# overview plot
data %>%
  ggplot(aes(x = cycle, y = r44, colour = isref)) +
  geom_line() +
  geom_line(aes(y = r45), linetype = 2) +
  geom_point() +
  geom_point(aes(y = r45), shape = 1) +
  facet_grid(~ timestamp)

# what I would like to do
data %>%
  group_by(timestamp) %>%
  do(target_cycle = approx(x = data %>% filter(isref) %>% pull(r44),
    y = data %>% filter(isref) %>% pull(cycle),
    xout = data %>% filter(!isref) %>% pull(r44))$y) %>%
  unnest()
# immediately append this new column to the original dataframe for all the
# samples (!isref) and then apply another approx for those values.

# here's my current attempt for one of the timestamps
matchref <- function(dat) {
  # split the data into sample gas and reference gas
  ref <- filter(dat, isref)
  smp <- filter(dat, !isref)

  # calculate the "target cycle", the points at which the reference intensity
  # 44 matches the sample intensity 44 with linear interpolation
  target_cycle <- approx(x = ref$r44,
    y = ref$cycle, xout = smp$r44)

  # append the target cycle to the sample gas
  smp <- smp %>%
    group_by(timestamp) %>%
    mutate(target = target_cycle$y)

  # linearly interpolate each reference gas to the target cycle
  ref <- ref %>%
    group_by(timestamp) %>%
    # this is needed because the reference has one more cycle
    mutate(target = c(target_cycle$y, NA)) %>%
    # filter out all the failed ones (no interpolation possible)
    filter(!is.na(target)) %>%
    # calculate interpolated value based on r44 interpolation (i.e., don't
    # actually interpolate this value but shift it based on the 44
    # interpolation)
    mutate(r44 = approx(x = cycle, y = r44, xout = target)$y,
      r45 = approx(x = cycle, y = r45, xout = target)$y) %>%
    select(timestamp, target, r44:r45)

  # add new reference gas intensities to the correct sample gasses by the target cycle
  left_join(smp, ref, by = c("time", "target"))
}

matchref(data)
# and because now "target" must be length 3 (the group size) or one, not 9
# I have to create this ugly for-loop

# for which I create a copy of data that has the new columns to be created
mr <- data %>%
  # filter the sample gasses (since we convert ref to sample)
  filter(!isref) %>%
  # add empty new columns
  mutate(target = NA, r44 = NA, r45 = NA)

# apply matchref for each group timestamp
for (grp in unique(data$timestamp)) {
  mr[mr$timestamp == grp, ] <- matchref(data %>% filter(timestamp == grp))
}

Answer 1

这是将参考文献和样本分散到新列的一种方法。在此示例中，为简单起见，我删除了r45。

  data %>% 
    select(-r45) %>% 
    mutate(isref = ifelse(isref, "REF", "SAMP")) %>% 
    spread(isref, r44) %>% 
    group_by(timestamp) %>% 
    mutate(target_cycle = approx(x = REF, y = cycle, xout = SAMP)$y) %>% 
    ungroup

给予

  # timestamp      cycle  REF  SAMP target_cycle
  # <fct>     <dbl> <dbl> <dbl>        <dbl>
  # 1  a             1    30    28          3  
  # 2  a             2    29    27          4  
  # 3  a             3    28    26         NA  
  # 4  a             4    27    NA         NA  
  # 5  b             1    31    26         NA  
  # 6  b             2    38    36          2.5
  # 7  b             3    34    33          4  
  # 8  b             4    33    NA         NA  
  # 9  c             1    15    31         NA  
  # 10 c             2    19    18          3  
  # 11 c             3    18    16          2.5
  # 12 c             4    17    NA         NA

编辑以下地址以发表评论

要保留r45，可以使用如下所示的collect-unite-spread方法：

df %>% 
  mutate(isref = ifelse(isref, "REF", "SAMP")) %>% 
  gather(r, value, r44:r45) %>% 
  unite(ru, r, isref, sep = "_") %>% 
  spread(ru, value) %>%
  group_by(timestamp) %>% 
  mutate(target_cycle_r44 = approx(x = r44_REF, y = cycle, xout = r44_SAMP)$y) %>% 
  ungroup

给予

# # A tibble: 12 x 7
#    timestamp cycle r44_REF r44_SAMP r45_REF r45_SAMP target_cycle_r44
# <fct>        <dbl>   <dbl>    <dbl>   <dbl>    <dbl>        <dbl>
# 1  a             1      30       28    49.5     47.2          3  
# 2  a             2      29       27    48.8     48.7          4  
# 3  a             3      28       26    47.2     46.8         NA  
# 4  a             4      27       NA    47.9     NA           NA  
# 5  b             1      31       26    51.4     45.7         NA  
# 6  b             2      38       36    57.5     55.9          2.5
# 7  b             3      34       33    54.3     52.4          4  
# 8  b             4      33       NA    52.0     NA           NA  
# 9  c             1      15       31    36.0     51.7         NA  
# 10 c             2      19       18    39.1     37.9          3  
# 11 c             3      18       16    39.2     35.3          2.5
# 12 c             4      17       NA    39.0     NA           NA

在R

1 个答案: