# ----------------------------------------------------
# Function for assigning new labels to initial strata
# and to report the structure of resulting
# aggregated strata
# Author: Giulio Barcaroli
# Date: 4 January 2012
# Last update: 12 January 2023
# ----------------------------------------------------
updateStrata <- function (strata,
solution,
writeFiles = FALSE,
outputFolder = file.path(getwd(),"output"))
{
if (writeFiles == TRUE) {
# if(dir.exists(outputFolder)){
# warning("Folder ", outputFolder," already existed and has been deleted.")
# unlink(outputFolder)
# }
if(!dir.exists(outputFolder)) dir.create(outputFolder)
}
colnames(strata) <- toupper(colnames(strata))
newstrata <- strata
newstrata$AGGR_STRATUM <- solution[[1]]
ndom <- length(levels(as.factor(strata$DOM1)))
nvarX <- length(grep("X", names(strata)))
matstrata <- NULL
stmt <- "matstrata <- as.data.frame(cbind(newstrata$DOM1,newstrata$AGGR_STRATUM,"
stmt2 <- "colnames(matstrata) <- c('DOM1','AGGR_STRATUM',"
stmt3 <- NULL
if (nvarX > 1) {
for (i in 1:(nvarX - 1)) {
stmt <- paste(stmt, "newstrata$X", i, ",", sep = "")
stmt2 <- paste(stmt2, "'X", i, "',", sep = "")
stmt3 <- paste(stmt3, "matstrata$X", i, ",", sep = "")
}
stmt <- paste(stmt, "newstrata$X", nvarX, "), stringsAsFactors = TRUE)", sep = "")
eval(parse(text = stmt))
stmt2 <- paste(stmt2, "'X", nvarX, "')", sep = "")
eval(parse(text = stmt2))
stmt3 <- paste(stmt3, "matstrata$X", nvarX, sep = "")
statement <- paste("matstrord <- matstrata[order(matstrata$DOM1,matstrata$AGGR_STRATUM,",
stmt3, "),]", sep = "")
eval(parse(text = statement))
}
if (nvarX == 1) {
matstrata <- as.data.frame(cbind(newstrata$DOM1,newstrata$AGGR_STRATUM,newstrata$X1),stringsAsFactors = TRUE)
colnames(matstrata) <- c('DOM1','AGGR_STRATUM','X1')
matstrord <- matstrata[order(matstrata$DOM1, matstrata$AGGR_STRATUM,
matstrata$X1), ]
}
if (nvarX == 1)
newstrata$STRATUM <- newstrata$X1
if (nvarX > 1) {
stmt <- NULL
stmt <- "newstrata$STRATUM <- paste("
for (i in 1:(nvarX - 1)) {
if (i > 0)
stmt <- paste(stmt, "newstrata$X", i, ",", sep = "")
}
stmt <- paste(stmt, "newstrata$X", nvarX, ",sep='*')",
sep = "")
eval(parse(text = stmt))
}
colnames(newstrata)[ncol(newstrata) - 1] <- c("LABEL")
colnames(newstrata) <- toupper(colnames(newstrata))
if (writeFiles == TRUE)
write.table(newstrata, file = file.path(outputFolder,"newstrata.txt"), sep = "\t",
row.names = FALSE, col.names = TRUE, quote = FALSE)
if (writeFiles == TRUE)
write.table(matstrord, file = file.path(outputFolder,"strata_aggregation.txt"),
sep = "\t", row.names = FALSE, col.names = TRUE,
quote = FALSE)
# if (writeFiles == TRUE) {
# setwd(dire)
# }
return(newstrata)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.