Normalising data with dplyr mutate() brings inconsistencies - r

I'm trying to reproduce the framework from this blogpost http://www.luishusier.com/2017/09/28/balance/ with the following code but it looks like I get inconsistent results
library(tidyverse)
library(magrittr)
ids <- c("1617", "1516", "1415", "1314", "1213", "1112", "1011", "0910", "0809", "0708", "0607", "0506")
data <- ids %>%
map(function(i) {read_csv(paste0("http://www.football-data.co.uk/mmz4281/", i ,"/F1.csv")) %>%
select(Date:AST) %>%
mutate(season = i)})
data <- bind_rows(data)
data <- data[complete.cases(data[ , 1:3]), ]
tmp1 <- data %>%
select(season, HomeTeam, FTHG:FTR,HS:AST) %>%
rename(BP = FTHG,
BC = FTAG,
TP = HS,
TC = AS,
TCP = HST,
TCC = AST,
team = HomeTeam)%>%
mutate(Pts = ifelse(FTR == "H", 3, ifelse(FTR == "A", 0, 1)),
Terrain = "Domicile")
tmp2 <- data %>%
select(season, AwayTeam, FTHG:FTR, HS:AST) %>%
rename(BP = FTAG,
BC = FTHG,
TP = AS,
TC = HS,
TCP = AST,
TCC = HST,
team = AwayTeam)%>%
mutate(Pts = ifelse(FTR == "A", 3 ,ifelse(FTR == "H", 0 , 1)),
Terrain = "Extérieur")
tmp3 <- bind_rows(tmp1, tmp2)
l1_0517 <- tmp3 %>%
group_by(season, team)%>%
summarise(j = n(),
pts = sum(Pts),
diff_but = (sum(BP) - sum(BC)),
diff_t_ca = (sum(TCP, na.rm = T) - sum(TCC, na.rm = T)),
diff_t = (sum(TP, na.rm = T) - sum(TC, na.rm = T)),
but_p = sum(BP),
but_c = sum(BC),
tir_ca_p = sum(TCP, na.rm = T),
tir_ca_c = sum(TCC, na.rm = T),
tir_p = sum(TP, na.rm = T),
tir_c = sum(TC, na.rm = T)) %>%
arrange((season), desc(pts), desc(diff_but))
Then I apply the framework mentioned above:
l1_0517 <- l1_0517 %>%
mutate(
# First, see how many goals the team scores relative to the average
norm_attack = but_p %>% divide_by(mean(but_p)) %>%
# Then, transform it into an unconstrained scale
log(),
# First, see how many goals the team concedes relative to the average
norm_defense = but_c %>% divide_by(mean(but_c)) %>%
# Invert it, so a higher defense is better
raise_to_power(-1) %>%
# Then, transform it into an unconstrained scale
log(),
# Now that we have normalized attack and defense ratings, we can compute
# measures of quality and attacking balance
quality = norm_attack + norm_defense,
balance = norm_attack - norm_defense
) %>%
arrange(desc(norm_attack))
When I look at the column norm_attack, I expect to find the same value for equivalent but_p values, which is not the case here:
head(l1_0517, 10)
for instance when but_p has value 83, row 5 and row 7, I get norm_attack at 0.5612738 and 0.5128357 respectively.
Is it normal? I would expect mean(l1_0517$but_p) to be fixed and therefore obtaining the same result when a value of l1_0517$but_p is log normalised?
UPDATE
I have tried to work on a simpler example but I can't reproduce this issue:
df <- tibble(a = as.integer(runif(200, 15, 100)))
df <- df %>%
mutate(norm_a = a %>% divide_by(mean(a)) %>%
log())

I found the solution after looking at the type of l1_0517
It is a grouped_df hence the different results.
The correct code is:
l1_0517 <- tmp3 %>%
group_by(season, team)%>%
summarise(j = n(),
pts = sum(Pts),
diff_but = (sum(BP) - sum(BC)),
diff_t_ca = (sum(TCP, na.rm = T) - sum(TCC, na.rm = T)),
diff_t = (sum(TP, na.rm = T) - sum(TC, na.rm = T)),
but_p = sum(BP),
but_c = sum(BC),
tir_ca_p = sum(TCP, na.rm = T),
tir_ca_c = sum(TCC, na.rm = T),
tir_p = sum(TP, na.rm = T),
tir_c = sum(TC, na.rm = T)) %>%
ungroup() %>%
arrange((season), desc(pts), desc(diff_but))

Related

Using summarize across with multiple functions when there are missing values

