I need to calculate the overall ontime percentage of each airline with this sample dataset.
library(tidyverse)
library(dplyr)
df_chi <- tribble(
~airline, ~ontime, ~qty,~dest,
'delta',TRUE,527,'CHI',
'delta',FALSE,92,'CHI',
'american',TRUE,4229,'CHI',
'american',FALSE,825,'CHI'
)
df_nyc <- tribble(
~airline, ~ontime, ~qty,~dest,
'delta',TRUE,1817,'NYC',
'delta',FALSE,567,'NYC',
'american',TRUE,1651,'NYC',
'american',FALSE,625,'NYC'
)
I have a solution although it is verbose and I want to avoid the numbered index ie [2,2]. Is there a more elegant way using more of the tidyverse?
df_all <- bind_rows(df_chi,df_nyc)
delta_ot <- df_all %>%
filter(airline == "delta") %>%
group_by(ontime) %>%
summarize(total = sum(qty))
delta_ot <- delta_ot[2,2] / sum(delta_ot$total)
american_ot <- df_all %>%
filter(airline == "american") %>%
group_by(ontime) %>%
summarize(total = sum(qty))
american_ot <- american_ot[2,2] / sum(american_ot$total)
As on the ontime column is logical column, use that to subset instead of [2, 2]. Also, instead of doing the filter, do this once by adding the 'airline' as a grouping column
library(dplyr)
bind_rows(df_chi, df_nyc) %>%
group_by(airline, ontime) %>%
summarise(total = sum(qty), .groups = 'drop_last') %>%
summarise(total = total[ontime]/sum(total))
-output
# A tibble: 2 × 2
airline total
<chr> <dbl>
1 american 0.802
2 delta 0.781
Subsetting by logical returns the corresponding value where there are TRUE elements
> c(1, 3, 5)[c(FALSE, TRUE, FALSE)]
[1] 3
Related
I've written a function that takes multiple columns as its input that I'd like to apply to a grouped tibble, and I think that something with purrr::map might be the right approach, but I don't understand what the appropriate input is for the various map functions. Here's a dummy example:
myFun <- function(DF){
DF %>% mutate(MyOut = (A * B)) %>% pull(MyOut) %>% sum()
}
MyDF <- data.frame(A = 1:5, B = 6:10)
myFun(MyDF)
This works fine. But what if I want to add some grouping?
MyDF <- data.frame(A = 1:100, B = 1:100, Fruit = rep(c("Apple", "Mango"), each = 50))
MyDF %>% group_by(Fruit) %>% summarize(MyVal = myFun(.))
This doesn't work. I get the same value for every group in my data.frame or tibble. I then tried using something with purrr:
MyDF %>% group_by(Fruit) %>% map(.f = myFun)
Apparently, that's expecting character data as input, so that's not it.
This next variation is basically what I need, but the output is a list of lists rather than a tibble with one row for each value of Fruit:
MyDF %>% group_by(Fruit) %>% group_map(~ myFun(.))
We can use the OP's function in group_modify
library(dplyr)
MyDF %>%
group_by(Fruit) %>%
group_modify(~ .x %>%
summarise(MyVal = myFun(.x))) %>%
ungroup
-output
# A tibble: 2 × 2
Fruit MyVal
<chr> <int>
1 Apple 42925
2 Mango 295425
Or in group_map where the .y is the grouping column
MyDF %>%
group_by(Fruit) %>%
group_map(~ bind_cols(.y, MyVal = myFun(.))) %>%
bind_rows
# A tibble: 2 × 2
Fruit MyVal
<chr> <int>
1 Apple 42925
2 Mango 295425
I am trying filtered data with value having 1 but the dataframe is already labelled . so the objective is to create a summary of filtered dataset
df <- data.frame(NY = c(1,2,1,1,2,1,1,1,2,1,1,1,2,1),
DE = c(2,1,1,1,1,2,2,1,1,1,2,2,2,1) )
df$NY<- factor(df$NY, levels =c(1,2), labels = c("unavailable","available"))
df$DE<- factor(df$DE, levels =c(1,2), labels = c("rejected","recieved"))
output is the frequency of "available" in both column
available/ total frequency in NY and DE for "recieved"
the output should be look like
If output in this format is useful?
library(janitor)
library(tidyverse)
df %>% pivot_longer(everything()) %>%
tabyl(name, value) %>%
adorn_percentages() %>%
adorn_pct_formatting(digits = 2)
#> name available unavailable
#> DE 50.00% 50.00%
#> NY 71.43% 28.57%
In case of revised scenario
df %>% pivot_longer(everything()) %>%
tabyl(value, name) %>%
adorn_percentages('col') %>%
filter(value %in% c('available', 'recieved')) %>%
adorn_totals('row') %>%
adorn_pct_formatting(digits = 2) %>%
tail(1)
value DE NY
Total 50.00% 71.43%
Here's a tidyverse approach to your problem which outputs the percentages as decimal:
library(tidyverse)
df %>% summarise(across(everything(), ~ sum(. == "available")/n()))
Output:
NY DE
1 0.7142857 0.5
You can try map_df() through each column.
df %>%
map_df(
~ (mean(. == "available") * 100) %>%
round() %>%
paste("%")
)
# # A tibble: 1 x 2
# NY DE
# <chr> <chr>
# 1 71 % 50 %
For different desired values, one approach is to create a named vector as below and pass it into a customised function. Note that the output is a character vector but you can change it as necessary.
values <- c(NY = "available",
DE = "received")
get_percent <- function(.data, .values) {
vars <- names(.values)
pct <- sapply(
seq_along(.values),
function(.) round(mean(.data[[ vars[.] ]] == .values[vars[.]]) * 100)
)
pct <- paste0(pct, "%")
names(pct) <- vars
pct
}
res <- get_percent(df, values)
res
# NY DE
# "29%" "43%"
I am trying to refactor my R code (shown below) into Sparklyr R code to work on a spark dataset to get to the final result as shown in Table 1:
Using help from stack overflow post Gather in sparklyr and SparklyR separate one Spark Data Frame column into two columns I was able to reach all the way except last step dealing with Spread.
Need Help:
Implement Spread via SparklyR
Optimize code in any way
Table 1: Final output needed:
var n nmiss
1 Sepal.Length 150 0
2 Sepal.Width 150 0
R code to achieve it:
library(dplyr)
library(tidyr)
library(tibble)
data <- iris
data_tbl <- as_tibble(data)
profile <- data_tbl %>%
select(Sepal.Length,Sepal.Width) %>%
summarize_all(funs(
n = n(), #Count
nmiss=sum(as.numeric(is.na(.))) # MissingCount
)) %>%
gather(variable, value) %>%
separate(variable, c("var", "stat"), sep = "_(?=[^_]*$)") %>%
spread(stat, value)
Spark Code:
sdf_gather <- function(tbl){
all_cols <- colnames(tbl)
lapply(all_cols, function(col_nm){
tbl %>%
select(col_nm) %>%
mutate(key = col_nm) %>%
rename(value = col_nm)
}) %>%
sdf_bind_rows() %>%
select(c('key', 'value'))
}
profile <- data_tbl %>%
select(Sepal.Length,Sepal.Width ) %>%
summarize_all(funs(
n = n(),
nmiss=sum(as.numeric(is.na(.)))
)) %>%
sdf_gather(.) %>%
ft_regex_tokenizer(input_col="key", output_col="KeySplit", pattern="_(?=[^_]*$)") %>%
sdf_separate_column("KeySplit", into=c("var", "stat")) %>%
select(var,stat,value) %>%
sdf_register('profile')
In this specific case (in general where all columns have the same type, although if you're interested only in missing data statistics, this can be further relaxed) you can use much simpler structure than this.
With data defined like this:
df <- copy_to(sc, iris, overwrite = TRUE)
gather the columns (below I assume a function as defined in my answer to Gather in sparklyr)
long <- df %>%
select(Sepal_Length, Sepal_Width) %>%
sdf_gather("key", "value", "Sepal_Length", "Sepal_Width")
and then group and aggregate:
long %>%
group_by(key) %>%
summarise(n = n(), nmiss = sum(as.numeric(is.na(value)), na.rm=TRUE))
with result as:
# Source: spark<?> [?? x 3]
key n nmiss
<chr> <dbl> <dbl>
1 Sepal_Length 150 0
2 Sepal_Width 150 0
Given reduced size of the output it is also fine to collect the result after aggregation
agg <- df %>%
select(Sepal_Length,Sepal_Width) %>%
summarize_all(funs(
n = n(),
nmiss=sum(as.numeric(is.na(.))) # MissingCount
)) %>% collect()
and apply your gather - spread logic on the result:
agg %>%
tidyr::gather(variable, value) %>%
tidyr::separate(variable, c("var", "stat"), sep = "_(?=[^_]*$)") %>%
tidyr::spread(stat, value)
# A tibble: 2 x 3
var n nmiss
<chr> <dbl> <dbl>
1 Sepal_Length 150 0
2 Sepal_Width 150 0
In fact the latter approach should be superior performance-wise in this particular case.
I have a data frame like this:
df <- data.frame(id = c(1,1,1,2,2,3,3,3,3,4,4,4),
torre = c("a","a","b","d","a","q","t","q","g","a","b","c"))
and I would like my code to select for each id the torre that repeats more, or the last torre for the id if there isnt one that repeats more than the other, so ill get a new data frame like this:
df2 <- data.frame(id = c(1,2,3,4), torre = c("a","a","q","c"))
You can use aggregate:
aggregate(torre ~ id, data=df,
FUN=function(x) names(tail(sort(table(factor(x, levels=unique(x)))),1))
)
The full explanation for this function is a bit involved, but most of the job is done by the FUN= parameter. In this case we are making a function that get's the frequency counts for each torre, sorts them in increasing order, then get's the last one with tail(, 1) and takes the name of it. aggregate() function then applies this function separately for each id.
You could do this using the dplyr package: group by id and torre to calculate the number of occurrences of each torre/id combination, then group by id only and select the last occurrence of torre that has the highest in-group frequency.
library(dplyr)
df %>%
group_by(id,torre) %>%
mutate(n=n()) %>%
group_by(id) %>%
filter(n==max(n)) %>%
slice(n()) %>%
select(-n)
id torre
<dbl> <chr>
1 1 a
2 2 a
3 3 q
4 4 c
An approach with the data.table package:
library(data.table)
setDT(df)[, .N, by = .(id, torre)][order(N), .(torre = torre[.N]), by = id]
which gives:
id torre
1: 1 a
2: 2 a
3: 3 q
4: 4 c
And two possible dplyr alternatives:
library(dplyr)
# option 1
df %>%
group_by(id, torre) %>%
mutate(n = n()) %>%
group_by(id) %>%
mutate(f = rank(n, ties.method = "first")) %>%
filter(f == max(f)) %>%
select(-n, -f)
# option 2
df %>%
group_by(id, torre) %>%
mutate(n = n()) %>%
distinct() %>%
arrange(n) %>%
group_by(id) %>%
slice(n()) %>%
select(-n)
Yet another dplyr solution, this time using add_count() instead of mutate():
df %>%
add_count(id, torre) %>%
group_by(id) %>%
filter(n == max(n)) %>%
slice(n()) %>%
select(-n)
# A tibble: 4 x 2
# Groups: id [4]
id torre
<dbl> <fct>
1 1. a
2 2. a
3 3. q
4 4. c
Let the data frame be:
set.seed(123)
df<-data.frame(name=sample(LETTERS,260,replace=TRUE),
hobby=rep(c("outdoor","indoor"),260),chess=rnorm(1:10))
and the condition which I will use to extract from df be:
df_cond<-df %>% group_by(name,hobby) %>%
summarize(count=n()) %>%
mutate(sum.var=sum(count),sum.name=length(name)) %>%
filter(sum.name==2) %>%
mutate(min.var=min(count)) %>%
mutate(use=ifelse(min.var==count,"yes","no")) %>%
filter(grepl("yes",use))
I want to randomly extract the rows from df that correspond to the (name,hobby,count) combination in df_cond along with the rest of df. I am having bit of a trouble combining %in% and sample.Thanks for any clue!
Edit: For example:
head(df_cond)
name hobby count sum.var sum.name min.var use
<fctr> <fctr> <int> <int> <int> <int> <chr>
1 A indoor 2 6 2 2 yes
2 B indoor 8 16 2 8 yes
3 B outdoor 8 16 2 8 yes
4 C outdoor 6 14 2 6 yes
5 D indoor 10 24 2 10 yes
6 E outdoor 8 18 2 8 yes
Using the above data frame, I want to randomly extract 2 rows (=count) with the combination A+indoor(row1) from df,
8 rows with the combination B+indoor (row 2) from df ....and so on.
Combining #denrous and #Jacob answers to get what I need. like so:
m2<-df_cond %>%
mutate(data = map2(name, hobby, function(x, y) {df %>% filter(name == x, hobby == y)})) %>%
ungroup() %>%
select(data) %>%
unnest()
test<-m2 %>%
group_by(name,hobby) %>%
summarize(num.levels=length(unique(hobby))) %>%
ungroup() %>%
group_by(name) %>%
summarize(total_levels=sum(num.levels)) %>%
filter(total_levels>1)
fin<-semi_join(m2,test)
If I understand correctly, you could use purrr to achieve what you want:
df_cond %>%
mutate(data = map2(name, hobby, function(x, y) {filter(df, name == x, hobby == y)})) %>%
mutate(data = map2(data, count, function(x, y) sample_n(x, size = y)))
And if you want the same form as df:
df_cond %>%
mutate(data = map2(name, hobby, function(x, y) {df %>% filter(name == x, hobby == y)})) %>%
mutate(data = map2(data, count, function(x, y) sample_n(x, size = y))) %>%
ungroup() %>%
select(data) %>%
unnest()
Edited based on OP clarification.
There has to better way but I'd use a loop:
library(dplyr)
master_df <- data.frame()
for (i in 1:nrow(df_cond)){
name = as.character(df_cond[i, 1])
hobby = as.character(df_cond[i, 2])
n = as.numeric(df_cond[i, 3])
temp_df <- df %>% filter(name == name, hobby == hobby)
temp_df <- sample_n(temp_df, n)
master_df <- rbind(master_df, temp_df)
}
Not clear if this is exactly what you want, but you may be looking for left_join:
df %>%
left_join(df_cond, by = "name")