Skip to content

misc (possibility to change statistical tests on 2-3-4, cpvs and emergency dates) #33

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
NiccoloSalvini wants to merge 10 commits into
base: main
Choose a base branch
from
Open

misc (possibility to change statistical tests on 2-3-4, cpvs and emergency dates) #33

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
0c6f581
add new countries in schema based on partners
NiccoloSalvini Apr 30, 2023
a463009
add capability to filter cpv other than the ones we consulted with ex…
NiccoloSalvini Apr 30, 2023
b65e16b
updated test wrt overwrite cpvs behavior
NiccoloSalvini Apr 30, 2023
6c7d8c0
misc commit
NiccoloSalvini May 4, 2023
601e829
distrubute tests across indicators
NiccoloSalvini May 6, 2023
156f971
del unnencessary files and docuent "..."
NiccoloSalvini May 6, 2023
fd3ba22
reorganized statistical tests
NiccoloSalvini May 15, 2023
90bcaf2
del further file (do not knwo where it comes)
NiccoloSalvini May 15, 2023
751aa55
add documentation for get_country_id_from_name
NiccoloSalvini May 15, 2023
247e3e5
delete superflous file
NiccoloSalvini May 16, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,10 +6,12 @@ export(compute_fisher)
export(compute_kolmogorov_smirnoff)
export(compute_prop_test)
export(compute_ttest)
export(compute_unpaired_ttest)
export(compute_wilcox)
export(emergency_dates)
export(generate_indicator_schema)
export(get_associated_cpv_from_emergency)
export(get_country_id_from_name)
export(grab_cpv)
export(ind_1)
export(ind_2)
Expand All @@ -20,6 +22,8 @@ export(ind_6)
export(ind_7)
export(ind_8)
export(ind_9)
export(test_set_1)
export(test_set_2)
import(rlang)
importFrom(DescTools,Gini)
importFrom(dplyr,across)
Expand Down
106 changes: 13 additions & 93 deletions R/01-winning-rate-across-crisis.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,77 +1,3 @@
#' compute Fisher-exact test https://en.wikipedia.org/wiki/Fisher%27s_exact_test
#' @description compute fisher test pvalue and estimate in piped expression
#' @keywords internal
#' @export
compute_fisher <- function(a, b, c, d) {
if (any(is.na(list(a, b, c, d)))) {
stop("All inputs must be non-missing")
}

data <- matrix(c(a, b, c, d), ncol = 2)
c(
p_value = round(fisher.test(data, alternative = "greater")$p.value, 3),
estimate = round(fisher.test(data, alternative = "greater")$estimate, 3)
)
}

#' compute Barnard test https://en.wikipedia.org/wiki/Barnard%27s_test
#' @description compute Barnard test pvalue and estimate in piped expression
#' @keywords internal
#' @export
compute_barnard <- function(a, b, c, d, method = "boschloo") {
if (any(is.na(list(a, b, c, d)))) {
stop("All inputs must be non-missing")
}
# only pre
if ((a + b) > 0 & (c + d) == 0) {
1
}
# only post
else if ((a + b) == 0 & (c + d) > 0) {
0
} else {
data <- matrix(c(d, b, c, a), ncol = 2)
out_barn <- DescTools::BarnardTest(data, alternative = "greater", method = "boschloo") %>%
suppressWarnings()
c(
p_value = round(out_barn$p.value, 5),
estimate = round(out_barn$estimate, 3)
)
}
}

#' compute Z-test proportional
#' @description compute Z-test pvalue and estimate in piped expression
#' @keywords internal
#' @export
compute_prop_test <- function(a, b, c, d, correct = FALSE) {
if (any(is.na(list(a, b, c, d)))) {
stop("All inputs must be non-missing")
}

m_1 <- a + b
m_2 <- c + d
p_1 <- b / m_1
p_2 <- d / m_2
diff_p2_p1 <- p_2 - p_1

c(
p_value = stats::prop.test(
x = c(d, b),
n = c(m_2, m_1),
correct = correct,
alternative = "greater"
)$p.value %>% suppressWarnings(),
estimate = stats::prop.test(
x = c(d, b),
n = c(m_2, m_1),
correct = correct,
alternative = "greater"
)$estimate %>% suppressWarnings()
)
}


