One-to-one mapping of 'between' values? - r

Question

I am trying to map with a one-to-one relation of values that returns a dataframe when the values are between two values. For example on this dataset:
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
Try to map with a one-to-one relation each value in the row, relative to the values between the upper and lower confidence, if not then set to 0.
lower_confidence upper_confidence
1 479.8784 509.0307
2 588.6927 622.7619
3 573.3041 605.4232
So row 1 should map to row 1, row 2 should map to row 2 etc ...
For example, given a set of values:
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)}
Now I am trying to produce a function that stores those values in each row that are between the upper and lower interval:
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)
}
However, when I call the function I get an output that I cannot seem to interpret what exactly is it representing by the :
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
It is not clear to me that it has done anything that I had in mind for.
As when I run this into a lapply function:
> lapply(weather[, -1], diff_ci, y=weather)
I get the error:
Error in data.frame(t, p) : object 'p' not found
I am guessing I messed up with the allocation of arguments within the for-loop?
My expected output (for first 2 rows):
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 am also expecting a cleaner version from the interpretation of my code with an explanation as to how I went wrong?
EDIT:
I have also tried this which fixes some of the i /j uses, however it just prints the entire output ...:
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

Reading your question it seems to me that what you need is fairly straight forward. If a value falls within the rowwise confidence interval provide that value. If a value is outside the confidence interval return 0. I named the data you supplied reprex.
I'm not sure what your use case is, so I didn't really fiddle with your ci calculation except to pull it out of a function so you can step through building the dataframe.
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)
Instead of stepping into indexing hell via for loops, you can take advantage of the dataframe structure. A dataframe is a list of vectors and so it is easy to work with lapply and sapply to iterate through.
If I use lapply on a dataframe object itself, it will iterate through each column. You can see this in action by running the simple example below:
lapply(data.frame(a = 1:3, b = 4:6, c = 7:9), print)
So for your use case you want to iterate through each element of the vector we call by an inital lapply. We can use a nested sapply to keep the vector structure.
using our really simple example above, let's say we want to paste "b" into each observation of the dataframe:
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"
So we apply the same logic, except instead of pasting "b" we use an if else statement to either return the original value, or return 0 if the corresponding row (y) in the confint dataframe.
Finally, we want to get a dataframe from our output. So we use do.call to supply the arguments (a list of vectors) to the data.frame() function call.
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)
But for real, if you do this kind of thing often, I recommend taking some time to learn the tidyverse. Tons of time saving tools for tasks like this. Using the tidyverse you could tackle this problem like so:
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
))