Loop for variable definition R - r

I have a data frame and I want to define multiple columns with the same function (ntile) operated on the original version (column) of the variable. I'm not sure whether a loop or something else will work but the below example is a toy example. My actual data frame has over 20 variables that this needs to be done on.
Basically I want to make a variable called "original_name"_bin for each of the numeric variables in my data frame. These _bin variables are just the ntile function operated on the original non _bin version:
dat1 <- read.table(text = "x1 x2
10 20
20 30.5
30 40.5
40 20.12
50 25
70 86
80 75
90 45 ", header = TRUE)
num_names <- paste(colnames(dat1[sapply(dat1, is.numeric)]))
bin_names <- paste(colnames(dat1[sapply(dat1, is.numeric)]), "bin", sep = "_")
# Want to make columns in data frame where the var_bin is:
dat1$x1_bin <- ntile(dat1$x1, n = 10)
# loop
for (i in 1:length(bin_names)){
assign(paste0("dat1$", bin_names[i]), ntile(???, 10))
}

Here is one base way to do it using lapply:
dat1 <- read.table(text = "x1 x2
10 20
20 30.5
30 40.5
40 20.12
50 25
70 86
80 75
90 45 ", header = TRUE)
num_names <- paste(colnames(dat1[sapply(dat1, is.numeric)]))
bin_names <- paste(colnames(dat1[sapply(dat1, is.numeric)]), "bin", sep = "_")
dat1[bin_names] <- lapply(dat1[num_names], \(x) dplyr::ntile(x, n = 10))
dat1
#> x1 x2 x1_bin x2_bin
#> 1 10 20.00 1 1
#> 2 20 30.50 2 4
#> 3 30 40.50 3 5
#> 4 40 20.12 4 2
#> 5 50 25.00 5 3
#> 6 70 86.00 6 8
#> 7 80 75.00 7 7
#> 8 90 45.00 8 6
Created on 2021-12-07 by the reprex package (v2.0.1)
As base R loop:
for (i in 1:length(bin_names)){
dat1[bin_names[i]] <- dplyr::ntile(dat1[num_names[i]], 10)
}
dat1
#> x1 x2 x1_bin x2_bin
#> 1 10 20.00 1 1
#> 2 20 30.50 2 4
#> 3 30 40.50 3 5
#> 4 40 20.12 4 2
#> 5 50 25.00 5 3
#> 6 70 86.00 6 8
#> 7 80 75.00 7 7
#> 8 90 45.00 8 6
With dplyr::across:
library(dplyr)
dat1 %>%
mutate(across(all_of(num_names),
~ ntile(.x, n = 10),
.names = "{.col}_bin"))
#> x1 x2 x1_bin x2_bin
#> 1 10 20.00 1 1
#> 2 20 30.50 2 4
#> 3 30 40.50 3 5
#> 4 40 20.12 4 2
#> 5 50 25.00 5 3
#> 6 70 86.00 6 8
#> 7 80 75.00 7 7
#> 8 90 45.00 8 6
Created on 2021-12-07 by the reprex package (v2.0.1)

Related

Looping a loop to do everything at once

I am trying to simulate the following "game:
There is a population of 100 units
You randomly sample 10 of these units, record the id's of the units you saw, and then put them back into the population
You then take a second sample, record the id's of the units you saw in this second sample along with the first sample, and then put the second sample back into the population
Repeat this many times
I wrote the following code in R that performs the above procedure:
library(dplyr)
var_1 = rnorm(100,10,10)
var_2 = rnorm(100,1,10)
var_3 = rnorm(100,5,10)
response = rnorm(100,1,1)
my_data = data.frame(var_1, var_2, var_3, response)
my_data$id = 1:100
results <- list()
results2<- list()
for (i in 1:100)
{
iteration_i = i
sample_i = my_data[sample(nrow(my_data), 10), ]
results_tmp = data.frame(iteration_i, sample_i)
results[[i]] <- results_tmp
}
results_df <- do.call(rbind.data.frame, results)
test_1 <- data.frame(results_df %>%
group_by(id) %>%
filter(iteration_i == min(iteration_i)) %>%
distinct)
summary_file = data.frame(test_1 %>% group_by(iteration_i) %>% summarise(Count = n()))
cumulative = cumsum(summary_file$Count)
summary_file$Cumulative = cumulative
summary_file$unobserved = 100 - cumulative
The result looks something like this:
> summary_file
iteration_i Count Cumulative unobserved
1 1 10 10 90
2 2 8 18 82
3 3 9 27 73
4 4 8 35 65
5 5 6 41 59
6 6 5 46 54
7 7 7 53 47
8 8 7 60 40
9 9 4 64 36
10 10 3 67 33
11 11 4 71 29
12 12 4 75 25
13 13 1 76 24
14 14 4 80 20
15 15 1 81 19
16 16 2 83 17
17 17 2 85 15
18 18 1 86 14
19 20 1 87 13
20 22 1 88 12
21 23 2 90 10
22 24 1 91 9
23 25 1 92 8
24 27 2 94 6
25 28 1 95 5
26 30 1 96 4
27 35 1 97 3
28 37 1 98 2
29 44 1 99 1
30 46 1 100 0
I would now like to repeat this "game" many times.
I would like to keep the "summary_file" for each "game" (e.g. summary_file_1, summary_file_2, summary_file_3, etc.)
I would then like to create a "total" summary file that shows the number of iterations that were required in each game to observe all units.
This total_summary_file would look something like this:
game_id iterations_required
1 game_1 47
2 game_2 45
3 game_3 44
4 game_4 42
5 game_5 42
Currently, I am just copy/pasting my earlier code several times and storing the results, then I append everything at the end and calculate the summary statistics - but I am trying to find a way to "loop the loop" and do everything at once. I do not know if it is possible to introduce a command like "results_df_i <- do.call(rbind.data.frame, results_i)" into the loop and efficiently create everything at the same time instead of manually copy/pasting the earlier loop.
You're making this a lot less efficient than it could be. To get, say, 100 repeated samples of 10 from the set 1:100 (with replacement), we can do replicate(100, sample(100, 10, TRUE)).
We can then coerce this into a vector and count the number of unique values every 10 entries along the vector until we get to 100. This gives us the number of iterations required to exhaust the samples.
If we put this inside an sapply, we don't even need an explicit loop, which means we can create the results data frame in a single call:
set.seed(1)
n_games <- 10
results <- data.frame(game_id = paste("game", seq(n_games), sep = "_"),
iterations_required = sapply(seq(n_games), function(x) {
samp <- c(replicate(100, sample(100, 10, TRUE)))
sum(sapply(1:100 * 10, function(n) length(unique(samp[1:n]))) < 100)
}))
results
#> game_id iterations_required
#> 1 game_1 59
#> 2 game_2 44
#> 3 game_3 54
#> 4 game_4 59
#> 5 game_5 57
#> 6 game_6 58
#> 7 game_7 96
#> 8 game_8 60
#> 9 game_9 71
#> 10 game_10 33
Created on 2022-06-11 by the reprex package (v2.0.1)
There are lots of ways to get your desired outcome; wrapping your loop in a function and running the function multiple times is another potential solution:
library(dplyr)
var_1 = rnorm(100,10,10)
var_2 = rnorm(100,1,10)
var_3 = rnorm(100,5,10)
response = rnorm(100,1,1)
my_data = data.frame(var_1, var_2, var_3, response)
my_data$id = 1:100
results <- list()
results2<- list()
sample_func <- function(output_file_name) {
for (i in 1:100)
{
iteration_i = i
sample_i = my_data[sample(nrow(my_data), 10), ]
results_tmp = data.frame(iteration_i, sample_i)
results[[i]] <- results_tmp
}
results_df <- do.call(rbind.data.frame, results)
test_1 <- data.frame(results_df %>%
group_by(id) %>%
filter(iteration_i == min(iteration_i)) %>%
distinct)
summary_file = data.frame(test_1 %>% group_by(iteration_i) %>% summarise(Count = n()))
cumulative = cumsum(summary_file$Count)
summary_file$Cumulative = cumulative
summary_file$unobserved = 100 - cumulative
output_file_name <- summary_file
return(output_file_name)
}
list_of_names <- paste0("game_", 1:10)
output <- lapply(list_of_names, sample_func)
names(output) <- list_of_names
head(output, n = 2)
#> $game_1
#> iteration_i Count Cumulative unobserved
#> 1 1 10 10 90
#> 2 2 9 19 81
#> 3 3 8 27 73
#> 4 4 8 35 65
#> 5 5 6 41 59
#> 6 6 6 47 53
#> 7 7 6 53 47
#> 8 8 4 57 43
#> 9 9 4 61 39
#> 10 10 3 64 36
#> 11 11 2 66 34
#> 12 12 1 67 33
#> 13 13 4 71 29
#> 14 14 1 72 28
#> 15 15 2 74 26
#> 16 16 2 76 24
#> 17 17 3 79 21
#> 18 18 4 83 17
#> 19 19 2 85 15
#> 20 20 2 87 13
#> 21 21 1 88 12
#> 22 24 1 89 11
#> 23 25 2 91 9
#> 24 26 1 92 8
#> 25 27 1 93 7
#> 26 30 1 94 6
#> 27 31 1 95 5
#> 28 33 1 96 4
#> 29 34 1 97 3
#> 30 36 1 98 2
#> 31 41 1 99 1
#> 32 66 1 100 0
#>
#> $game_2
#> iteration_i Count Cumulative unobserved
#> 1 1 10 10 90
#> 2 2 10 20 80
#> 3 3 7 27 73
#> 4 4 7 34 66
#> 5 5 8 42 58
#> 6 6 5 47 53
#> 7 7 7 54 46
#> 8 8 5 59 41
#> 9 9 1 60 40
#> 10 10 7 67 33
#> 11 11 3 70 30
#> 12 12 3 73 27
#> 13 13 1 74 26
#> 14 14 3 77 23
#> 15 15 4 81 19
#> 16 16 3 84 16
#> 17 17 2 86 14
#> 18 18 1 87 13
#> 19 19 2 89 11
#> 20 20 1 90 10
#> 21 21 2 92 8
#> 22 22 1 93 7
#> 23 25 2 95 5
#> 24 27 1 96 4
#> 25 29 2 98 2
#> 26 30 1 99 1
#> 27 41 1 100 0
The output is a list, so you can use purrr to apply functions to each element (e.g. https://purrr.tidyverse.org/reference/lmap.html) or use the bind_rows() function to create a single dataframe for further use, e.g.
df2 <- bind_rows(output, .id = "game") %>%
group_by("Game" = factor(game, levels = list_of_names)) %>%
summarise(rows_in_output = n(),
number_of_iterations = max(iteration_i))
df2
#> # A tibble: 10 × 3
#> Game rows_in_output number_of_iterations
#> <fct> <int> <int>
#> 1 game_1 32 66
#> 2 game_2 27 41
#> 3 game_3 27 48
#> 4 game_4 32 50
#> 5 game_5 27 35
#> 6 game_6 27 71
#> 7 game_7 28 68
#> 8 game_8 27 48
#> 9 game_9 29 43
#> 10 game_10 29 66
Created on 2022-06-17 by the reprex package (v2.0.1)
Or you can use list2env() to get have each individual dataframe in your environment, e.g.
list2env(output, envir = .GlobalEnv)
ls()
#> [1] "df2" "game_1" "game_10" "game_2" "game_3" "game_4"
#> [7] "game_5" "game_6" "game_7" "game_8" "game_9" "list_of_names"
#> [13] "my_data" "output" "response" "results" "results2" "sample_func"
#> [19] "var_1" "var_2" "var_3"
This seems easily solvable using recursion:
fun <- function(x, i=1, size = 10){
a <- setdiff(x,sample(100, 10, TRUE)) # Remove the seen from x
if(length(a)) Recall(a, i+1) else i # if we have unobserved, call fun again
}
Now we can have as many games as we want:
data.frame(game = paste0('game',seq(10)), results = replicate(10, fun(1:100)))
game results
1 game1 62
2 game2 40
3 game3 51
4 game4 50
5 game5 34
6 game6 83
7 game7 38
8 game8 40
9 game9 53
10 game10 41
You could also do
hist(replicate(1000, fun(1:100)), breaks = 30)
Edit:
Note that this can be editted to take in any size and vector. eg:
fun <- function(x, size = 10, y=x, i=1){
a <- setdiff(x,sample(y, size, TRUE))
cat('i', i, '\t a: ',a, '\n')
if(length(a)>0) Recall(a, size, y, i+1) else i
}
set.seed(117);fun(1:10, 1)
i 1 a: 1 2 4 5 6 7 8 9 10 # 3 removed
i 2 a: 1 2 4 5 7 8 9 10 # 6 removed
i 3 a: 1 2 4 5 7 8 9 # 10 removed
i 4 a: 1 2 4 5 8 9 # 7 removed
i 5 a: 1 2 5 8 9 # 4 removed
i 6 a: 1 2 5 8 9 # Nothing removed
i 7 a: 1 5 8 9 # 2 removed
i 8 a: 1 5 8 # 9 removed
i 9 a: 1 5 # Nothing removed
i 10 a: 1 5 # Nothing removed
i 11 a: 5 # 1 removed
i 12 a: # 5 removed
Using Markov chains, we can produce the cumulative distribution function for the number of iterations required for a game (up to machine precision). The resulting CDF can be sampled directly using findInterval.
We can simplify things slightly by starting with the second iteration, since the first iteration will always result in 90 unseen units.
First, set up a matrix for all possible transitions:
m <- matrix(c(rep(90:1, each = 11), sequence(rep(11,90), 90:1, -1)), ncol = 2, dimnames = list(NULL, c("from", "to")))
m <- m[m[,2] >= 0L,]
Then create a transition matrix with row 1 representing the state where all units have been seen and row 91 representing the state where 10 units have been seen:
mTrans <- matrix(0, 91, 91)
The number of previously unseen units selected follows the hypergeometric distribution.
mTrans[m + 1L] <- dhyper(m[,1] - m[,2], m[,1], 100L - m[,1], 10L)
Row 1 represents an absorbing state since all units have been seen.
mTrans[1, 1] <- 1
mTrans contains the probabilities of each state after the second iteration.
Initialize a while loop and calculate the CDF.
mm <- mTrans %*% mTrans
maxIter <- 1000L
p <- numeric(maxIter)
iter <- 3L
while (p[iter] < 1) {
if ((iter <- iter + 1L) > maxIter) {
p <- c(p, numeric(maxIter))
maxIter <- maxIter*2L
}
mm <- mm %*% mTrans
p[iter] <- mm[91, 1]
}
p <- p[1:iter]
iter
#> [1] 345
Machine precision limits the CDF to less than 345 iterations. Plot the CDF:
plot(p, xlab = "iterations", ylab = "cumulative probability")
Using findInterval we can quickly generate a large number of random samples of the iterations required.
ngames <- 1e6L # one million games
results <- data.frame(game_id = 1:ngames, iterations_required = findInterval(runif(ngames), p))
head(results)
#> game_id iterations_required
#> 1 1 73
#> 2 2 69
#> 3 3 40
#> 4 4 41
#> 5 5 44
#> 6 6 43
Get a histogram of the sample number of iterations required.
hist(results$iterations_required)
OP here! I think I was able to find an answer to my own question:
library(dplyr)
var_1 <- rnorm(100, 10, 10)
var_2 <- rnorm(100, 1, 10)
var_3 <- rnorm(100, 5, 10)
response <- rnorm(100, 1, 1)
my_data <- data.frame(var_1, var_2, var_3, response)
my_data$id <- 1:100
simulate <- function() {
results <- list()
results2 <- list()
for (i in 1:100) {
iteration_i <- i
sample_i <- my_data[sample(nrow(my_data), 10), ]
results_tmp <- data.frame(iteration_i, sample_i)
results[[i]] <- results_tmp
}
results_df <- do.call(rbind.data.frame, results)
test_1 <- data.frame(results_df %>%
group_by(id) %>%
filter(iteration_i == min(iteration_i)) %>%
distinct)
summary_file <- data.frame(test_1 %>%
group_by(iteration_i) %>%
summarise(Count=n()))
cumulative <- cumsum(summary_file$Count)
summary_file$Cumulative <- cumulative
summary_file$unobserved <- 100 - cumulative
return(summary_file)
}
# now, loop 10 times!
results <- list()
for (i in 1:10) {
game_i <- i
s_i <- simulate()
results_tmp <- data.frame(game_i, s_i)
results[[i]] <- results_tmp
}
final_file <- do.call(rbind.data.frame, results)
Thanks for your help everyone!

Creating a grouping indicator per row in R

I have following data
x1 <- rnorm(20,0,1)
x2 <- rnorm(20,0,1)
group <- sample(50:55, size=20, replace=TRUE)
data <- data.frame(x1,x2,group)
head(data)
x1 x2 group
1 -0.88001290 0.53866432 50
2 0.34228653 -0.54503078 52
3 -2.42308971 0.09542262 54
4 0.07310148 -1.03226594 50
5 -0.47786709 2.46726615 55
6 0.45224510 -1.46224926 55
I need to create a grouping indicator based on group variable. (so that the rows where group=50 will equal to 1, group=51 equal to 2 so on)
I tried to do this using dplyr package in R. But I am not getting the correct answer as I have not defined the indicator variable correctly.
data %>% arrange(group) %>% group_by(group) %>% mutate(Indicator = n() )
Can anyone help me to correct my code?
Thank you
We need cur_group_id instead of n() (n() - returns the number of rows of that group)
library(dplyr)
data %>%
arrange(group) %>%
group_by(group) %>%
mutate(indicator = cur_group_id()) %>%
ungroup
-output
# A tibble: 20 x 4
# x1 x2 group indicator
# <dbl> <dbl> <int> <int>
# 1 -1.24 -0.497 50 1
# 2 -0.648 1.59 50 1
# 3 0.598 -0.325 51 2
# 4 -0.721 0.510 51 2
# 5 0.259 1.62 51 2
# 6 -0.288 0.872 52 3
# 7 0.403 0.785 52 3
# 8 1.84 1.65 52 3
# 9 0.116 -0.0234 52 3
#10 -1.31 -0.244 52 3
#11 -0.615 0.994 53 4
#12 -0.469 0.695 53 4
#13 -0.324 -0.599 53 4
#14 -0.394 -0.971 53 4
#15 1.30 0.323 54 5
#16 0.0242 -1.46 54 5
#17 -0.342 -1.96 54 5
#18 1.10 -0.569 54 5
#19 -0.967 -0.863 54 5
#20 -0.396 -0.441 55 6
Or another option is match
data %>%
mutate(indicator = match(group, sort(unique(group))))
base R using factor()
levels = 50:55
labels = 1:6
data$indicator <- factor(data$group, levels, labels)
or
levels = unique(data$group)
labels = seq_len(length(levels))
data$indicator <- factor(data$group, levels, labels)
dplyr::dense_rank may also help even without grouping
data %>% mutate(indicator = dense_rank(group) )
baseR way
data$indicator <- as.numeric(as.factor(data$group))
data
x1 x2 group indicator
1 -1.453628399 -1.78776319 55 6
2 -0.119413813 -0.07656982 52 3
3 0.387951296 -0.26845052 55 6
4 3.117977719 0.69280780 51 2
5 -0.938126762 -0.16898209 50 1
6 -1.596371818 0.35289797 52 3
7 -2.291376398 -1.59385221 55 6
8 0.161164263 -0.99387565 54 5
9 -0.281744752 -0.26801191 53 4
10 0.760719223 -0.28255900 50 1
11 -0.204073022 -1.10262114 51 2
12 0.653628314 0.77778039 54 5
13 0.043736298 -0.37896178 55 6
14 0.002800531 1.17034334 55 6
15 0.451136658 -0.38459588 51 2
16 0.151793862 0.60303631 55 6
17 0.173976519 -0.41745808 53 4
18 0.282827170 -0.16794851 52 3
19 0.737444975 -0.45712603 51 2
20 0.014182869 0.99013155 51 2

Make column with "sample" for each row with purrr

I'm trying to make column with sample value for each row of data
But I'm new with purrr and can't make this.
My code
df<-data.frame(x=rep(1:3,each=4),y=99)
df%>%
group_by(x)%>%
mutate_(val=~purrr::map_dbl(function(x) sample(50,1)))
This didn't work.
But function with purrr only working:
1:5%>%purrr::map_dbl(function(x) sample(50,1))
[1] 39 30 7 18 45
Thanks for any help!
You don't need purrr:
df <- data.frame(x = rep(1:3, each = 4), y = 99)
df %>%
group_by(x) %>%
mutate(val = sample(50, n()))
Output
# A tibble: 12 x 3
# Groups: x [3]
x y val
<int> <dbl> <int>
1 1 99.0 10
2 1 99.0 25
3 1 99.0 2
4 1 99.0 24
5 2 99.0 48
6 2 99.0 19
7 2 99.0 34
8 2 99.0 33
9 3 99.0 24
10 3 99.0 14
11 3 99.0 37
12 3 99.0 12
If you need to use purrr, I guess you could do:
dplyr::mutate(df, val = purrr::map(x, ~ sample(50, 1)))
x y val
1 1 99 35
2 1 99 4
3 1 99 43
4 1 99 28
5 2 99 49
6 2 99 31
7 2 99 31
8 2 99 31
9 3 99 19
10 3 99 4
11 3 99 43
12 3 99 20
Or with the pipe:
library(dplyr)
library(purrr)
df %>%
mutate(val = map(x, ~ sample(50, 1)))
Data:
df <- data.frame(x = rep(1:3, each = 4), y = 99)

Adding rows to a data frame to report all the values that did not change over time

I have this data frame:
Votes <- data.frame(
VoteCreationDate = c(1,3,3,5,5,6),
GiverId = c(19,19,38,19,38,19),
CumNumUpVotes = c(1,3,1,7,2,10)
)
Votes
VoteCreationDate GiverId CumNumUpVotes
1 19 1
3 19 3
3 38 1
5 19 7
5 38 2
6 19 10
For each GiverId (19 and 38), all possible dates (number from 1 to 6) should be listed in VoteCreationDate.
Then, for each GiverId and VoteCreationDate, the corresponding CumNumUpVotes should be matched. If there is no corresponding value, the CumNumUpVotes should be taken from the immediately preceding VoteCreationDate.
For example, for VoteCreationDate = 4 and GiverId = 38 there is no corresponding CumNumUpVotes. This cell should be equal to 1, which is the CumNumUpVotes from GiverId = 38 and VoteCreationDate = 3.
Here how it should look at the end:
VoteCreationDate GiverId CumNumUpVotes
1 19 1
2 19 1
3 19 3
4 19 3
5 19 7
6 19 10
1 38 0
2 38 0
3 38 1
4 38 1
5 38 2
6 38 2
Any idea how to get there?
A dplyr and tidyr solution.
library(dplyr)
library(tidyr)
Votes2 <- Votes %>%
complete(VoteCreationDate = full_seq(VoteCreationDate, period = 1), GiverId) %>%
arrange(GiverId, VoteCreationDate) %>%
group_by(GiverId) %>%
fill(CumNumUpVotes) %>%
replace_na(list(CumNumUpVotes = 0)) %>%
ungroup()
Votes2
# # A tibble: 12 x 3
# VoteCreationDate GiverId CumNumUpVotes
# <dbl> <dbl> <dbl>
# 1 1.00 19.0 1.00
# 2 2.00 19.0 1.00
# 3 3.00 19.0 3.00
# 4 4.00 19.0 3.00
# 5 5.00 19.0 7.00
# 6 6.00 19.0 10.0
# 7 1.00 38.0 0
# 8 2.00 38.0 0
# 9 3.00 38.0 1.00
# 10 4.00 38.0 1.00
# 11 5.00 38.0 2.00
# 12 6.00 38.0 2.00
do.call(rbind, lapply(split(Votes, Votes$GiverId), function(x){
temp = merge(x, data.frame(VoteCreationDate = 1:6), all = TRUE)
temp$GiverId = temp$GiverId[!is.na(temp$GiverId)][1]
temp$CumNumUpVotes = cummax(replace(temp$CumNumUpVotes, is.na(temp$CumNumUpVotes), 0))
temp
}))
# VoteCreationDate GiverId CumNumUpVotes
#19.1 1 19 1
#19.2 2 19 1
#19.3 3 19 3
#19.4 4 19 3
#19.5 5 19 7
#19.6 6 19 10
#38.1 1 38 0
#38.2 2 38 0
#38.3 3 38 1
#38.4 4 38 1
#38.5 5 38 2
#38.6 6 38 2

How to calculate the standard deviation of subsets of data down a column in R

I would like to calculate the standard deviation of every 4 values down a column from the first to the last observation. I have found lots of answers for moving SD functions, but I simply need a line of code that will calculate the sd() for every 4 data values and write the answers into a new column in the data frame as below:
Example data:
Obs Count
1 56
2 29
3 66
4 62
5 49
6 12
7 65
8 81
9 73
10 66
11 71
12 59
Desired output:
Obs Count SD
1 56 16.68
2 29 16.68
3 66 16.68
4 62 16.68
5 49 29.55
6 12 29.55
7 65 29.55
8 81 29.55
9 73 6.24
10 66 6.24
11 71 6.24
12 59 6.24
I tried the below code, but this is obviously incorrect:
a <- for(i in 1: length(df)) sd(df$Count[i:(i+3)])
This should be a very easy task, but I have not been able to find an answer. I am still learning and any help would be appreciated.
In base R, you can use the following to create an index of "every 4 rows":
(seq_len(nrow(mydf))-1) %/% 4
# [1] 0 0 0 0 1 1 1 1 2 2 2 2
Using that, you can use ave to get the desired result:
mydf$SD <- ave(mydf$Count, (seq_len(nrow(mydf))-1) %/% 4, FUN = sd)
mydf
# Obs Count SD
# 1 1 56 16.680827
# 2 2 29 16.680827
# 3 3 66 16.680827
# 4 4 62 16.680827
# 5 5 49 29.545163
# 6 6 12 29.545163
# 7 7 65 29.545163
# 8 8 81 29.545163
# 9 9 73 6.238322
# 10 10 66 6.238322
# 11 11 71 6.238322
# 12 12 59 6.238322
An anternative is using rollapply from zoo package in combination with rep.
> library(zoo)
> N <- 4 # every four values
> SDs <- rollapply(df[,2], width=N, by=N, sd)
> df$SD <- rep(SDs, each=N)
> df
Obs Count SD
1 1 56 16.680827
2 2 29 16.680827
3 3 66 16.680827
4 4 62 16.680827
5 5 49 29.545163
6 6 12 29.545163
7 7 65 29.545163
8 8 81 29.545163
9 9 73 6.238322
10 10 66 6.238322
11 11 71 6.238322
12 12 59 6.238322
You might want to get it all in a once:
df$SD <- rep( rollapply(df[,2], width=N, by=N, sd), each=N)
This looks faster (i didn't test tough):
# mydf = your data
idxs = rep(1:nrow(mydf), each = 4, length = nrow(mydf))
mydf = within(mydf, {
Sd = rep(tapply(Count, idxs, sd), each = 4)
})
print(mydf)

Resources