#' Compute Winning rate across the crisis indicator
#'
#' @description
Expand All @@ -90,6 +16,8 @@ compute_prop_test <- function(a, b, c, d, correct = FALSE) {
#' @param emergency_name emergency name character string for which you wish to calculate the indicator for, e.g. "Coronavirus" "Terremoto Aquila"
#' @param test_type character vector string to identifying the test type you want to apply, available alternatives are c("barnard", "fisher", "z-test")
#' @param stat_unit statistical unit of measurement, aggregation variable, the indicator target
#' @param cpvs a vector of cpv on which contracts are filtered
#' @param ... other parameters for generate_indicator_schema as country_name
#' @return indicator schema as from [generate_indicator_schema()]
#' @examples
#' \dontrun{
Expand Down Expand Up @@ -118,28 +46,19 @@ ind_1 <- function(data,
publication_date,
emergency_name,
stat_unit,
test_type) {
test_type,
cpvs,
...) {
indicator_id <- 1
indicator_name <- "Winning rate across the crisis"
aggregation_type <- quo_squash(enquo(stat_unit))
emergency_scenario <- emergency_dates(emergency_name)
cpvs <- get_associated_cpv_from_emergency(emergency_scenario$em_name)
cpv_col <- grab_cpv(data = data)

test <- function(a, b, c, d, test_type) {
switch(test_type,
"barnard" = {
compute_barnard(a, b, c, d)
},
"fisher" = {
compute_fisher(a, b, c, d)
},
"z-test" = {
compute_prop_test(a, b, c, d)
},
stop(paste0("No handler for ", test_type))
)

emergency_scenario <- emergency_dates(emergency_name)
if (missing(cpvs)) {
cpvs <- get_associated_cpv_from_emergency(emergency_scenario$em_name)
}
cpv_col <- grab_cpv(data = data)

data %>%
dplyr::mutate(
Expand Down Expand Up @@ -173,7 +92,7 @@ ind_1 <- function(data,
dplyr::mutate(
## apply test
tab = paste(n_11, n_12, n_21, n_22, sep = "-"),
test = test(n_11, n_12, n_21, n_22, test_type)[1],
test = test_set_1(n_11, n_12, n_21, n_22, test_type)[1],
# new companies --> at risk
test = dplyr::if_else(m_1 == 0 & n_22 > 0,
true = 0,
Expand All @@ -187,7 +106,8 @@ ind_1 <- function(data,
indicator_value = 1 - test, # 1 - pvalue
aggregation_name = {{ stat_unit }},
aggregation_type = as_string(aggregation_type),
emergency = emergency_scenario
emergency = emergency_scenario,
...
) %>%
return()
}
66 changes: 13 additions & 53 deletions R/02-awd-eco-value-across-crisis.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,34 +1,3 @@
#' compute Wilcoxon-Mann-Whitney test in dplyr https://it.wikipedia.org/wiki/Test_di_Wilcoxon-Mann-Whitney
#' @description compute Wilcoxon-Mann-Whitney test pvalue
#' @keywords internal
#' @export
compute_wilcox <- function(data, var, group, exact = TRUE, alternative = "greater") {
test_res <- data %>%
wilcox.test(var ~ group, data = ., exact = exact, alternative = alternative)
c(
p_value = round(test_res$p.value, 3),
estimate = round(test_res$statistic, 3)
)
}

#' compute Kolmogorov Smirnov test in dplyr https://it.wikipedia.org/wiki/Test_di_Kolmogorov-Smirnov
#' @description compute Kolmogorov Smirnov test pvalue
#' @keywords internal
#' @export
compute_kolmogorov_smirnoff <- function(data, var, group, alternative = "less") {
test_res <- suppressWarnings({
data %>%
ks.test(var ~ group, data = ., alternative = alternative)
})

c(
p_value = round(test_res$p.value, 3),
estimate = round(test_res$statistic, 3)
)
}



#' Compute Awarded economic value across the crisis indicator
#'
#' @description
Expand All @@ -47,7 +16,9 @@ compute_kolmogorov_smirnoff <- function(data, var, group, alternative = "less")
#' @param stat_unit statistical target unit of measurement, aggregation variable, the indicator target
#' @param publication_date the date in which the tender was published
#' @param test_type character vector identifying the type of test you want to execute, alternatives are c("ks", "wilcoxon")
#' @param cpvs a vector of cpv on which contracts are filtered
#' @param emergency_name emergency name character string for which you want to evaluate the indicator, e.g. "Coronavirus" "Terremoto Aquila"
#' @param ... other parameters for generate_indicator_schema as country_name
#' @return indicator schema as from `generate_indicator_schema()` rows determined by aggregation level and `indicator_value` based on statistical test performed in `ind_2`
#' @examples
#' \dontrun{
Expand Down Expand Up @@ -79,34 +50,22 @@ ind_2 <- function(data,
publication_date,
emergency_name,
stat_unit,
test_type) {
test_type,
cpvs,
...) {
indicator_id <- 2
indicator_name <- "Awarded economic value across the crisis"
aggregation_type <- quo_squash(enquo(stat_unit))

emergency_scenario <- emergency_dates(emergency_name)
cpvs <- get_associated_cpv_from_emergency(emergency_scenario$em_name)
cpv_col <- grab_cpv(data = data)


test <- function(data, var, group, test_type) {
# temporary: if two levels in group are not found:
if (length(unique(group)) != 2) {
# print("999")
999
} else {
# print("test")
switch(test_type,
"ks" = {
compute_kolmogorov_smirnoff(data, var, group)
},
"wilcoxon" = {
compute_wilcox(data, var, group)
},
stop(paste0("No handler for ", test_type))
)
}
if (missing(cpvs)) {
cpvs <- get_associated_cpv_from_emergency(emergency_scenario$em_name)
}

cpv_col <- grab_cpv(data = data)

data %>%
dplyr::mutate(
prepost = dplyr::if_else(lubridate::ymd({{ publication_date }}) >= emergency_scenario$em_date,
Expand Down Expand Up @@ -136,7 +95,7 @@ ind_2 <- function(data,
npre > 0 & npost == 0 ~ 1, # not at risk, pvalue=1
npre == 0 & npost > 0 ~ 0, # at risk, pvalue=0
# npre > 0 & npost > 0 ~ test(var = {{ contract_value }}, group = prepost, data = ., test_type)[1],
TRUE ~ test(var = {{ contract_value }}, group = prepost, data = ., test_type)[1]
TRUE ~ test_set_2(var = {{ contract_value }}, group = prepost, data = ., test_type)[1]
)
) %>%
generate_indicator_schema(
Expand All @@ -145,7 +104,8 @@ ind_2 <- function(data,
indicator_value = 1 - test, # 1 - pvalue
aggregation_name = {{ stat_unit }},
aggregation_type = as_string(aggregation_type),
emergency = emergency_scenario
emergency = emergency_scenario,
...
) %>%
return()
}
19 changes: 16 additions & 3 deletions R/03-ec-dev-across-crisis.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,8 +15,11 @@
#' @param award_value The date when the tender was awarded
#' @param sums_paid The amount paid by the C.A.
#' @param stat_unit the statistical unit of measurement (can be a vector of grouping variables), i.e. variable to group by
#' @param cpvs a vector of cpv on which contracts are filtered
#' @param emergency_name emergency name character string for which you want to evaluate the indicator, e.g. "Coronavirus" "Terremoto Aquila"
#' @param test_type test type belonging to set 2 i.e. "ks", "wilcoxon"
#' @param publication_date The date when the tender was published
#' @param ... other parameters for generate_indicator_schema as country_name
#' @return indicator schema as from `generate_indicator_schema`
#' @details DETAILS
#' @examples
Expand All @@ -28,6 +31,7 @@
#' award_value = importo_aggiudicazione,
#' sums_paid = importo_lotto,
#' stat_unit = cf_amministrazione_appaltante,
#' test_type = "wilcoxon",
#' emergency_name = "coronavirus"
#' )
#' }
Expand All @@ -44,14 +48,23 @@ ind_3 <- function(data,
sums_paid,
stat_unit,
emergency_name,
publication_date) {
publication_date,
test_type,
cpvs,
...) {
indicator_id <- 3
indicator_name <- "Economic deviation across the crisis"
aggregation_type <- quo_squash(enquo(stat_unit))
emergency_scenario <- emergency_dates(emergency_name)
cpvs <- get_associated_cpv_from_emergency(emergency_scenario$em_name)
if (missing(cpvs)) {
cpvs <- get_associated_cpv_from_emergency(emergency_scenario$em_name)
}
cpv_col <- grab_cpv(data = data)

if (missing(test_type)) {
test_type <- "wilcoxon"
}

data %>%
dplyr::filter(!is.na({{ award_value }}) &
!is.na({{ sums_paid }}) &
Expand Down Expand Up @@ -80,7 +93,7 @@ ind_3 <- function(data,
mean_post = mean(ratio[prepost == "post"]),
median_pre = median(ratio[prepost == "pre"]),
median_post = median(ratio[prepost == "post"]),
ind_3 = compute_kolmogorov_smirnoff(var = ratio, group = prepost, data = .)[1]
ind_3 = test_set_2(var = ratio, group = prepost, data = ., test_type)[1]
) %>%
generate_indicator_schema(
indicator_id = indicator_id,
Expand Down
21 changes: 17 additions & 4 deletions R/04-len-dev-across-crisis.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,8 +16,11 @@
#' @param eff_end Effective end of the execution of the contract
#' @param eff_start Effective contract signature
#' @param stat_unit the statistical unit of measurement (can be a vector of grouping variables), i.e. variable to group by
#' @param cpvs a vector of cpv on which contracts are filtered
#' @param emergency_name emergency name character string for which you want to evaluate the indicator, e.g. "Coronavirus" "Terremoto Aquila"
#' @param test_type test type belonging to set 2 i.e. "ks", "wilcoxon"
#' @param publication_date The date when the tender was published
#' @param ... other parameters for generate_indicator_schema as country_name
#' @return indicator schema as from `generate_indicator_schema`
#' @details DETAILS
#' @examples
Expand All @@ -30,6 +33,7 @@
#' eff_end = data_effettiva_ultimazione,
#' eff_start = data_stipula_contratto,
#' stat_unit = cf_amministrazione_appaltante,
#' test_type = "wilcoxon",
#' emergency_name = "coronavirus"
#' )
#' }
Expand All @@ -47,14 +51,22 @@ ind_4 <- function(data,
eff_end,
stat_unit,
emergency_name,
publication_date) {
publication_date,
test_type,
cpvs,
...) {
indicator_id <- 4
indicator_name <- "Length deviation across the crisis"
aggregation_type <- quo_squash(enquo(stat_unit))
emergency_scenario <- emergency_dates(emergency_name)
cpvs <- get_associated_cpv_from_emergency(emergency_scenario$em_name)
if (missing(cpvs)) {
cpvs <- get_associated_cpv_from_emergency(emergency_scenario$em_name)
}
cpv_col <- grab_cpv(data = data)

if (missing(test_type)) {
test_type <- "wilcoxon"
}

data %>%
dplyr::filter(
Expand Down Expand Up @@ -87,15 +99,16 @@ ind_4 <- function(data,
mean_post = mean(ratio[prepost == "post"]),
median_pre = median(ratio[prepost == "pre"]),
median_post = median(ratio[prepost == "post"]),
ind_4 = compute_kolmogorov_smirnoff(var = ratio, group = prepost, data = .)[1]
ind_4 = test_set_2(var = ratio, group = prepost, data = ., test_type)[1]
) %>%
generate_indicator_schema(
indicator_id = indicator_id,
indicator_name = indicator_name,
indicator_value = 1 - ind_4, # 1 - pvalue
aggregation_name = {{ stat_unit }},
aggregation_type = as_string(aggregation_type),
emergency = emergency_scenario
emergency = emergency_scenario,
...
) %>%
return()
}
Loading