#' @include get_internal_data.R
#' @include get_proportion.R
#' @include get_contribution.R
#' @include get_general_contribution.R
NULL
#' @import data.table
#' @import parallel
#' @import runner
#' @import stats
M_within <- function(data, group, unit, within, by = NULL, contribution.from = NULL, components = FALSE, cores = NULL) {
total <- sum(data[, fw])
contribution <- NULL
if (length(within) > 1) {
w <- 1
n <- 1
list_index_between <- list()
within_tmp <- NULL
vec_p_within <- NULL
comp_within <- NULL
result <- NULL
if (!is.null(by)) {
id_by <- unique(data[, .SD, .SDcols = by])
formated_id_by <- as.data.table(sapply(id_by, function(i) return(gsub(" ", "_", i))))
repeat {
if (w == 1) {
data_tmp_input <- get_internal_data(data = data, vars = c(group, unit, within[w], by))
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(group, unit, by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
index_total <- na.omit(object = DT_general, cols = colnames(DT_general))
if (within[w] %in% group) {
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(within[w], unit, by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(within[w], unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = within[w], unit = unit))
})
DT_general <- do.call(rbind, M_list)
index_between <- na.omit(object = DT_general, cols = colnames(DT_general))
group <- group[!group %in% within[w]]
} else if (within[w] %in% unit) {
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(group, within[w], by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, within[w]))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = within[w]))
})
DT_general <- do.call(rbind, M_list)
index_between <- na.omit(object = DT_general, cols = colnames(DT_general))
unit <- unit[!unit %in% within[w]]
} else stop(paste("Computation requires that", within[w], "belongs to either 'group' or 'unit'."))
DT_p <- get_proportion(data = data_tmp_input, within = within[w], by = by)
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(group, unit, by, within[w]))
data_by <- split(data_tmp, by = c(by, within[w]))
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
comp_within <- na.omit(object = DT_general, cols = colnames(DT_general))$M
DT_within <- cbind(DT_p, within = comp_within)
index_within <- DT_within[, list(M_W = sum(p %*% within)), by = by]
DT_general <- merge(x = index_total, y = index_between, by = by, sort = FALSE)
setnames(x = DT_general, old = c("M.x", "M.y"), new = c("M", paste0("M_B_", within[w])))
DT_general <- merge(x = DT_general, y = index_within, by = by, sort = FALSE)
setnames(x = DT_general, old = "M_W", new = paste0("M_W_", within[w]))
index_between <- DT_general$M_B
list_index_between[[w]] <- index_between
vec_p_within <- get_proportion(data = data, within = within[w], by = by)$p
} else {
data_tmp_input <- get_internal_data(data = data, vars = c(group, unit, within[w], by, within_tmp))
by_original <- by
by <- c(by, within_tmp)
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(group, unit, by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
index_total <- na.omit(object = DT_general, cols = colnames(DT_general))
if (within[w] %in% group) {
data_tmp <- get_internal_data(data = data, vars = c(within[w], unit, by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(within[w], unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = within[w], unit = unit))
})
DT_general <- do.call(rbind, M_list)
index_between <- na.omit(object = DT_general, cols = colnames(DT_general))
group <- group[!group %in% within[w]]
} else if (within[w] %in% unit) {
data_tmp <- get_internal_data(data = data, vars = c(group, within[w], by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, within))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = within[w]))
})
DT_general <- do.call(rbind, M_list)
index_between <- na.omit(object = DT_general, cols = colnames(DT_general))
unit <- unit[!unit %in% within[w]]
} else stop(paste("Computation requires that", within[w], "belongs to either 'group' or 'unit'."))
DT_p <- get_proportion(data = data, within = within[w], by = by)
data_tmp <- get_internal_data(data = data, vars = c(group, unit, by, within[w]))
data_by <- split(data_tmp, by = c(by, within[w]))
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
comp_within <- na.omit(object = DT_general, cols = colnames(DT_general))$M
DT_within <- cbind(DT_p, within = comp_within)
index_within <- DT_within[, list(M_W = sum(p %*% within)), by = by]
DT_general <- merge(x = index_total, y = index_between, by = by, sort = FALSE)
setnames(x = DT_general, old = c("M.x", "M.y"), new = c("M", paste0("M_B_", within[w])))
DT_general <- merge(x = DT_general, y = index_within, by = by, sort = FALSE)
setnames(x = DT_general, old = "M_W", new = paste0("M_W_", within[w]))
index_between <- DT_general$M_B
DT_index_between <- data.table(unique(data[, .SD, .SDcols = by]), p = vec_p_within, M = index_between)
list_index_between[[w]] <- DT_index_between[, list(M_B = sum(p %*% M)), by = by_original]$M_B
vec_p_within <- get_proportion(data = data, within = c(within_tmp, within[w]), by = by_original)$p
if (w == length(within)) {
data_tmp <- get_internal_data(data = data, vars = c(group, unit, by_original, within))
data_by <- split(data_tmp, by = c(by_original, within))
by <- by_original
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
comp_within <- na.omit(object = DT_general, cols = colnames(DT_general))$M
}
}
if (within[w] %in% group) group <- group[!group %in% within[w]]
if (within[w] %in% unit) unit <- unit[!unit %in% within[w]]
within_tmp <- c(within_tmp, within[w])
if (w == length(within)) break
w <- w + 1
}
list_between_names <- c(paste0("M_B_", within[1]), rep("M_W_", length(within)-1))
list_between_end_names <- runner::runner(within[-length(within)], f = paste, collapse = "_")
list_between_names[2:length(list_between_names)] <- paste0(list_between_names[2:length(list_between_names)], list_between_end_names)
index_between <- as.data.table(do.call(cbind, list_index_between))
index_between <- setNames(object = index_between, nm = list_between_names)
DT_p <- get_proportion(data = data, within = within, by = by)
DT_within <- cbind(DT_p, within = comp_within)
index_within <- DT_within[, list(M_W = sum(p %*% within)), by = by]$M_W
DT_index_total <- cbind(index_between, index_within)
index_total <- DT_index_total[, list(M = rowSums(.SD)), .SDcols = names(DT_index_total)]
DT_general <- cbind(id_by, index_total, index_between)
if ("group_vars" %in% contribution.from) contribution <- group
else if ("unit_vars" %in% contribution.from) contribution <- unit
else contribution <- contribution.from
if (!is.null(contribution)) {
if (((isTRUE(contribution %in% group)) & (length(group) < 2)) | (isTRUE(contribution %in% unit)) & (length(unit) < 2))
stop("When using option 'within' alongside option 'contribution.from', there must be more than one variable left in either 'group' or 'unit'. Use only option 'within' in this case.")
within_on_contribution <- within[within %in% contribution]
if (length(within_on_contribution) > 0) stop(paste("Variables in option 'within' cannot be used simultaneously in option 'contribution.from'. Try using either 'group_vars' or 'unit_vars'." ))
if ((length(intersect(contribution, group)) == length(group)) | length(intersect(contribution, unit)) == length(unit)) {
DT_within <- get_contribution(data = data, group = group, unit = unit, within = within, by = by, component = DT_within, contribution = contribution, cores = cores, iterm = TRUE)
DT_general_comp <- get_general_contribution(DT_contribution = DT_within, contribution = contribution, by = by, cores = cores, iterm = TRUE)
} else {
DT_within <- get_contribution(data = data, group = group, unit = unit, within = within, by = by, component = DT_within, contribution = contribution, cores = cores, iterm = FALSE)
DT_general_comp <- get_general_contribution(DT_contribution = DT_within, contribution = contribution, by = by, cores = cores, iterm = FALSE)
}
DT_general <- cbind(DT_general, DT_general_comp)
} else {
DT_general <- cbind(DT_general, M_W = index_within)
setnames(x = DT_general, old = "M_W", new = paste0("M_W_", paste0(within, collapse = "_")))
}
if (isTRUE(components)) {
DT_general <- split(DT_general, by = by)
DT_within <- split(DT_within, by = by)
element <- 1
repeat {
res <- list()
DT_general[[element]] <- DT_general[[element]][, -1:-length(by)]
DT_within[[element]] <- DT_within[[element]][, -1:-length(by)]
res[['Total']] <- DT_general[[element]]
res[['W_Decomposition']] <- DT_within[[element]]
result[[element]] <- res
if (element == length(DT_general)) break
element <- element + 1
}
names_result <- as.data.table(do.call(cbind, Map(paste, names(formated_id_by), formated_id_by, sep = ".")))
names_result <- names_result[, list(list_name = do.call(paste, c(.SD, sep = ".")))]
result <- setNames(object = result, nm = names_result$list_name)
} else {
result <- DT_general
}
result
} else {
repeat {
if (w == 1) {
data_tmp_input <- get_internal_data(data = data, vars = c(group, unit, within[w]))
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(group, unit))
index_total <- as.numeric(M_value(data = data_tmp, group = group, unit = unit))
if (within[w] %in% group) {
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(within[w], unit))
index_between <- as.numeric(M_value(data = data_tmp, group = within[w], unit = unit))
group <- group[!group %in% within[w]]
} else if (within[w] %in% unit) {
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(group, within[w]))
index_between <- as.numeric(M_value(data = data_tmp, group = group, unit = within[w]))
unit <- unit[!unit %in% within[w]]
} else stop(paste("Computation requires that", within[w], "belongs to either 'group' or 'unit'."))
DT_p <- get_proportion(data = data_tmp_input, within = within[w], total = total)
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(group, unit, within[w]))
by <- within[w]
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
DT_general <- na.omit(object = DT_general, cols = colnames(DT_general))
comp_within <- DT_general$M
DT_within <- cbind(DT_p, within = comp_within)
index_within <- sum(DT_within$p %*% DT_within$within)
DT_general <- data.table(M = index_total, M_B = index_between)
setnames(x = DT_general, old = "M_B", new = paste0("M_B_", within[w]))
DT_general <- cbind(DT_general, M_W = index_within)
setnames(x = DT_general, old = "M_W", new = paste0("M_W_", within[w]))
list_index_between[[w]] <- DT_general$M_B
vec_p_within <- get_proportion(data = data, within = within[w], total = total)$p
} else {
data_tmp_input <- get_internal_data(data = data, vars = c(group, unit, within[w], within_tmp))
by <- within_tmp
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(group, unit, by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
index_total <- na.omit(object = DT_general, cols = colnames(DT_general))
if (within[w] %in% group) {
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(within[w], unit, by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(within[w], unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = within[w], unit = unit))
})
DT_general <- do.call(rbind, M_list)
index_between <- na.omit(object = DT_general, cols = colnames(DT_general))
group <- group[!group %in% within[w]]
} else if (within[w] %in% unit) {
data_tmp <- get_internal_data(data = data, vars = c(group, within[w], by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, within[w]))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = within[w]))
})
DT_general <- do.call(rbind, M_list)
index_between <- na.omit(object = DT_general, cols = colnames(DT_general))
unit <- unit[!unit %in% within[w]]
} else stop(paste("Computation requires that", within[w], "belongs to either 'group' or 'unit'."))
DT_p <- get_proportion(data = data_tmp_input, within = within[w], by = by)
data_tmp <- get_internal_data(data = data_tmp_input, vars = c(group, unit, by, within))
by <- c(by, within[w])
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
DT_general <- na.omit(object = DT_general, cols = colnames(DT_general))
comp_within <- DT_general$M
by <- within_tmp
DT_within <- cbind(DT_p, within = comp_within)
index_within <- DT_within[, list(M_W = sum(p %*% within)), by = by]
DT_general <- merge(x = index_total, y = index_between, by = by, sort = FALSE)
setnames(x = DT_general, old = c("M.x", "M.y"), new = c("M", paste0("M_B_", within[w])))
DT_general <- merge(x = DT_general, y = index_within, by = by, sort = FALSE)
setnames(x = DT_general, old = "M_W", new = paste0("M_W_", within[w]))
index_between <- DT_general$M_B
list_index_between[[w]] <- sum(vec_p_within %*% index_between)
vec_p_within <- get_proportion(data = data, within = c(within_tmp, within[w]), total = total)$p
if (w == length(within)) {
data_tmp <- get_internal_data(data = data, vars = c(group, unit, within))
by <- within
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
DT_general <- na.omit(object = DT_general, cols = colnames(DT_general))
comp_within <- DT_general$M
}
}
if (within[w] %in% group) group <- group[!group %in% within[w]]
if (within[w] %in% unit) unit <- unit[!unit %in% within[w]]
within_tmp <- c(within_tmp, within[w])
if (w == length(within)) break
w <- w + 1
}
list_between_names <- c(paste0("M_B_", within[1]), rep("M_W_", length(within)-1))
list_between_end_names <- runner::runner(within[-length(within)], f = paste, collapse = "_")
list_between_names[2:length(list_between_names)] <- paste0(list_between_names[2:length(list_between_names)], list_between_end_names)
index_between_sum <- sum(unlist(list_index_between, use.names = FALSE))
list_index_between <- setNames(object = list_index_between, nm = list_between_names)
DT_p <- get_proportion(data = data, within = within, total = total)
DT_within <- cbind(DT_p, within = comp_within)
index_within <- sum(DT_within$p %*% DT_within$within)
index_total <- index_between_sum + index_within
DT_general <- data.table(M = index_total, rbind(list_index_between))
if ("group_vars" %in% contribution.from) contribution <- group
else if ("unit_vars" %in% contribution.from) contribution <- unit
else contribution <- contribution.from
if (!is.null(contribution)) {
if (((isTRUE(contribution %in% group)) & (length(group) < 2)) | (isTRUE(contribution %in% unit)) & (length(unit) < 2))
stop("When using option 'within' alongside option 'contribution.from', there must be more than one variable left in either 'group' or 'unit'. Use only option 'within' in this case.")
within_on_contribution <- within[within %in% contribution]
if (length(within_on_contribution) > 0) stop(paste("Variables in option 'within' cannot be used simultaneously in option 'contribution.from'. Try using either 'group_vars' or 'unit_vars'." ))
if ((length(intersect(contribution, group)) == length(group)) | length(intersect(contribution, unit)) == length(unit)) {
DT_within <- get_contribution(data = data, group = group, unit = unit, within = within, component = DT_within, contribution = contribution, cores = cores, iterm = TRUE)
DT_general_comp <- get_general_contribution(DT_contribution = DT_within, contribution = contribution, cores = cores, iterm = TRUE)
} else {
DT_within <- get_contribution(data = data, group = group, unit = unit, within = within, component = DT_within, contribution = contribution, cores = cores, iterm = FALSE)
DT_general_comp <- get_general_contribution(DT_contribution = DT_within, contribution = contribution, cores = cores, iterm = FALSE)
}
DT_general <- cbind(DT_general, DT_general_comp)
} else {
DT_general <- cbind(DT_general, M_W = index_within)
setnames(x = DT_general, old = "M_W", new = paste0("M_W_", paste0(within, collapse = "_")))
}
if (isTRUE(components)) {
result <- list(Total = DT_general, W_Decomposition = DT_within)
} else {
result <- DT_general
}
result
}
} else {
if (!is.null(by)) {
result <- NULL
data_tmp <- get_internal_data(data = data, vars = c(group, unit, by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
index_total <- na.omit(object = DT_general, cols = colnames(DT_general))
if (within %in% group) {
data_tmp <- get_internal_data(data = data, vars = c(within, unit, by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(within, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = within, unit = unit))
})
DT_general <- do.call(rbind, M_list)
index_between <- na.omit(object = DT_general, cols = colnames(DT_general))
group <- group[!group %in% within]
} else if (within %in% unit) {
data_tmp <- get_internal_data(data = data, vars = c(group, within, by))
data_by <- split(data_tmp, by = by)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, within))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = within))
})
DT_general <- do.call(rbind, M_list)
index_between <- na.omit(object = DT_general, cols = colnames(DT_general))
unit <- unit[!unit %in% within]
} else stop(paste("Computation requires that", within, "belongs to either 'group' or 'unit'."))
DT_p <- get_proportion(data = data, within = within, by = by)
data_tmp <- get_internal_data(data = data, vars = c(group, unit, by, within))
data_by <- split(data_tmp, by = c(by, within))
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
comp_within <- na.omit(object = DT_general, cols = colnames(DT_general))$M
DT_within <- cbind(DT_p, within = comp_within)
index_within <- DT_within[, list(M_W = sum(p %*% within)), by = by]
DT_general <- merge(x = index_total, y = index_between, by = by, sort = FALSE)
setnames(x = DT_general, old = c("M.x", "M.y"), new = c("M", paste0("M_B_", within)))
if ("group_vars" %in% contribution.from) contribution <- group
else if ("unit_vars" %in% contribution.from) contribution <- unit
else contribution <- contribution.from
if (!is.null(contribution)) {
if (((isTRUE(contribution %in% group)) & (length(group) < 2)) | (isTRUE(contribution %in% unit)) & (length(unit) < 2))
stop("When using option 'within' alongside option 'contribution.from', there must be more than one variable left in either 'group' or 'unit'. Use only option 'within' in this case.")
within_on_contribution <- within[within %in% contribution]
if (length(within_on_contribution) > 0) stop(paste("Variables in option 'within' cannot be used simultaneously in option 'contribution.from'. Try using either 'group_vars' or 'unit_vars'." ))
if ((length(intersect(contribution, group)) == length(group)) | length(intersect(contribution, unit)) == length(unit)) {
DT_within <- get_contribution(data = data, group = group, unit = unit, within = within, by = by, component = DT_within, contribution = contribution, cores = cores, iterm = TRUE)
DT_general_comp <- get_general_contribution(DT_contribution = DT_within, contribution = contribution, by = by, cores = cores, iterm = TRUE)
} else {
DT_within <- get_contribution(data = data, group = group, unit = unit, within = within, by = by, component = DT_within, contribution = contribution, cores = cores, iterm = FALSE)
DT_general_comp <- get_general_contribution(DT_contribution = DT_within, contribution = contribution, by = by, cores = cores, iterm = FALSE)
}
DT_general <- cbind(DT_general, DT_general_comp)
} else {
DT_general <- merge(x = DT_general, y = index_within, by = by, sort = FALSE)
setnames(x = DT_general, old = "M_W", new = paste0("M_W_", within))
}
if (isTRUE(components)) {
DT_general <- split(DT_general, by = by)
DT_within <- split(DT_within, by = by)
element <- 1
repeat {
res <- list()
DT_general[[element]] <- DT_general[[element]][, -1:-length(by)]
DT_within[[element]] <- DT_within[[element]][, -1:-length(by)]
res[['Total']] <- DT_general[[element]]
res[['W_Decomposition']] <- DT_within[[element]]
result[[element]] <- res
if (element == length(DT_general)) break
element <- element + 1
}
id_value <- unique(data[, .SD, .SDcols = by])
formated_id_value <- as.data.table(sapply(id_value, function(i) return(gsub(" ", "_", i))))
names_result <- as.data.table(do.call(cbind, Map(paste, names(formated_id_value), formated_id_value, sep = ".")))
names_result <- names_result[, list(list_name = do.call(paste, c(.SD, sep = ".")))]
result <- setNames(object = result, nm = names_result$list_name)
} else {
result <- DT_general
}
result
} else {
data_tmp <- get_internal_data(data = data, vars = c(group, unit))
index_total <- data.table(M = M_value(data = data_tmp, group = group, unit = unit))$M
if (within %in% group) {
data_tmp <- get_internal_data(data = data, vars = c(within, unit))
index_between <- data.table(M = M_value(data = data_tmp, group = within, unit = unit))$M
group <- group[!group %in% within]
} else if (within %in% unit) {
data_tmp <- get_internal_data(data = data, vars = c(group, within))
index_between <- data.table(M = M_value(data = data_tmp, group = group, unit = within))$M
unit <- unit[!unit %in% within]
} else stop(paste("Computation requires that", within, "belongs to either 'group' or 'unit'."))
DT_p <- get_proportion(data = data, within = within, total = total)
data_tmp <- get_internal_data(data = data, vars = c(group, unit, within))
data_by <- split(data_tmp, by = within)
M_list <- lapply(data_by, function(d) {
data_tmp <- get_internal_data(data = d, vars = c(group, unit))
cbind(unique(d[, ..by]), M = M_value(data = data_tmp, group = group, unit = unit))
})
DT_general <- do.call(rbind, M_list)
comp_within <- na.omit(object = DT_general, cols = colnames(DT_general))$M
DT_within <- cbind(DT_p, within = comp_within)
index_within <- sum(DT_within$p %*% DT_within$within)
DT_general <- data.table(M = index_total, M_B = index_between)
setnames(x = DT_general, old = "M_B", new = paste0("M_B_", within))
if ("group_vars" %in% contribution.from) contribution <- group
else if ("unit_vars" %in% contribution.from) contribution <- unit
else contribution <- contribution.from
if (!is.null(contribution)) {
if (((isTRUE(contribution %in% group)) & (length(group) < 2)) | (isTRUE(contribution %in% unit)) & (length(unit) < 2))
stop("When using option 'within' alongside option 'contribution.from', there must be more than one variable left in either 'group' or 'unit'. Use only option 'within' in this case.")
within_on_contribution <- within[within %in% contribution]
if (length(within_on_contribution) > 0) stop(paste("Variables in option 'within' cannot be used simultaneously in option 'contribution.from'. Try using either 'group_vars' or 'unit_vars'." ))
if ((length(intersect(contribution, group)) == length(group)) | length(intersect(contribution, unit)) == length(unit)) {
DT_within <- get_contribution(data = data, group = group, unit = unit, within = within, component = DT_within, contribution = contribution, cores = cores, iterm = TRUE)
DT_general_comp <- get_general_contribution(DT_contribution = DT_within, contribution = contribution, cores = cores, iterm = TRUE)
} else {
DT_within <- get_contribution(data = data, group = group, unit = unit, within = within, component = DT_within, contribution = contribution, cores = cores, iterm = FALSE)
DT_general_comp <- get_general_contribution(DT_contribution = DT_within, contribution = contribution, cores = cores, iterm = FALSE)
}
DT_general <- cbind(DT_general, DT_general_comp)
} else {
DT_general <- cbind(DT_general, M_W = index_within)
setnames(x = DT_general, old = "M_W", new = paste0("M_W_", within))
}
if (isTRUE(components)) {
result <- list(Total = DT_general, W_Decomposition = DT_within)
} else {
result <- DT_general
}
result
}
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.