r - “之间”值的一对一映射?
问题描述
我正在尝试使用值的一对一关系进行映射,当值在两个值之间时返回数据框。例如在这个数据集上:
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)
解决方案
阅读您的问题,在我看来,您需要的是相当直截了当的。如果一个值落在逐行置信区间内,则提供该值。如果值超出置信区间,则返回 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 循环进入索引地狱。Adataframe
是一个向量列表,因此很容易使用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”,我们使用if
else
语句返回原始值,或者如果 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
))
推荐阅读
- python - 用于聚合保留截止时间的子实体的功能工具
- bash - 串行数据流的实时数学运算
- r - 滚动多元回归
- python - AttributeError:“元组”对象在将列从一个工作表复制到另一个工作表时没有属性“值”
- python - 列表的 dict+zip 问题 - 在转换中丢失列表的前两个值?
- python - TensorFlow Keras:tf.keras.Model train_on_batch vs make_train_function - 为什么一个比另一个慢?
- vhdl - 在 VHDL FSM 中计算外部信号
- reactjs - 通过其 id 属性引用 SVG 标记元素 *not*
- c# - 如何让 IEdmEntityTypeReference.Key() 以正确的顺序返回键?
- javascript - Nodejs + reactjs + jwt 检查