[Qca-commits] r65 - in pkg: . R inst inst/gui inst/gui/www/js inst/staticdocs man src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jan 18 17:51:36 CET 2019
Author: dusadrian
Date: 2019-01-18 17:51:36 +0100 (Fri, 18 Jan 2019)
New Revision: 65
Added:
pkg/src/Makevars
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/Electron.R
pkg/R/XYplot.R
pkg/R/Xplot.R
pkg/R/allExpressions.R
pkg/R/calibrate.R
pkg/R/causalChain.R
pkg/R/combinations.R
pkg/R/compute.R
pkg/R/createMatrix.R
pkg/R/dimnames.R
pkg/R/export.R
pkg/R/factorize.R
pkg/R/findRows.R
pkg/R/findSubsets.R
pkg/R/findSupersets.R
pkg/R/findTh.R
pkg/R/findmin.R
pkg/R/fuzzyand.R
pkg/R/fuzzyor.R
pkg/R/getInfo.R
pkg/R/getLevels.R
pkg/R/getRow.R
pkg/R/getSolution.R
pkg/R/intersection.R
pkg/R/makeChart.R
pkg/R/minimize.R
pkg/R/modelFit.R
pkg/R/negate.R
pkg/R/numeric.R
pkg/R/onAttach.R
pkg/R/panel.R
pkg/R/pof.R
pkg/R/pofind.R
pkg/R/prettyString.R
pkg/R/prettyTable.R
pkg/R/print.R
pkg/R/recode.R
pkg/R/removeRedundants.R
pkg/R/retention.R
pkg/R/rowDominance.R
pkg/R/runGUI.R
pkg/R/solveChart.R
pkg/R/sortExpressions.R
pkg/R/sortMatrix.R
pkg/R/sortVector.R
pkg/R/string.R
pkg/R/superSubset.R
pkg/R/translate.R
pkg/R/truthTable.R
pkg/R/uninstall.R
pkg/R/validateNames.R
pkg/R/verifyQCA.R
pkg/R/writePrimeimp.R
pkg/R/writeSolution.R
pkg/inst/ChangeLog
pkg/inst/gui/server.R
pkg/inst/gui/www/js/maincode.js
pkg/inst/gui/www/js/utils.js
pkg/inst/staticdocs/CV.html
pkg/inst/staticdocs/LegacyDatasets.html
pkg/inst/staticdocs/Lipset.html
pkg/inst/staticdocs/QCA.package.html
pkg/inst/staticdocs/RS.html
pkg/inst/staticdocs/SOPexpression.html
pkg/inst/staticdocs/XYplot.html
pkg/inst/staticdocs/Xplot.html
pkg/inst/staticdocs/calibrate.html
pkg/inst/staticdocs/causalChain.html
pkg/inst/staticdocs/chartFunctions.html
pkg/inst/staticdocs/export.html
pkg/inst/staticdocs/factorize.html
pkg/inst/staticdocs/findRows.html
pkg/inst/staticdocs/findTh.html
pkg/inst/staticdocs/fuzzyops.html
pkg/inst/staticdocs/implicantMatrixFunctions.html
pkg/inst/staticdocs/index.html
pkg/inst/staticdocs/intersection.html
pkg/inst/staticdocs/minimize.html
pkg/inst/staticdocs/modelFit.html
pkg/inst/staticdocs/negate.html
pkg/inst/staticdocs/pof.html
pkg/inst/staticdocs/recode.html
pkg/inst/staticdocs/retention.html
pkg/inst/staticdocs/runGUI.html
pkg/inst/staticdocs/subsetsAndSupersets.html
pkg/inst/staticdocs/truthTable.html
pkg/man/QCA.package.Rd
pkg/man/SOPexpression.Rd
pkg/man/findRows.Rd
pkg/man/intersection.Rd
pkg/man/minimize.Rd
pkg/src/QCA.c
pkg/src/registerDynamicSymbol.c
pkg/src/truthTable.c
Log:
version 3.4
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/DESCRIPTION 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,6 +1,6 @@
Package: QCA
-Version: 3.3-6
-Date: 2018-11-13
+Version: 3.4
+Date: 2019-01-18
Title: Qualitative Comparative Analysis
Authors at R: c(person("Adrian", "Dusa", role = c("aut", "cre", "cph"),
email = "dusa.adrian at unibuc.ro"),
@@ -28,7 +28,7 @@
minimal causal combination that explains a given phenomenon.
License: GPL (>= 2)
NeedsCompilation: yes
-Packaged: 2018-11-13 11:17:55 UTC; dusadrian
+Packaged: 2019-01-18 08:14:27 UTC; dusadrian
Author: Adrian Dusa [aut, cre, cph],
jQuery Foundation [cph] (jQuery library and jQuery UI library),
jQuery contributors [ctb, cph] (jQuery library; authors listed in
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/NAMESPACE 2019-01-18 16:51:36 UTC (rev 65)
@@ -52,6 +52,7 @@
setRownames,
setColnames,
setDimnames,
+ simplify,
solveChart,
sop,
sortExpressions,
Modified: pkg/R/Electron.R
===================================================================
--- pkg/R/Electron.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/Electron.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -24,7 +24,24 @@
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
`GUIcall` <- function(commandlist) {
- ev <- get("invisibleEnvironment", envir = globalenv())
+ QCA_env <- as.environment("package:QCA")
+ if (is.element("invisibleEnvironment", ls(envir = QCA_env))) {
+ ev <- QCA_env$invisibleEnvironment
+ }
+ else {
+ ev <- new.env()
+ ev$firstHistory <- TRUE
+ ev$hashes <- list()
+ ev$visiblecols <- 8
+ ev$visiblerows <- 17
+ if (.Call("C_unlock", QCA_env, PACKAGE = "QCA")) {
+ QCA_env$invisibleEnvironment <- ev
+ }
+ else {
+ cat("\n")
+ stop(simpleError("Cannot unlock QCA environment.\n\n"))
+ }
+ }
nms <- names(commandlist)
result <- c()
`hashobjs` <- function(...) {
@@ -265,7 +282,7 @@
if (length(added) > 0) result <- c(result, infobjs(added))
if (length(modified) > 0) result <- c(result, infobjs(modified))
if (length(deleted) > 0) result <- c(result, jsonify(list(deleted = deleted)))
- savehistory(file = "temphistory")
+ utils::savehistory(file = "temphistory")
history <- readLines("temphistory")
if (ev$firstHistory) {
ev$firstHistory <- FALSE
Modified: pkg/R/XYplot.R
===================================================================
--- pkg/R/XYplot.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/XYplot.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/Xplot.R
===================================================================
--- pkg/R/Xplot.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/Xplot.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/allExpressions.R
===================================================================
--- pkg/R/allExpressions.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/allExpressions.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/calibrate.R
===================================================================
--- pkg/R/calibrate.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/calibrate.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/causalChain.R
===================================================================
--- pkg/R/causalChain.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/causalChain.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/combinations.R
===================================================================
--- pkg/R/combinations.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/combinations.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/compute.R
===================================================================
--- pkg/R/compute.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/compute.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/createMatrix.R
===================================================================
--- pkg/R/createMatrix.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/createMatrix.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/dimnames.R
===================================================================
--- pkg/R/dimnames.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/dimnames.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/export.R
===================================================================
--- pkg/R/export.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/export.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/factorize.R
===================================================================
--- pkg/R/factorize.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/factorize.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -224,7 +224,7 @@
}
}
factorizeit <- function(x, snames, noflevels) {
- x <- sop(x, snames = snames, noflevels = noflevels)
+ x <- simplify(x, snames = snames, noflevels = noflevels)
trexp <- translate(x, snames = snames, noflevels = noflevels)
snames <- colnames(trexp)
getSol(lapply(
Modified: pkg/R/findRows.R
===================================================================
--- pkg/R/findRows.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/findRows.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/findSubsets.R
===================================================================
--- pkg/R/findSubsets.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/findSubsets.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/findSupersets.R
===================================================================
--- pkg/R/findSupersets.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/findSupersets.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/findTh.R
===================================================================
--- pkg/R/findTh.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/findTh.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/findmin.R
===================================================================
--- pkg/R/findmin.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/findmin.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -31,5 +31,5 @@
stop(simpleError("The input should be a logical matrix. See function makeChart()\n\n"))
}
}
- return(.Call("C_findmin", t(matrix(as.logical(chart), nrow = nrow(chart))), PACKAGE = "QCA"))
+ return(.Call("C_findmin", t(matrix(as.logical(chart), nrow = nrow(chart))), FALSE, PACKAGE = "QCA"))
}
Modified: pkg/R/fuzzyand.R
===================================================================
--- pkg/R/fuzzyand.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/fuzzyand.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -52,13 +52,13 @@
}
for (i in seq(length(funargs))) {
tc <- tryCatch(eval.parent(parse(text = funargs[i])), error = function(e) e, warning = function(w) w)
- tc <- capture.output(tc)[1]
+ tc <- capture.output(dim(tc))[1]
if (identical(substring(gsub("[[:space:]]", "", tc), 1, 9), "function(")) {
tc <- simpleError("simpleError")
}
if (grepl("simpleError", tc)) {
tc <- tryCatch(eval.parent(parse(text = toupper(funargs[i]))), error = function(e) e, warning = function(w) w)
- tc <- capture.output(tc)[1]
+ tc <- capture.output(dim(tc))[1]
if (identical(substring(gsub("[[:space:]]", "", tc), 1, 9), "function(")) {
tc <- simpleError("simpleError")
}
Modified: pkg/R/fuzzyor.R
===================================================================
--- pkg/R/fuzzyor.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/fuzzyor.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -52,13 +52,13 @@
}
for (i in seq(length(funargs))) {
tc <- tryCatch(eval.parent(parse(text = funargs[i])), error = function(e) e, warning = function(w) w)
- tc <- capture.output(tc)[1]
+ tc <- capture.output(dim(tc))[1]
if (identical(substring(gsub("[[:space:]]", "", tc), 1, 9), "function(")) {
tc <- simpleError("simpleError")
}
if (grepl("simpleError", tc)) {
tc <- tryCatch(eval.parent(parse(text = toupper(funargs[i]))), error = function(e) e, warning = function(w) w)
- tc <- capture.output(tc)[1]
+ tc <- capture.output(dim(tc))[1]
if (identical(substring(gsub("[[:space:]]", "", tc), 1, 9), "function(")) {
tc <- simpleError("simpleError")
}
Modified: pkg/R/getInfo.R
===================================================================
--- pkg/R/getInfo.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/getInfo.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -30,6 +30,7 @@
if (identical(outcome, "")) {
if (identical(conditions, "")) {
conditions <- colnames(data)
+ outcome <- NULL
}
else {
if (is.null(colnames(data))) {
@@ -49,6 +50,7 @@
conditions <- setdiff(colnames(data), outcome)
}
}
+ data <- data[, c(conditions, outcome)]
dc.code <- unique(unlist(lapply(data, function(x) {
if (is.numeric(x)) {
return(x[x < 0])
Modified: pkg/R/getLevels.R
===================================================================
--- pkg/R/getLevels.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/getLevels.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/getRow.R
===================================================================
--- pkg/R/getRow.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/getRow.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/getSolution.R
===================================================================
--- pkg/R/getSolution.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/getSolution.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/intersection.R
===================================================================
--- pkg/R/intersection.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/intersection.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -92,7 +92,7 @@
}
expressions[i] <- paste(expression, collapse = "")
expressions[i] <- gsub("\\*\\(", "(", expressions[i])
- result[i] <- do.call("sop", c(list(expressions[i]), arglist))
+ result[i] <- do.call("simplify", c(list(expressions[i]), arglist))
}
if (sl) {
for (i in seq(length(expressions))) {
Modified: pkg/R/makeChart.R
===================================================================
--- pkg/R/makeChart.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/makeChart.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -82,12 +82,18 @@
snames <- names(tconfigs[[1]])
}
tprimes <- attr(translate(primes, snames, noflevels), "retlist")
- mtrx <- matrix(FALSE, nrow=length(tprimes), ncol=length(tconfigs))
+ mtrx <- matrix(FALSE, nrow = length(tprimes), ncol = length(tconfigs))
for (i in seq(nrow(mtrx))) {
for (j in seq(ncol(mtrx))) {
- tp <- unlist(tprimes[[i]])
- tc <- unlist(tconfigs[[j]])
- mtrx[i, j] <- all(tp[tp >= 0] == tc[tp >= 0])
+ subset <- TRUE
+ s <- 1
+ while (subset & s <= length(tprimes[[i]])) {
+ if (tprimes[[i]][[s]] >= 0) {
+ subset <- is.element(tprimes[[i]][[s]], tconfigs[[j]][[s]])
+ }
+ s <- s + 1
+ }
+ mtrx[i, j] <- subset
}
}
colnames(mtrx) <- names(tconfigs)
Modified: pkg/R/minimize.R
===================================================================
--- pkg/R/minimize.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/minimize.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -310,7 +310,7 @@
if (sol.cons > 0 & all.sol & sol.depth == 0) {
sol.depth <- 5
}
- expressions <- .Call("C_ccubes", list(
+ expressions <- .Call("C_Cubes", list(
tt = cbind(rbind(pos.matrix, neg.matrix) - 1, rep(c(1, 0), c(nrow(pos.matrix), nrow(neg.matrix)))),
pi.cons = pi.cons, depth = as.integer(c(pi.depth, sol.depth)),
min.pin = min.pin, row.dom = row.dom, all.sol = all.sol, sol.cons = sol.cons,
@@ -557,6 +557,6 @@
return(structure(minimize.list, class = "mqca"))
}
`eqmcc` <- function(...) {
- .Deprecated(msg = "Function eqmcc() is deprecated. Use function minimize() instead.\n")
+ .Deprecated(msg = "Function eqmcc() is deprecated, and has been renamed to minimize()\n")
minimize(...)
}
Modified: pkg/R/modelFit.R
===================================================================
--- pkg/R/modelFit.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/modelFit.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/negate.R
===================================================================
--- pkg/R/negate.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/negate.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -53,7 +53,7 @@
}
mv <- any(grepl("[{|}]", expression))
negateit <- function(x, snames, noflevels) {
- x <- sop(x, snames = snames, noflevels = noflevels)
+ x <- simplify(x, snames = snames, noflevels = noflevels)
trexp <- translate(x, snames = snames, noflevels = noflevels)
snames <- colnames(trexp)
if (missing(noflevels)) {
@@ -75,7 +75,7 @@
return(paste("(", paste(nms, collapse = " + ", sep = ""), ")", sep = ""))
}
}), collapse = "")
- negated <- sop(negated, snames = snames, noflevels = noflevels)
+ negated <- simplify(negated, snames = snames, noflevels = noflevels)
if (use.tilde & !mv) {
trneg <- translate(negated, snames = snames, noflevels = noflevels)
negated <- paste(apply(trneg, 1, function(x) {
Modified: pkg/R/numeric.R
===================================================================
--- pkg/R/numeric.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/numeric.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/onAttach.R
===================================================================
--- pkg/R/onAttach.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/onAttach.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -33,9 +33,4 @@
" uninstall(\"QCApro\")", sep="")
}
packageStartupMessage("\nTo cite this package in publications, please use:\n", msg, "\n")
- invisibleEnvironment <- new.env()
- invisibleEnvironment$firstHistory <- TRUE
- invisibleEnvironment$hashes <- list()
- invisibleEnvironment$visiblecols <- 8
- invisibleEnvironment$visiblerows <- 17
}
Modified: pkg/R/panel.R
===================================================================
--- pkg/R/panel.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/panel.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/pof.R
===================================================================
--- pkg/R/pof.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/pof.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -63,7 +63,7 @@
if (eval.parent(parse(text = sprintf("is.element(\"%s\", ls())", toupper(setms))), n = 1)) {
conds <- toupper(setms)
setms <- eval.parent(parse(text = sprintf("get(\"%s\")", toupper(setms))), n = 1)
- setms <- getLevels(setms) - setms - 1
+ setms <- QCA::getLevels(setms) - setms - 1
condnegated <- TRUE
}
}
@@ -78,7 +78,7 @@
if (hastilde(testit)) {
if (eval.parent(parse(text = sprintf("is.element(\"%s\", ls())", notilde(testit))), n = 1)) {
setms <- eval.parent(parse(text = sprintf("get(\"%s\")", notilde(testit))), n = 1)
- setms <- getLevels(setms) - setms - 1
+ setms <- QCA::getLevels(setms) - setms - 1
condnegated <- TRUE
}
else {
@@ -104,7 +104,7 @@
if (hastilde(testit)) {
if (eval.parent(parse(text = sprintf("is.element(\"%s\", ls())", notilde(testit))), n = 1)) {
outcome <- eval.parent(parse(text = sprintf("get(\"%s\")", notilde(testit))), n = 1)
- outcome <- getLevels(outcome) - outcome - 1
+ outcome <- QCA::getLevels(outcome) - outcome - 1
outnegated <- TRUE
}
else {
@@ -158,7 +158,6 @@
if (is.element("data.frame", class(data))) {
data <- as.data.frame(data)
}
- verify.qca(data)
colnames(data) <- toupper(colnames(data))
for (i in colnames(data)) {
if (!is.numeric(data[, i])) {
@@ -223,7 +222,7 @@
else {
if (is.character(outcome)) {
conditions <- setdiff(conditions, outcome)
- if (!is.element(toupper(notilde(curlyBrackets(outcome, outside=TRUE))), colnames(data))) {
+ if (!is.element(toupper(notilde(curlyBrackets(outcome, outside = TRUE))), colnames(data))) {
cat("\n")
stop(simpleError("The outcome in the expression is not found in the data.\n\n"))
}
@@ -244,7 +243,7 @@
cat("\n")
stop(simpleError("The outcome name should not contain both lower and upper case letters.\n\n"))
}
- data[, toupper(outcome)] <- getLevels(data[, toupper(outcome)]) - data[, toupper(outcome)] - 1
+ data[, toupper(outcome)] <- QCA::getLevels(data[, toupper(outcome)]) - data[, toupper(outcome)] - 1
}
outcome <- toupper(outcome)
}
@@ -255,7 +254,11 @@
}
}
if (is.character(outcome)) {
+ verify.qca(data[, which(colnames(data) == outcome), drop = FALSE])
data2 <- data[, -which(colnames(data) == outcome), drop = FALSE]
+ texp <- translate(expression, data = data2)
+ data2 <- data2[, apply(texp, 2, function(x) any(x >= 0)), drop = FALSE]
+ verify.qca(data2)
setms <- compute(expression, data2, separate = TRUE)
if (is.data.frame(setms)) {
setms$expression <- compute(expression, data2)
@@ -265,6 +268,9 @@
}
}
else {
+ texp <- translate(expression, data = data)
+ data <- data[, apply(texp, 2, function(x) any(x >= 0)), drop = FALSE]
+ verify.qca(data)
setms <- compute(expression, data, separate = TRUE)
if (is.data.frame(setms)) {
setms$expression <- compute(expression, data)
@@ -324,6 +330,7 @@
stop(simpleError("The relationship should be either \"necessity\" or \"sufficiency\".\n\n"))
}
if (!missing(data)) {
+ verify.qca(data)
if (length(outcome) != nrow(data)) {
cat("\n")
stop(simpleError("The outcome's length should be the same as the number of rows in the data.\n\n"))
@@ -473,7 +480,7 @@
}
if (is.null(rownames(setms))) {
use.tilde <- FALSE
- if ("use.tilde" %in% names(other.args)) {
+ if (is.element("use.tilde", names(other.args))) {
use.tilde <- other.args$use.tilde
}
rownames(setms) <- writePrimeimp(setms, mv = any(setms > 2), use.tilde = use.tilde)
@@ -487,7 +494,7 @@
}
}
if (neg.out) {
- outcome <- getLevels(outcome) - outcome - 1
+ outcome <- QCA::getLevels(outcome) - outcome - 1
}
sum.outcome <- sum(outcome)
if (pims) {
@@ -526,7 +533,7 @@
mins <- as.data.frame(mins)
colnames(mins) <- conditions
}
- colnames(mins) <- gsub("[[:space:]|,]", "", colnames(mins))
+ colnames(mins) <- gsub("[[:space:]]", "", colnames(mins))
multivalue <- any(grepl("[{|}]", colnames(mins)))
if (condnegated) {
if (identical(conds, "")) {
Modified: pkg/R/pofind.R
===================================================================
--- pkg/R/pofind.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/pofind.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/prettyString.R
===================================================================
--- pkg/R/prettyString.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/prettyString.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -36,7 +36,7 @@
startpoint <- 1
for (j in seq(2, length(string.vector) + 1)) {
if (j <= length(string.vector)) {
- if (nchar(encodeString(paste(string.vector[seq(startpoint, j - ifelse(separator == ";", 1, 0))], collapse = paste(ifelse(separator == ";", "", " "), separator, " ", sep="")))) >= string.width) {
+ if (nchar(encodeString(paste(string.vector[seq(startpoint, j - ifelse(separator == ";", 1, 0))], collapse = paste(ifelse(separator == ";", "", " "), separator, " ", sep = "")))) >= string.width) {
string <- paste(paste(string, ifelse(separator == ";", "", " "), separator, "\n", sep = ""),
paste(rep(" ", repeat.space), collapse=""),
string.vector[j], sep="")
Modified: pkg/R/prettyTable.R
===================================================================
--- pkg/R/prettyTable.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/prettyTable.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/print.R
===================================================================
--- pkg/R/print.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/print.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/recode.R
===================================================================
--- pkg/R/recode.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/recode.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/removeRedundants.R
===================================================================
--- pkg/R/removeRedundants.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/removeRedundants.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/retention.R
===================================================================
--- pkg/R/retention.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/retention.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/rowDominance.R
===================================================================
--- pkg/R/rowDominance.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/rowDominance.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/runGUI.R
===================================================================
--- pkg/R/runGUI.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/runGUI.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/solveChart.R
===================================================================
--- pkg/R/solveChart.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/solveChart.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -43,7 +43,7 @@
row.numbers <- rowDominance(chart)
chart <- chart[row.numbers, ]
}
- if (findmin(chart) == 0) {
+ if (findmin(chart) == 0) {
cat("\n")
stop(simpleError("The PI chart cannot be solved.\n\n"))
}
Modified: pkg/R/sortExpressions.R
===================================================================
--- pkg/R/sortExpressions.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/sortExpressions.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/sortMatrix.R
===================================================================
--- pkg/R/sortMatrix.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/sortMatrix.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/sortVector.R
===================================================================
--- pkg/R/sortVector.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/sortVector.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
Modified: pkg/R/string.R
===================================================================
--- pkg/R/string.R 2018-11-13 11:19:40 UTC (rev 64)
+++ pkg/R/string.R 2019-01-18 16:51:36 UTC (rev 65)
@@ -1,4 +1,4 @@
-# Copyright (c) 2018, Adrian Dusa
+# Copyright (c) 2019, Adrian Dusa
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -110,7 +110,7 @@
return(y)
}
}
-getName <- function(x) {
+`getName` <- function(x) {
result <- rep("", length(x))
x <- as.vector(gsub("1-", "", gsub("[[:space:]]", "", x)))
for (i in seq(length(x))) {
@@ -189,7 +189,7 @@
big.list <- simplifyList(big.list)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/qca -r 65
More information about the Qca-commits
mailing list