If I want to get the mean and sum of all the numeric columns using the mtcars data set, I would use following codes:
group_by(gear) %>%
summarise(across(where(is.numeric), list(mean = mean, sum = sum)))
But if I have missing values in some of the columns, how do I take that into account? Here is a reproducible example:
test.df1 <- data.frame("Year" = sample(2018:2020, 20, replace = TRUE),
"Firm" = head(LETTERS, 5),
"Exporter"= sample(c("Yes", "No"), 20, replace = TRUE),
"Revenue" = sample(100:200, 20, replace = TRUE),
stringsAsFactors = FALSE)
test.df1 <- rbind(test.df1,
data.frame("Year" = c(2018, 2018),
"Firm" = c("Y", "Z"),
"Exporter" = c("Yes", "No"),
"Revenue" = c(NA, NA)))
test.df1 <- test.df1 %>% mutate(Profit = Revenue - sample(20:30, 22, replace = TRUE ))
test.df_summarized <- test.df1 %>% group_by(Firm) %>% summarize(across(where(is.numeric)), list(mean = mean, sum = sum)))
If I would just summarize each variable separately, I could use the following:
test.df1 %>% group_by(Firm) %>% summarize(Revenue_mean = mean(Revenue, na.rm = TRUE,
Profit_mean = mean(Profit, na.rm = TRUE)
But I am trying to figure out how can I tweak the code I wrote above for mtcars to the example data set I have provided here.
Because your functions all have a na.rm argument, you can pass it along with the ...
test.df1 %>% summarize(across(where(is.numeric), list(mean = mean, sum = sum), na.rm = TRUE))
# Year_mean Year_sum Revenue_mean Revenue_sum Profit_mean Profit_sum
# 1 2019.045 44419 162.35 3247 138.25 2765
(I left out the group_by because it's not specified properly in your code and the example is still well-illustrated without it. Also make sure that your functions are inside across().)
Just for the record, you could also do it like this (and this works when the different functions have different arguments)
test.df1 %>%
summarise(across(where(is.numeric),
list(
mean = ~ mean(.x, na.rm = T),
sum = ~ sum(.x, na.rm = T))
)
)
# Year_mean Year_sum Revenue_mean Revenue_sum Profit_mean Profit_sum
# 1 2019.045 44419 144.05 2881 119.3 2386

An error keeps appearing that the sample doesn't work in R Studio cloud and I don't know why

sharp_null_thought_experiment <-
function() {
final_data %>%
mutate(
OUTCOME_Z_0 = rnorm(n(), sd = 0.5007117),
OUTCOME_Z_1 = OUTCOME_Z_0,
Z = sample(rep(c(0, 1), times = c(sum(final_data$treatment_group=="control"), sum(final_data$treatment_group=="treatment"))), size = n()),
OUTCOME = if_else(Z == 0, OUTCOME_Z_0, OUTCOME_Z_1)
) %>%
difference_in_means(OUTCOME ~ Z, data = .) %>%
tidy
}
sampling_distribution_sharp_null <- rerun(1000, sharp_null_thought_experiment()) %>%
bind_rows
sampling_distribution_sharp_null %>%
summarise(mean(estimate>=results$estimate))

Sort the highest values ​by combining data sets

df <- read.csv ('https://raw.githubusercontent.com/ulklc/covid19-
timeseries/master/countryReport/raw/rawReport.csv',
stringsAsFactors = FALSE)
df8 <- read.csv ('https://raw.githubusercontent.com/hirenvadher954/Worldometers-
Scraping/master/countries.csv',
stringsAsFactors = FALSE)
library(tidyverse)
df %>%
left_join(df8, by = c("countryName" = "country_name")) %>%
mutate(population = as.numeric(str_remove_all(population, ","))) %>%
group_by(countryName) %>%
group_by(countryName) %>%
unique() %>%
summarize(population = sum(population, na.rm = TRUE),
confirmed = sum(confirmed, na.rm = TRUE),
recovered = sum(recovered, na.rm = TRUE),
death = sum(death, na.rm = TRUE),
death_prop = paste0(as.character(death), "/", as.character(population)),
confirmed_prop = paste0(as.character(confirmed), "/", as.character(population)),
recovered_prop = paste0(as.character(recovered), "/", as.character(population)),
)
population / death ratio is calculated in this code.
what I want to do is
Finding 10 countries with the highest population / death ratio.
as output;
counrtyName death population rate
İtaly 19000 50000000000 19/50000000
spain 17000 60000000000 17/60000000
....
.....
....
....
....
The examples I have given are not real data.
examples do not reflect reality.

summarise data for multiple variables of a data.frame in r?

I am trying to compute the upper and lower quartile of the two variables in my data.frame across the time period of my interest. The code below gave me single digit for upper and lower value.
set.seed(50)
FakeData <- data.frame(seq(as.Date("2001-01-01"), to= as.Date("2003-12-31"), by="day"),
A = runif(1095, 0,10),
D = runif(1095,5,15))
colnames(FakeData) <- c("Date", "A","D")
statistics <- FakeData %>%
gather(-Date, key = "Variable", value = "Value") %>%
mutate(Year = year(Date), Month = month(Date)) %>%
filter(between(Month,3,5)) %>%
mutate(NewDate = ymd(paste("2020", Month,day(Date), sep = "-"))) %>%
group_by(Variable, NewDate) %>%
summarise(Upper = quantile(Value,0.75, na.rm = T),
Lower = quantile(Value, 0.25, na.rm = T))
I would want an output like below (the Final_output is what i am interested)
Output1 <- data.frame(seq(as.Date("2000-03-01"), to= as.Date("2000-05-31"), by="day"),
Upper = runif(92, 0,10), lower = runif(92,5,15), Variable = rep("A",92))
colnames(Output1)[1] <- "Date"
Output2 <- data.frame(seq(as.Date("2000-03-01"), to= as.Date("2000-05-31"), by="day"),
Upper = runif(92, 2,10), lower = runif(92,5,15), Variable = rep("D",92))
colnames(Output2)[1] <- "Date"
Final_Output<- bind_rows(Output1,Output2)
I can propose you a data.table solution. In fact there are several ways to do that.
The final steps (apply quartile by group on the Value variable) could be translated into (if you want, as in your example, two columns):
statistics[,.('p25' = quantile(get('Value'), probs = 0.25), 'p75' = quantile(get('Value'), probs = 0.75)),
by = c("Variable", "NewDate")]
If you prefer long-formatted output:
library(data.table)
setDT(statistics)
statistics[,.(lapply(get('Value'), quantile, probs = .25,.75)) ,
by = c("Variable", "NewDate")]
All steps together
It's probably better if you chose to use data.table to do all steps using data.table verbs. I will assume your data have the structure similar to the dataframe you generated and arranged, i.e.
statistics <- FakeData %>%
gather(-Date, key = "Variable", value = "Value")
In that case, mutate and filter steps would become
statistics[,`:=`(Year = year(Date), Month = month(Date))]
statistics <- statistics[Month %between% c(3,5)]
statistics[, NewDate = :ymd(paste("2020", Month,day(Date), sep = "-"))]
And choose the final step you prefer, e.g.
statistics[,.('p25' = quantile(get('Value'), probs = 0.25), 'p75' = quantile(get('Value'), probs = 0.75)),
by = c("Variable", "NewDate")]

How to display results from only select subgroups + the whole data frame in an expss table?

Apologies for what is a pretty basic question... I am loving using the expss package for table creation, but am having trouble working through some of the output display. Specifically, I have a situation where my data frame contains a grouping variable as well as a few variables that will be summarized. I'd like to create output that displays certain summary statistics for each value of the subgroup in turn (each value of the grouping variable) plus the total for the whole sample. Something like the code below, but appending the output1 and output2 objects together in a single table that maintains the formatting of expss's RStudio Viewer output.
library(expss)
set.seed(12345)
df <- data.frame(group = rep(1:5, each = 4),
varA = sample(1:4, 20, replace = TRUE),
varB = sample(6:9, 20, replace = TRUE))
output1 <- df[df$group == 1, ] %>%
tab_cells(varA, varB) %>%
tab_cols(total(label = "")) %>%
tab_stat_fun("Valid N" = w_n, "Mean" = w_mean, "SD" = w_sd,
"Median" = w_median, method = list) %>%
tab_pivot() %>%
set_caption("Group 1")
output2 <- df %>%
tab_cells(varA, varB) %>%
tab_cols(total(label = "")) %>%
tab_stat_fun("Valid N" = w_n, "Mean" = w_mean, "SD" = w_sd,
"Median" = w_median, method = list) %>%
tab_pivot() %>%
set_caption("All Groups")
expss_output_viewer()
output1
output2
I know that I can add tab_rows(group) to the piping which will display all of the groups; however, I am only interested in displaying each group in turn (plus the total), not all groups, for output.
There are special function for subgroups: tab_subgroup:
library(expss)
set.seed(12345)
df <- data.frame(group = rep(1:5, each = 4),
varA = sample(1:4, 20, replace = TRUE),
varB = sample(6:9, 20, replace = TRUE))
output <- df %>%
tab_cells(varA, varB) %>%
tab_cols(total(label = "")) %>%
tab_subgroup(group == 1) %>%
tab_row_label("Group 1") %>%
tab_stat_fun("Valid N" = w_n, "Mean" = w_mean, "SD" = w_sd,
"Median" = w_median, method = list) %>%
tab_row_label("All Groups") %>%
tab_subgroup() %>%
tab_stat_fun("Valid N" = w_n, "Mean" = w_mean, "SD" = w_sd,
"Median" = w_median, method = list) %>%
tab_pivot()
expss_output_viewer()
output
Alternatively, you can use tab_rows and net:
library(expss)
set.seed(12345)
df <- data.frame(group = rep(1:5, each = 4),
varA = sample(1:4, 20, replace = TRUE),
varB = sample(6:9, 20, replace = TRUE))
output <- df %>%
tab_cells(varA, varB) %>%
tab_cols(total(label = "")) %>%
tab_rows(net(group, "Group 1" = 1, "All Groups" = 1:5, position = "above")) %>%
tab_stat_fun("Valid N" = w_n, "Mean" = w_mean, "SD" = w_sd,
"Median" = w_median, method = list) %>%
tab_pivot()
expss_output_viewer()
output

Resources