Commit 775ff4df authored by Reinhold Kainhofer's avatar Reinhold Kainhofer

Implement a custom version of rbind that allows non-matching columns (filled with NA by default)

parent 947298d2
...@@ -25,6 +25,7 @@ makeQxDataFrame = function(..., YOB = 1972, Period = NA, reference = NULL) { ...@@ -25,6 +25,7 @@ makeQxDataFrame = function(..., YOB = 1972, Period = NA, reference = NULL) {
if (is.null(data)) return(data.frame(x = double(), y = double(), group = character())) if (is.null(data)) return(data.frame(x = double(), y = double(), group = character()))
reference_ages = NULL; reference_ages = NULL;
# browser()
if (missing(Period)) { if (missing(Period)) {
# If reference is given, normalize all probabilities by that table! # If reference is given, normalize all probabilities by that table!
...@@ -35,9 +36,9 @@ makeQxDataFrame = function(..., YOB = 1972, Period = NA, reference = NULL) { ...@@ -35,9 +36,9 @@ makeQxDataFrame = function(..., YOB = 1972, Period = NA, reference = NULL) {
data = lapply(data, function(t) { data = lapply(data, function(t) {
normalize_deathProbabilities( normalize_deathProbabilities(
if (is.data.frame(t@data$dim) || is.list(t@data$dim)) { if (is.data.frame(t@data$dim) || is.list(t@data$dim)) {
cbind(x = ages(t), y = `names<-`(deathProbabilities(t, YOB = YOB), NULL), group = t@name, as.data.frame(t@data$dim)) data.frame(x = ages(t), y = `names<-`(deathProbabilities(t, YOB = YOB), NULL), group = t@name, as.data.frame(t@data$dim))
} else { } else {
cbind(x = ages(t), y = `names<-`(deathProbabilities(t, YOB = YOB), NULL), group = t@name) data.frame(x = ages(t), y = `names<-`(deathProbabilities(t, YOB = YOB), NULL), group = t@name)
}, },
reference = reference, reference = reference,
referenceAges = reference_ages) referenceAges = reference_ages)
...@@ -49,16 +50,19 @@ makeQxDataFrame = function(..., YOB = 1972, Period = NA, reference = NULL) { ...@@ -49,16 +50,19 @@ makeQxDataFrame = function(..., YOB = 1972, Period = NA, reference = NULL) {
} }
data = lapply(data, function(t) { data = lapply(data, function(t) {
normalize_deathProbabilities( normalize_deathProbabilities(
ifelse(is.data.frame(t@data$dim) || is.list(t@data$dim), if (is.data.frame(t@data$dim) || is.list(t@data$dim)) {
cbind(x = ages(t), y = `names<-`(periodDeathProbabilities(t, Period = Period), NULL), group = t@name, as.data.frame(t@data$dim)), data.frame(x = ages(t), y = `names<-`(periodDeathProbabilities(t, Period = Period), NULL), group = t@name, as.data.frame(t@data$dim))
cbind(x = ages(t), y = `names<-`(periodDeathProbabilities(t, Period = Period), NULL), group = t@name) } else {
), data.frame(x = ages(t), y = `names<-`(periodDeathProbabilities(t, Period = Period), NULL), group = t@name)
},
reference = reference, reference = reference,
referenceAges = reference_ages) referenceAges = reference_ages)
}); });
} }
data <- as.data.frame(do.call("rbind", data)) names(data) = NULL
data <- as.data.frame(do.call("rbind.expand", data))
data data
} }
...@@ -85,3 +89,17 @@ normalize_deathProbabilities = function(data, reference = NULL, referenceAges = ...@@ -85,3 +89,17 @@ normalize_deathProbabilities = function(data, reference = NULL, referenceAges =
data data
} }
rbind.expand = function(df1, df2, ..., fill = NA) {
# browser()
if (missing(df2) || is.null(df2))
return(df1)
df2.clmiss = setdiff(colnames(df1), colnames(df2))
df1.clmiss = setdiff(colnames(df2), colnames(df1))
df1[df1.clmiss] = fill
df2[df2.clmiss] = fill
rbind.expand(rbind(df1, df2), ..., fill = fill)
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment