Related
I want to count the number of occurrences that a specific factor level occurs across multiple factor varaibles per row.
Simplified, I want to know how many times each factor level is chosen across specific variables per row (memberID).
Example data:
results=data.frame(MemID=c('A','B','C','D','E','F','G','H'),
value_a = c(1,2,1,4,5,1,4,0),
value_b = c(1,5,2,3,4,1,0,3),
value_c = c(3,5,2,1,1,1,2,1)
)
In this example, I want to know the frequency of each factor level for value_a and value_b for each MemID. How many times does A respond 1? How many times does A respond 2? Etc...for each level and for each MemID but only for value_a and value_b.
I would like the output to look something like this:
counts_by_level = data.frame(MemID=c('A','B','C','D','E','F','G','H'),
count_1 = c(2, 0, 1, 0, 0, 2, 0, 0),
count_2 = c(0, 1, 1, 0, 0, 0, 0, 0),
count_3 = c(0, 0, 0, 1, 0, 0, 0, 1),
count_4 = c(0, 0, 0, 1, 1, 0, 1, 0),
count_5 = c(0, 1, 0, 0, 1, 0, 0, 0))
I have been trying to use add_count or add_tally as well as table and searching other ways to answer this question. However, I am struggling to identify specific factor levels across multiple variables and then output new columns for the counts of those levels for each row.
You could do something like this. Note that you didn't include a zero count, but there are some zero selections.
library(tidyverse)
results |>
select(-value_c) |>
pivot_longer(cols = starts_with("value"),
names_pattern = "(value)") |>
mutate(count = 1) |>
select(-name) |>
pivot_wider(names_from = value,
values_from = count,
names_prefix = "count_",
values_fill = 0,
values_fn = sum)
#> # A tibble: 8 x 7
#> MemID count_1 count_2 count_5 count_4 count_3 count_0
#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 A 2 0 0 0 0 0
#> 2 B 0 1 1 0 0 0
#> 3 C 1 1 0 0 0 0
#> 4 D 0 0 0 1 1 0
#> 5 E 0 0 1 1 0 0
#> 6 F 2 0 0 0 0 0
#> 7 G 0 0 0 1 0 1
#> 8 H 0 0 0 0 1 1
Another solution:
results %>%
group_by(MemID, value_a, value_b) %>%
summarise(n=n()) %>%
pivot_longer(c(value_a,value_b)) %>%
group_by(MemID, value) %>%
summarise(n=sum(n)) %>%
pivot_wider(MemID,
names_from = value, names_sort = T, names_prefix = "count_",
values_from=n, values_fn=sum, values_fill = 0)
I have a data frame of values across successive years (columns) for unique individuals (rows). A dummy data example is provided here:
dt = structure(list(ID = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), `2015` = c(0,
0.8219178, 0, 0.1369863, 0, 1.369863, 0.2739726, 0.8219178, 5,
0), `2016` = c(0, 1.369863, 0, 0.2739726, 0, 0.2739726, 0, 3.2876712,
0, 0), `2017` = c(0.6849315, 0, 0, 0.6849315, 0, 0.5479452, 0,
0, 0, 0), `2018` = c(1.0958904, 0.5479452, 1.9178082, 0, 0, 0,
0, 0, 0, 3), `2019` = c(0, 0, 0, 1.0958904, 0, 0.9589041, 0.5479452,
0, 0, 0), `2020` = c(0.4383562, 0, 0, 0, 0.2739726, 0.6849315,
0, 0, 0, 0)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-10L))
I want to create a dataset where the maximum value for each individual that should appear for each year is 1. In cases where it exceeds this value, I want to carry the excess value over 1 into the next year (column) and sum it to that year's value for each individual and so on.
The expected result is:
dt_expected = structure(list(ID = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), `2015` = c(0,
0.8219178, 0, 0.1369863, 0, 1, 0.2739726, 0.8219178, 1, 0), `2016` = c(0,
1, 0, 0.2739726, 0, 0.6438356, 0, 1, 1, 0), `2017` = c(0.6849315,
0.369863, 0, 0.6849315, 0, 0.5479452, 0, 1, 1, 0), `2018` = c(1,
0.5479452, 1, 0, 0, 0, 0, 1, 1, 1), `2019` = c(0.0958904, 0,
0.9178082, 1, 0, 0.9589041, 0.5479452, 0.2876712, 1, 1), `2020` = c(0.4383562,
0, 0, 0.0958904, 0.2739726, 0.6849315, 0, 0, 0, 1)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -10L))
I am at a total loss of where to start with this problem, so any assistance achieving this using data.table would be greatly appreciated. My only thought is to use lapply with an ifelse function for the conditional component. Then should I be using rowSums or Reduce to achieve my outcome of shifting excess values across columns?
A translation of Martin Morgan's answer to data.table:
for (i in 2:(ncol(dt) - 1)) {
x = dt[[i]]
set(dt, j = i, value = pmin(x, 1))
set(dt, j = i + 1, value = dt[[i + 1L]] + pmax(x - 1, 0))
}
Not particularly pretty or efficient, but as a starting point I used pmin() and pmax() to update each year (and the subsequent year), iteratively. The current year is the minimum of the current year and 1 (pmin(x, 1)); the subsequent year is the current subsequent year plus the excess of the previous year (pmax(x - 1, 0))
update <- function(df) {
result = df
for (idx in 2:(ncol(df) - 1)) {
x = result[[ idx ]]
result[[ idx ]] = pmin(x, 1)
result[[ idx + 1 ]] = result[[ idx + 1 ]] + pmax(x - 1, 0)
}
result
}
We have
> all.equal(update(dt), dt_expected)
[1] TRUE
I don't know how to translate this into efficient data.table syntax, but the function 'works' as is on a data.table, update(as.data.table(dt)).
Not sure if there is a more efficient way with built in functions, but I simply wrote a recursive function that implements your described algorithm for the rows and then apply it over every row.
f <- function(l, rest = 0, out = list()) {
if (length(l) == 0) return(unlist(out))
if (l[[1]] + rest <= 1) {
f(l[-1], rest = 0, out = append(out, list(l[[1]] + rest)))
} else (
f(l[-1], rest = l[[1]] + rest - 1, out = append(out, list(1)))
)
}
dt[-1] <- apply(dt[-1], 1, f, simplify = F) |>
do.call(what = rbind)
dt
#> # A tibble: 10 × 7
#> ID `2015` `2016` `2017` `2018` `2019` `2020`
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 1 0 0 0.685 1 0.0959 0.438
#> 2 2 0.822 1 0.370 0.548 0 0
#> 3 3 0 0 0 1 0.918 0
#> 4 4 0.137 0.274 0.685 0 1 0.0959
#> 5 5 0 0 0 0 0 0.274
#> 6 6 1 0.644 0.548 0 0.959 0.685
#> 7 7 0.274 0 0 0 0.548 0
#> 8 8 0.822 1 1 1 0.288 0
#> 9 9 1 1 1 1 1 0
#> 10 10 0 0 0 1 1 1
Created on 2022-03-25 by the reprex package (v2.0.1)
Here is my solution:
dt |>
pivot_longer(cols = -ID, "year") |>
arrange(ID, year) |>
group_by(ID) |>
mutate(x = {
r <- accumulate(value,
~max(0,.y + .x - 1),
.init = 0)
pmin(1, value + head(r, -1))
}) |>
select(x, year, ID) |>
pivot_wider(names_from = "year", values_from = "x")
##> + # A tibble: 10 × 7
##> # Groups: ID [10]
##> ID `2015` `2016` `2017` `2018` `2019` `2020`
##> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##> 1 1 0 0 0.685 1 0.0959 0.438
##> 2 2 0.822 1 0.370 0.548 0 0
##> 3 3 0 0 0 1 0.918 0
##> 4 4 0.137 0.274 0.685 0 1 0.0959
##> 5 5 0 0 0 0 0 0.274
##> 6 6 1 0.644 0.548 0 0.959 0.685
##> 7 7 0.274 0 0 0 0.548 0
##> 8 8 0.822 1 1 1 0.288 0
##> 9 9 1 1 1 1 1 0
##> 10 10 0 0 0 1 1 1
I have the following DF (example data, my actual data set is 96 columns):
class X1A X1B X2A X2B X3A X3B X4A X4B X5A X5B X6A X6B
1 A 0 1 0 0 0 0 0 1 1 1 1 1
2 B 1 1 1 1 0 0 0 1 1 1 0 1
3 C 0 0 0 1 1 0 0 0 1 1 0 0
4 D 0 0 0 1 1 0 1 0 1 0 0 0
5 A 0 1 1 1 0 0 0 1 1 1 1 1
6 B 0 0 1 1 0 0 0 1 1 1 0 1
7 C 0 0 0 1 1 0 0 0 1 1 0 0
8 D 0 0 0 1 1 0 1 0 1 0 0 0
9 A 0 1 1 1 0 0 0 1 1 1 1 1
10 B 1 1 1 1 0 0 0 1 1 1 0 1
11 C 0 0 0 1 1 0 0 0 1 1 0 0
12 D 0 1 0 1 1 0 1 0 1 0 0 0
Class denotes the phylogenic class of the organism (each replicate of the letter is a different species but members of the same class). 1A and 1B are samples from the same site. I want to combine the two presence/absence data (1/0 respectively) from each two samples from every site and add up the number of "presences" for the class across that site. so that my df now looks something like this:
Sample Class Number of Species Present
1 A 3
1 B 2
1 C 0
1 D 1
2 A 2
2 B 3
2 C 3
2 D 3
For example,
in the original df you see that Class C species are not present in sample 2A at all but each species of class C is present in sample 2B. So the output df records Species C as present 3 times in sample 2. Furthermore, Class B has 3 different species occur in 2A and in 2B but because they are replicates of the output df records sample 2 as having 3 Class B species present.
Any help would be appreactiated as I'm stumped!
Cheers!!
You just need to format your initial df a bit (since your colnames actually contain more information than just being a "name").
library(tidyverse)
d <- data %>% pivot_longer(-class, names_to = 'site', values_to = 'presence') %>%
mutate(sample=substr(site,1,1)) %>%
mutate(site = substr(site, 2,2))
d %>% group_by(class,sample) %>%
summarise(presence = sum(presence)) %>% arrange(sample)
which results in:
# A tibble: 24 x 3
# Groups: class [4]
class sample presence
<chr> <chr> <dbl>
1 A 1 3
2 B 1 4
3 C 1 0
4 D 1 1
5 A 2 4
6 B 2 6
7 C 2 3
8 D 2 3
9 A 3 0
10 B 3 0
Here is the data with dput():
structure(list(class = c("A", "B", "C", "D", "A", "B", "C", "D",
"A", "B", "C", "D"), `1A` = c(0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0), `1B` = c(1, 1, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1), `2A` = c(0,
1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0), `2B` = c(0, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1), `3A` = c(0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1,
1), `3B` = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), `4A` = c(0,
0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1), `4B` = c(1, 1, 0, 0, 1, 1,
0, 0, 1, 1, 0, 0), `5A` = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1), `5B` = c(1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0), `6A` = c(1,
0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0), `6B` = c(1, 1, 0, 0, 1, 1,
0, 0, 1, 1, 0, 0)), class = c("spec_tbl_df", "tbl_df", "tbl",
"data.frame"), row.names = c(NA, -12L), spec = structure(list(
cols = list(class = structure(list(), class = c("collector_character",
"collector")), `1A` = structure(list(), class = c("collector_double",
"collector")), `1B` = structure(list(), class = c("collector_double",
"collector")), `2A` = structure(list(), class = c("collector_double",
"collector")), `2B` = structure(list(), class = c("collector_double",
"collector")), `3A` = structure(list(), class = c("collector_double",
"collector")), `3B` = structure(list(), class = c("collector_double",
"collector")), `4A` = structure(list(), class = c("collector_double",
"collector")), `4B` = structure(list(), class = c("collector_double",
"collector")), `5A` = structure(list(), class = c("collector_double",
"collector")), `5B` = structure(list(), class = c("collector_double",
"collector")), `6A` = structure(list(), class = c("collector_double",
"collector")), `6B` = structure(list(), class = c("collector_double",
"collector"))), default = structure(list(), class = c("collector_guess",
"collector")), skip = 1L), class = "col_spec"))
You can try this:
Code
df %>%
#long format with column for sample and species
pivot_longer(-class,
names_pattern = "(\\d*)([A-Z]*)",
names_to = c("sample", "species")) %>%
#creating two columns (for each species one)
pivot_wider(c(class, sample),
names_from = species,
values_from = value,
values_fn = list) %>%
unnest(c(A, B)) %>%
#creating a presence column - 1 when any species (column A and B) is presence
mutate(presence = ifelse(A == 1 | B == 1, 1, 0)) %>%
#sum prescence by sample and class
group_by(sample, class) %>%
summarise(Number = sum(presence))
Output
# A tibble: 24 x 3
# Groups: sample [6]
sample class Number
<chr> <chr> <dbl>
1 1 A 3
2 1 B 2
3 1 C 0
4 1 D 1
5 2 A 2
6 2 B 3
7 2 C 3
8 2 D 3
9 3 A 0
10 3 B 0
# ... with 14 more rows
I have a df that looks like this:
It can be build using codes:
structure(list(ID = c(1, 2, 3, 4, 5), Pass = c(0, 1, 1, 1, 1),
Math = c(0, 0, 1, 1, 1), ELA = c(0, 1, 0, 1, 0), PE = c(0,
0, 1, 1, 1)), row.names = c(NA, -5L), class = c("tbl_df",
"tbl", "data.frame"))
Where pass stand for a student pass any test or not. Now I want to build a new var Result to capture a student's test results like following, what should I do?
Try the base R code below
q <- with(data.frame(which(df[-(1:2)] == 1, arr.ind = TRUE)),
tapply(names(df[-(1:2)])[col], factor(row, levels = 1:nrow(df)), toString))
df$Result <- ifelse(is.na(q), "Not Pass", paste0("Pass: ", q))
which gives
> df
# A tibble: 5 x 6
ID Pass Math ELA PE Result
<dbl> <dbl> <dbl> <dbl> <dbl> <chr>
1 1 0 0 0 0 Not Pass
2 2 1 0 1 0 Pass: ELA
3 3 1 1 0 1 Pass: Math, PE
4 4 1 1 1 1 Pass: Math, ELA, PE
5 5 1 1 0 1 Pass: Math, PE
Using dplyr with rowwise
library(dplyr)
library(stringr)
df1 %>%
rowwise %>%
mutate(Result = if(as.logical(Pass))
str_c('Pass: ', toString(names(select(., Math:PE))[as.logical(c_across(Math:PE))])) else 'Not pass' ) %>%
ungroup
# A tibble: 5 x 6
# ID Pass Math ELA PE Result
# <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
#1 1 0 0 0 0 Not pass
#2 2 1 0 1 0 Pass: ELA
#3 3 1 1 0 1 Pass: Math, PE
#4 4 1 1 1 1 Pass: Math, ELA, PE
#5 5 1 1 0 1 Pass: Math, PE
data
df1 <- structure(list(ID = c(1, 2, 3, 4, 5), Pass = c(0, 1, 1, 1, 1),
Math = c(0, 0, 1, 1, 1), ELA = c(0, 1, 0, 1, 0), PE = c(0,
0, 1, 1, 1)), row.names = c(NA, -5L), class = c("tbl_df",
"tbl", "data.frame"))
Here's one solution:
library(dplyr)
library(magrittr)
library(stringr)
df <- structure(list(ID = c(1, 2, 3, 4, 5), Pass = c(0, 1, 1, 1, 1),
Math = c(0, 0, 1, 1, 1), ELA = c(0, 1, 0, 1, 0), PE = c(0,
0, 1, 1, 1)), row.names = c(NA, -5L), class = c("tbl_df",
"tbl", "data.frame"))
df %<>% pivot_longer(cols = -c(ID, Pass), names_to = "sub", values_to = "done")
df %<>% group_by(ID) %>% mutate(Result = paste0(ifelse(done == 1, sub, NA), collapse = ", ")) %>% ungroup()
df %<>% pivot_wider(names_from = sub, values_from = done)
df %<>% mutate(Result = paste0("Pass: ", str_replace_all(Result, "NA[, ]*", "")))
df %<>% mutate(Result = ifelse(str_detect(Result, "Pass: $"), "Not pass", str_replace_all(Result, ",[\\s]*$", "")))
df
# # A tibble: 5 x 6
# ID Pass Result Math ELA PE
# <dbl> <dbl> <chr> <dbl> <dbl> <dbl>
# 1 1 0 Not pass 0 0 0
# 2 2 1 Pass: ELA 0 1 0
# 3 3 1 Pass: Math, PE 1 0 1
# 4 4 1 Pass: Math, ELA, PE 1 1 1
# 5 5 1 Pass: Math, PE 1 0 1
I can provide an explanation of what the code is doing if necessary.
I am using case_when to summarise a data frame using rowwise in dplyr. I have a sample data frame as shown below
structure(list(A = c(NA, 1, 0, 0, 0, 0, 0), B = c(NA, 0, 0, 1,
0, 0, 0), C = c(NA, 1, 0, 0, 0, 0, 0), D = c(NA, 1, 0, 1, 0,
0, 1), E = c(NA, 1, 0, 1, 0, 0, 1)), row.names = c(NA, -7L), class = "data.frame")
The code works when I mention all the names
df %>%
rowwise() %>%
mutate(New = case_when(any(c(A,B,C,D,E) == 1) ~ 1,
all(c(A,B,C,D,E) == 0 ) ~ 0
))
Can I pass the names in a vector, e.g cols <- colnames(df), and then that in case_when
To answer your question you can use cur_data() in dplyr 1.0.0 or c_across()
library(dplyr)
df %>%
rowwise() %>%
mutate(New = case_when(any(cur_data() == 1) ~ 1,
all(cur_data() == 0 ) ~ 0))
# A B C D E New
# <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#1 NA NA NA NA NA NA
#2 1 0 1 1 1 1
#3 0 0 0 0 0 0
#4 0 1 0 1 1 1
#5 0 0 0 0 0 0
#6 0 0 0 0 0 0
#7 0 0 0 1 1 1
With c_across() :
df %>%
rowwise() %>%
mutate(New = case_when(any(c_across()== 1) ~ 1,
all(c_across()== 0 ) ~ 0))
But you can also solve this using rowSums :
df %>%
mutate(New = case_when(rowSums(. == 1, na.rm = TRUE) > 0 ~ 1,
rowSums(. == 0, na.rm = TRUE) == ncol(.) ~ 0))
If you only have 0's and 1's in your dataset you could use this
df$New <- ifelse(rowSums(df) > 0, 1, 0)
If the rowsum > 0 it means that at least one '1' is present. Output
A B C D E New
1 NA NA NA NA NA NA
2 1 0 1 1 1 1
3 0 0 0 0 0 0
4 0 1 0 1 1 1
5 0 0 0 0 0 0
6 0 0 0 0 0 0
7 0 0 0 1 1 1
In base R, we can do this with
df$New <- +( rowSums(df) > 0)