[Qca-commits] r19 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 3 17:48:32 CEST 2014
Author: dusadrian
Date: 2014-07-03 17:48:32 +0200 (Thu, 03 Jul 2014)
New Revision: 19
Modified:
pkg/R/solveChart.R
pkg/R/verifyQCA.R
Log:
Better printing of error messages
Modified: pkg/R/solveChart.R
===================================================================
--- pkg/R/solveChart.R 2014-07-03 12:50:17 UTC (rev 18)
+++ pkg/R/solveChart.R 2014-07-03 15:48:32 UTC (rev 19)
@@ -36,9 +36,10 @@
# Stop if the matrix with all possible combinations of k PIs has over 2GB of memory
if ((mem <- nrow(chart)*choose(nrow(chart), k)*8/1024^3) > 2) {
+ errmessage <- paste(paste("Too much memory needed (", round(mem, 1), " GB) to solve the PI chart using combinations of", sep=""),
+ k, "out of", nrow(chart), "minimised PIs, with the PI chart having", ncol(chart), "columns.\n\n")
cat("\n")
- stop(paste(paste("Too much memory needed (", round(mem, 1), " GB) to solve the PI chart using combinations of", sep=""),
- k, "out of", nrow(chart), "minimised PIs.\n\n"), call. = FALSE)
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
if (!min.dis & k < nrow(chart)) {
@@ -46,7 +47,7 @@
# if (2^nrow(chart)*2 > .Machine$integer.max) {
if (nrow(chart) > 29) { # in order to prevent cases where integer.max is larger than 32-bit
cat("\n")
- stop("The PI chart is too large to identify all models.\n\n", call. = FALSE)
+ stop(paste(strwrap("The PI chart is too large to identify all models.\n\n", exdent = 7), collapse = "\n", sep=""))
}
output <- .Call("allSol", k, chart*1, PACKAGE="QCA")
Modified: pkg/R/verifyQCA.R
===================================================================
--- pkg/R/verifyQCA.R 2014-07-03 12:50:17 UTC (rev 18)
+++ pkg/R/verifyQCA.R 2014-07-03 15:48:32 UTC (rev 19)
@@ -3,38 +3,38 @@
# check if the data has column names
if (is.null(colnames(data))) {
cat("\n")
- stop("Please specify the column names for your data.\n\n", call. = FALSE)
+ stop("Please specify the column names for your data.\n\n")
}
# check the outcome specified by the user
if (nchar(outcome) == 0) {
cat("\n")
- stop("You haven't specified the outcome set.\n\n", call. = FALSE)
+ stop("You haven't specified the outcome set.\n\n")
}
else if (! outcome %in% colnames(data)) {
cat("\n")
- stop("The outcome's name is not correct.\n\n", call. = FALSE)
+ stop("The outcome's name is not correct.\n\n")
}
# subset the data with the conditions specified
if (length(conditions) > 1) {
if (outcome %in% conditions) {
cat("\n")
- stop('Variable "', outcome, '" cannot be both outcome _and_ condition!\n\n', call. = FALSE)
+ stop('Variable "', outcome, '" cannot be both outcome _and_ condition!\n\n')
}
if (!all(conditions %in% names(data))) {
cat("\n")
- stop("The conditions' names are not correct.\n\n", call. = FALSE)
+ stop("The conditions' names are not correct.\n\n")
}
}
else if (nchar(conditions) > 0) {
if (outcome %in% conditions) {
cat("\n")
- stop('Variable "', outcome, '" cannot be both outcome _and_ condition!\n\n', call. = FALSE)
+ stop('Variable "', outcome, '" cannot be both outcome _and_ condition!\n\n')
}
else {
cat("\n")
- stop("Cannot find a solution with only one causal condition.\n\n", call. = FALSE)
+ stop("Cannot find a solution with only one causal condition.\n\n")
}
}
}
@@ -51,25 +51,25 @@
# check if all cases have been included in analysis
if ((expl.0 | incl.0) & (expl.1 | incl.1) & (expl.ctr | incl.ctr) & incl.rem) {
cat("\n")
- stop("You have included all cases in the analysis!\n\n", call. = FALSE)
+ stop("You have included all cases in the analysis!\n\n")
}
# if more than 26 conditions (plus one outcome), we cannot use letters
if (use.letters & ncol(data) > 27) {
cat("\n")
- stop("Cannot use letters. There are more than 26 conditions.\n\n", call. = FALSE)
+ stop("Cannot use letters. There are more than 26 conditions.\n\n")
}
# check if the user specifies something to explain
if (sum(expl.0, expl.1, expl.ctr) == 0 ) {
cat("\n")
- stop("You have not specified what to explain.\n\n", call. = FALSE)
+ stop("You have not specified what to explain.\n\n")
}
# checking for complete data (without missings)
if (any(is.na(data))) {
cat("\n")
- stop("Missing data found; this is not (yet) supported.\n\n", call. = FALSE)
+ stop("Missing data found; this is not (yet) supported.\n\n")
}
}
@@ -79,12 +79,13 @@
if (class(data) != "data.frame") {
cat("\n")
- stop(paste("You have to provide a data frame, the current \"data\" argument contains an object\n",
+ errmessage <- paste("You have to provide a data frame, the current \"data\" argument contains an object\n",
" of class \"", class(data), "\"",
ifelse(class(data) == "sS", ", created by superSubset()", ""),
ifelse(class(data) == "tt", ", created by truthTable()", ""),
ifelse(class(data) == "pof", ", created by pof()", ""),
- ".\n\n", sep=""), call. = FALSE)
+ ".\n\n", sep="")
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
if (is.tt(data)) {
@@ -93,44 +94,44 @@
if (nchar(outcome) == 0) {
cat("\n")
- stop("You haven't specified the outcome set.\n\n", call. = FALSE)
+ stop("You haven't specified the outcome set.\n\n")
}
else if (! outcome %in% colnames(data)) {
cat("\n")
- stop("The outcome's name is not correct.\n\n", call. = FALSE)
+ stop("The outcome's name is not correct.\n\n")
}
# subset the data with the conditions specified
if (length(conditions) > 1) {
if (outcome %in% conditions) {
cat("\n")
- stop('"', outcome, '" cannot be both outcome _and_ condition!\n\n', call. = FALSE)
+ stop('"', outcome, '" cannot be both outcome _and_ condition!\n\n')
}
if (!all(conditions %in% colnames(data))) {
cat("\n")
- stop("The conditions' names are not correct.\n\n", call. = FALSE)
+ stop("The conditions' names are not correct.\n\n")
}
}
else if (nchar(conditions) > 0) {
cat("\n")
- stop("Cannot create a truth table with only one condition.\n\n", call. = FALSE)
+ stop("Cannot create a truth table with only one condition.\n\n")
}
# checking for complete data (without missings)
if (any(is.na(data))) {
cat("\n")
- stop("Missing data found; this is not (yet) supported.\n\n", call. = FALSE)
+ stop("Missing data found; this is not (yet) supported.\n\n")
}
# checking for the two including cut-offs
if (any(c(incl.cut1, incl.cut0) < 0) | any(c(incl.cut1, incl.cut0) > 1)) {
cat("\n")
- stop("The including cut-off(s) should be bound to the interval [0, 1].\n\n", call. = FALSE)
+ stop("The including cut-off(s) should be bound to the interval [0, 1].\n\n")
}
if (incl.cut0 > incl.cut1 & incl.cut0 < 1) {
cat("\n")
- stop("incl.cut0 cannot be greater than incl.cut1.\n\n", call. = FALSE)
+ stop("incl.cut0 cannot be greater than incl.cut1.\n\n")
}
data <- data[, c(conditions, outcome)]
@@ -143,7 +144,8 @@
if (any(data[, conditions] > 1 & data[, conditions] %% 1 > 0)) {
cat("\n")
- stop("Uncalibrated data.\nFuzzy sets should have values bound to the interval [0 , 1] and all other values should be crisp.\n\n", call. = FALSE)
+ errmessage <- "Uncalibrated data.\nFuzzy sets should have values bound to the interval [0 , 1] and all other values should be crisp.\n\n"
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
verify.inf.test(inf.test, data)
@@ -157,29 +159,29 @@
# check if the data has column names
if (is.null(colnames(data))) {
cat("\n")
- stop("Please specify the column names for your data.\n\n", call. = FALSE)
+ stop("Please specify the column names for your data.\n\n")
}
# check the outcome specified by the user
if (nchar(outcome) == 0) {
cat("\n")
- stop("You haven't specified the outcome set.\n\n", call. = FALSE)
+ stop("You haven't specified the outcome set.\n\n")
}
else if (! outcome %in% colnames(data)) {
cat("\n")
- stop("The outcome's name is not correct.\n\n", call. = FALSE)
+ stop("The outcome's name is not correct.\n\n")
}
# check if the user specifies something to explain
if (all(explain == c(""))) {
cat("\n")
- stop("You have not specified what to explain.\n\n", call. = FALSE)
+ stop("You have not specified what to explain.\n\n")
}
# check if the user specifies something to explain
if (!all(explain %in% c(0, 1, "C"))) {
cat("\n")
- stop("You should explain either 0, 1, or \"C\".\n\n", call. = FALSE)
+ stop("You should explain either 0, 1, or \"C\".\n\n")
}
chexplain <- c(0, 1)[which(0:1 %in% explain)]
@@ -188,19 +190,21 @@
if (any(chinclude != chexplain)) {
chinclude <- chinclude[which(chinclude != chexplain)]
cat("\n")
- stop(paste("You cannot include ", chinclude, " since you want to explain ", chexplain, ".\n\n", sep=""), call. = FALSE)
+ errmessage <- paste("You cannot include ", chinclude, " since you want to explain ", chexplain, ".\n\n", sep="")
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
}
# check if explain has both 1 and 0
if (length(chexplain) == 2) {
cat("\n")
- stop("Combination to be explained not allowed.\n\n", call. = FALSE)
+ stop("Combination to be explained not allowed.\n\n")
}
if (!all(include %in% c("?", "0", "1", "C"))) {
cat("\n")
- stop("You can only include one or more of the following: \"?\", \"C\", \"0\" and \"1\".\n\n", call. = FALSE)
+ errmessage <- "You can only include one or more of the following: \"?\", \"C\", \"0\" and \"1\".\n\n"
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
@@ -208,34 +212,34 @@
if (length(conditions) > 1) {
if (outcome %in% conditions) {
cat("\n")
- stop('Variable "', outcome, '" cannot be both outcome _and_ condition!\n\n', call. = FALSE)
+ stop('Variable "', outcome, '" cannot be both outcome _and_ condition!\n\n')
}
if (!all(conditions %in% names(data))) {
cat("\n")
- stop("The conditions' names are not correct.\n\n", call. = FALSE)
+ stop("The conditions' names are not correct.\n\n")
}
}
else if (length(conditions) == 1) {
if (outcome == conditions) {
cat("\n")
- stop('Variable "', outcome, '" cannot be both outcome _and_ condition!\n\n', call. = FALSE)
+ stop('Variable "', outcome, '" cannot be both outcome _and_ condition!\n\n')
}
else {
cat("\n")
- stop("Cannot find a solution with only one causal condition.\n\n", call. = FALSE)
+ stop("Cannot find a solution with only one causal condition.\n\n")
}
}
# if more than 26 conditions (plus one outcome), we cannot use letters
if (use.letters & ncol(data) > 27) {
cat("\n")
- stop("Cannot use letters. There are more than 26 conditions.\n\n", call. = FALSE)
+ stop("Cannot use letters. There are more than 26 conditions.\n\n")
}
# checking for complete data (without missings)
if (any(is.na(data))) {
cat("\n")
- stop("Missing data found; this is not (yet) supported.\n\n", call. = FALSE)
+ stop("Missing data found; this is not (yet) supported.\n\n")
}
}
@@ -273,7 +277,7 @@
if (length(dir.exp) != length(conditions)) {
cat("\n")
- stop("Number of expectations does not match number of conditions.\n\n", call. = FALSE)
+ stop("Number of expectations does not match number of conditions.\n\n")
}
# del is dir.exp.list
@@ -282,11 +286,11 @@
if (!is.null(names(dir.exp))) {
if (length(names(dir.exp)) != length(conditions)) {
cat("\n")
- stop("All directional expectations should have names, or none at all.\n\n", call. = FALSE)
+ stop("All directional expectations should have names, or none at all.\n\n")
}
else if (length(setdiff(names(dir.exp), conditions)) > 0) {
cat("\n")
- stop("Incorect names of the directional expectations.\n\n", call. = FALSE)
+ stop("Incorect names of the directional expectations.\n\n")
}
names(del) <- names(dir.exp)
del <- del[conditions]
@@ -309,7 +313,8 @@
values <- setdiff(values, c("-", "dc"))
if (length(setdiff(values, names(delc[[i]])) > 0)) {
cat("\n")
- stop(paste("Values specified in the directional expectations do not appear in the data, for condition \"", conditions[i], "\".\n\n", sep=""), call. = FALSE)
+ errmessage <- paste("Values specified in the directional expectations do not appear in the data, for condition \"", conditions[i], "\".\n\n", sep="")
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
else {
delc[[i]][as.character(values)] <- 1
@@ -352,14 +357,16 @@
if (length(intersect(outcome, names(data))) < length(outcome)) {
outcome <- setdiff(outcome, names(data))
cat("\n")
- stop(paste("Outcome(s) not present in the data: \"", paste(outcome, collapse="\", \""), "\".\n\n", sep=""), call. = FALSE)
+ errmessage <- paste("Outcome(s) not present in the data: \"", paste(outcome, collapse="\", \""), "\".\n\n", sep="")
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
for (i in seq(length(outcome))) {
if (mvoutcome[i]) {
if (!any(unique(data[, outcome.name[[i]]]) == outcome.value[[i]])) {
cat("\n")
- stop(paste("The value {", outcome.value[[i]], "} does not exist in the outcome \"", outcome.name[[i]], "\".\n\n", sep=""), call. = FALSE)
+ errmessage <- paste("The value {", outcome.value[[i]], "} does not exist in the outcome \"", outcome.name[[i]], "\".\n\n", sep="")
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
}
}
@@ -371,7 +378,8 @@
if (length(intersect(outcome, names(data))) < length(outcome)) {
outcome <- setdiff(outcome, names(data))
cat("\n")
- stop(paste("Outcome(s) not present in the data: \"", paste(outcome, collapse="\", \""), "\".\n\n", sep=""), call. = FALSE)
+ errmessage <- paste("Outcome(s) not present in the data: \"", paste(outcome, collapse="\", \""), "\".\n\n", sep="")
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
fuzzy.outcome <- apply(data[, outcome, drop=FALSE], 2, function(x) any(x %% 1 > 0))
@@ -384,7 +392,8 @@
valents <- unique(data[, i])
if (!all(valents %in% c(0, 1))) {
cat("\n")
- stop(paste("Please specify the value of outcome variable \"", i, "\" to explain.\n\n", sep = ""), call. = FALSE)
+ errmessage <- paste("Please specify the value of outcome variable \"", i, "\" to explain.\n\n", sep = "")
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
}
}
@@ -400,7 +409,8 @@
if (length(setdiff(outcome, conditions)) > 0) {
outcome <- setdiff(outcome, conditions)
cat("\n")
- stop(paste("Outcome(s) not present in the conditions' names: \"", paste(outcome, collapse="\", \""), "\".\n\n", sep=""), call. = FALSE)
+ errmessage <- paste("Outcome(s) not present in the conditions' names: \"", paste(outcome, collapse="\", \""), "\".\n\n", sep="")
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
invisible(return(list(mvoutcome = mvoutcome, outcome = outcome, outcome.value = outcome.value, conditions = conditions)))
@@ -414,13 +424,14 @@
if (all(inf.test != "")) {
if (inf.test[1] != "binom") {
cat("\n")
- stop("For the moment only \"binom\"ial testing for crisp data is allowed.\n\n", call. = FALSE)
+ stop("For the moment only \"binom\"ial testing for crisp data is allowed.\n\n")
}
else {
fuzzy <- apply(data, 2, function(x) any(x %% 1 > 0))
if (any(fuzzy)) {
cat("\n")
- stop("The binomial test only works with crisp data.\n\n", call. = FALSE)
+ errmessage <- "The binomial test only works with crisp data.\n\n"
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
}
@@ -428,7 +439,8 @@
alpha <- as.numeric(inf.test[2])
if (is.na(alpha) | alpha < 0 | alpha > 1) {
cat("\n")
- stop("The second value of inf.test should be a number between 0 and 1.\n\n", call. = FALSE)
+ errmessage <- "The second value of inf.test should be a number between 0 and 1.\n\n"
+ stop(paste(strwrap(errmessage, exdent = 7), collapse = "\n", sep=""))
}
}
}
More information about the Qca-commits
mailing list