“之间”值的一对一映射？

Question

我正在尝试使用值的一对一关系进行映射，当值介于两个值之间时，该关系返回一个数据框。例如在这个数据集上：

                       Coastal_Cities Summer_2009 Summer_2010 Summer_2011 Summer_2012 Summer_2013 Summer_2014 Summer_2015 Summer_2016 Summer_2017 Summer_2018 Summer_2019
1                        Aberdeen City         497         434         437         310         541         556         556         492         474         616         526
2                    Barrow-in-Furness         552         555         637         445         671         726         616         514         547         773         627
3                            Blackpool         551         550         623         433         664         700         585         493         535         738         611

尝试以一对一的关系映射行中的每个值，相对于上下置信度之间的值，如果不是，则设置为 0。

   lower_confidence upper_confidence
1          479.8784         509.0307
2          588.6927         622.7619
3          573.3041         605.4232

所以第 1 行应该映射到第 1 行，第 2 行应该映射到第 2 行等等...

例如，给定一组值：

structure(list(Coastal_Cities = c("Aberdeen City", "Barrow-in-Furness", 
"Blackpool", "Bournemouth, Christchurch and Poole", "Caerdydd - Cardiff"
), Summer_2009 = c(497, 552, 551, 654, 529), Summer_2010 = c(434, 
555, 550, 642, 598), Summer_2011 = c(437, 637, 623, 567, 549), 
    Summer_2012 = c(310, 445, 433, 481, 433), Summer_2013 = c(541, 
    671, 664, 776, 733), Summer_2014 = c(556, 726, 700, 799, 
    741), Summer_2015 = c(556, 616, 585, 619, 621), Summer_2016 = c(492, 
    514, 493, 598, 524), Summer_2017 = c(474, 547, 535, 659, 
    569), Summer_2018 = c(616, 773, 738, 806, 730), Summer_2019 = c(526, 
    627, 611, 688, 561)), row.names = c(NA, 5L), class = "data.frame")

#Get its 95% confidence interval by rows
ci <- function(x){
z= rowMeans(x[,-1])-1.96*(apply(x[, -1], 1, sd)/length(x[,-1])); 
v =rowMeans(x[,-1])+1.96*(apply(x[, -1], 1, sd)/length(x[,-1])) ;
y=data.frame(lower_confidence = z, upper_confidence = v);
return(y)}

现在我正在尝试生成一个函数，将这些值存储在上下区间之间的每一行中：

diff_ci <- function(x, y) { 
  
  for(i in nrow(x)) {
    for(j in length(x[, -1])){
  t = x[j] > ci(y)[1][[1]][i] 
  p = x[j] < ci(y)[2][[1]][i]
  
    } 
    
  }
  e = data.frame(t, p)
  return(e)
}

但是，当我调用该函数时，我得到一个输出，我似乎无法解释它到底代表什么：

diff_ci(weather[, -1], weather)

 Summer_2018 Summer_2018.1
1        FALSE          TRUE
2         TRUE         FALSE
3         TRUE         FALSE
4         TRUE         FALSE
5         TRUE         FALSE

我不清楚它是否完成了我想做的任何事情。

当我在 lapply 函数中运行它时：

> lapply(weather[, -1], diff_ci, y=weather)

我得到错误：

data.frame(t, p) 中的错误：找不到对象“p”

我猜我搞砸了 for 循环中的参数分配？

我的预期输出（前 2 行）：

                       Coastal_Cities Summer_2009 Summer_2010 Summer_2011 Summer_2012 Summer_2013 Summer_2014 Summer_2015 Summer_2016 Summer_2017 Summer_2018 Summer_2019
1                   Barrow-in-Furness         497         0         0         0         0         0         0         492         0         0         0
2                           Blackpool         0         0         0         0         0         0         0         0         0         0         0

我还期望从我的代码解释中得到一个更简洁的版本，并解释我是如何出错的？

编辑： 我也试过这个修复了一些i /j 使用，但它只是打印整个输出......：

diff_ci <- function(x, y) { 
  
  for(i in nrow(x)) {
    for(j in length(x[, -1])){
  if(x[[j]][i] > ci(y)[1][[1]][i] | x[[j]][i] < ci(y)[2][[1]][i]){
    print(x)
  }
  
    } 
    
  }

}
diff_ci(ten_year.average[, -1], ten_year.average)

Answer 1

阅读您的问题，在我看来，您需要的是相当直接的。如果一个值落在逐行置信区间内，则提供该值。如果值超出置信区间，则返回 0。我将您提供的数据命名为 reprex。

我不确定您的用例是什么，所以我并没有真正摆弄您的 ci 计算，只是将其从函数中提取出来，以便您可以逐步构建数据框。

min <- 
  sapply(seq_along(reprex$Coastal_Cities), 
         function(x) {
           rowMeans(reprex[x,-1])-1.96*(apply(reprex[x, -1], 1, sd)/length(reprex[x,-1]))
           }
         )

max <- 
  sapply(seq_along(reprex$Coastal_Cities), 
         function(x) {
           rowMeans(reprex[x,-1])+1.96*(apply(reprex[x, -1], 1, sd)/length(reprex[x,-1]))
           }
         )

confint <- data.frame(min = min, max = max)

您可以利用数据帧结构，而不是通过 for 循环进入索引地狱。一个dataframeis a list of vectors，所以很容易使用lapply和sapply进行迭代。

如果我在数据框对象本身上使用lapply，它将遍历每一列。通过运行下面的简单示例，您可以看到这一点：

lapply(data.frame(a = 1:3, b = 4:6, c = 7:9), print)

因此，对于您的用例，您希望遍历我们通过初始 lapply 调用的向量的每个元素。我们可以使用嵌套的sapply 来保持向量结构。

使用我们上面非常简单的示例，假设我们想将“b”粘贴到数据框的每个观察值中：

lapply(data.frame(a = 1:3, b = 4:6, c = 7:9), 
    function(x) {
        sapply(x, 
            function(y) {
                paste(y, "b") }
        )
      }) 
# if we print the above output
$a
[1] "1 b" "2 b" "3 b"

$b
[1] "4 b" "5 b" "6 b"

$c
[1] "7 b" "8 b" "9 b"

所以我们应用相同的逻辑，除了粘贴“b”之外，我们使用ifelse 语句来返回原始值，或者如果 confint 数据帧中的相应行 (y) 则返回 0。

最后，我们想从我们的输出中获取一个数据框。所以我们使用 do.call 为 data.frame() 函数调用提供参数（向量列表）。

conditional <- 
lapply(reprex[-1], function(x) {
  sapply(seq_along(x), function(y) {
    if(x[y] > confint$min[y] & x[y] < confint$max[y]) {x[y]} else {0}
  })
})

do.call(data.frame, conditional)

但实际上，如果您经常做这种事情，我建议您花一些时间来学习 tidyverse。用于此类任务的大量节省时间的工具。使用 tidyverse 你可以像这样解决这个问题：

library(tidyverse)
reprex %>% 
  pivot_longer(starts_with("Summer")) %>%
  group_by(Coastal_Cities) %>%
  mutate(sd = sd(value),
         mean = mean(value),
         ci_min = mean - 1.96 * sd/n(),
         ci_max = mean + 1.96 * sd/n()) %>%
  ungroup() %>%
  mutate(value = case_when(
    ci_min <= value & value <= ci_max ~ value,
    TRUE ~ 0
  ))