[Asrr-commits] r8 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jan 16 13:49:23 CET 2009
Author: wincent
Date: 2009-01-16 13:49:23 +0100 (Fri, 16 Jan 2009)
New Revision: 8
Added:
pkg/ChangeLog
Modified:
pkg/NAMESPACE
pkg/R/QCA.R
pkg/man/fs_truthTable.rd
pkg/man/reduce.rd
Log:
Added: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog (rev 0)
+++ pkg/ChangeLog 2009-01-16 12:49:23 UTC (rev 8)
@@ -0,0 +1,2 @@
+2009-01-16
+ * reduce is generic function now.
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2009-01-15 15:25:13 UTC (rev 7)
+++ pkg/NAMESPACE 2009-01-16 12:49:23 UTC (rev 8)
@@ -14,6 +14,9 @@
S3method(print, QCA)
S3method(print, suffnec)
S3method(print, summary.QCA)
+S3method(print, truthTable)
+S3method(reduce, truthTable)
+S3method(reduce, default)
S3method(summary, QCA)
S3method('[',QCA)
#importFrom(lpSolve, lp)
Modified: pkg/R/QCA.R
===================================================================
--- pkg/R/QCA.R 2009-01-15 15:25:13 UTC (rev 7)
+++ pkg/R/QCA.R 2009-01-16 12:49:23 UTC (rev 8)
@@ -313,6 +313,9 @@
allExpress$Cases[allExpress$OUT!="C"] <- gsub("\\[|\\]","",allExpress$Cases[allExpress$OUT!="C"]) ## mark contr case
}
allExpress
+ ans <- list(truthTable=allExpress,outcome=outcome,conditions=conditions,nlevels=nlevels)
+ class(ans) <- c("truthTable","cs_truthTable")
+ ans
}
@@ -327,7 +330,7 @@
if (any(fulldata<0)|| any(fulldata>1)) stop("Fuzzy set score must in [0,1].")
ncases_cutoff <- ifelse(ncases_cutoff<1,ncases_cutoff*nrow(fulldata),ncases_cutoff)
allExpress <- eval(parse(text=(sprintf("expand.grid(%s)",paste(conditions,"=1:0",sep="",collapse=",")))))
- conditions <- mydata[,conditions]
+ conditionsData <- mydata[,conditions]
getScore <- function(index,data){
Negative <- which(index==0)
@@ -341,7 +344,7 @@
}
}
- score_mat <- apply(allExpress,1,function(x) getScore(x,data=conditions))
+ score_mat <- apply(allExpress,1,function(x) getScore(x,data=conditionsData))
allExpress$NCase<- apply(score_mat,2,function(x) sum(x>membership_cutoff))
allExpress$Consistency <- apply(score_mat,2,function(x,outcome) {sum(pmin(x,outcome))/sum(x)},outcome=mydata[,outcome])
allExpress$OUT <- "?"
@@ -361,9 +364,17 @@
} ## else {
if (!complete) allExpress <- allExpress[allExpress$OUT != "?",,drop=FALSE]
##}
- allExpress
+ allExpress
+ ans <- list(truthTable=allExpress,outcome=outcome,conditions=conditions,nlevels=rep(2,length(conditions)))
+ class(ans) <- c("truthTable","fs_truthTable")
+ ans
}
+print.truthTable <- function(x,...){
+x <- unclass(x)
+print(x$truthTable)
+}
+
pass <- function(mydata,conditions,outcome,NCase=NULL,Cases=NULL,freq1=NULL,freq0=NULL,...) {## may need modification?
dat <- mydata[,conditions,drop=FALSE]
dat$OUT <- mydata[[outcome]]
@@ -371,10 +382,29 @@
if (!is.null(freq0)) dat$freq1 <- mydata[[freq0]]
if (is.null(NCase)) dat$NCases <- 1 else dat$NCase <- mydata[[NCase]]
if (is.null(Cases)) dat$Cases <- rownames(mydata) else dat$Cases <- mydata[[Cases]]
- dat
+ dat <- list(truthTable=dat,outcome=outcome,conditions=conditions)
}
-reduce <- function(mydata,outcome,conditions,
+reduce <- function(mydata,...){
+ UseMethod('reduce')
+}
+
+reduce.truthTable <- function(mydata,
+ explain=c("positive","negative"),
+ remainders=c("exclude","include"),
+ contradictions=c("remainders","positive","negative"),
+ dontcare=c("remainders","positive","negative"),
+ keepTruthTable=TRUE,...){
+ call <- match.call()
+ ans <- reduce.default(mydata=mydata,outcome=mydata$outcome,conditions=mydata$conditions,
+ explain=explain,remainders=remainders,dontcare=dontcare,nlevels=mydata$nlevels,
+ keepTruthTable=keepTruthTable,...)
+ ans$call <- call
+ ans
+}
+
+
+reduce.default <- function(mydata,outcome,conditions,
explain=c("positive","negative"),
remainders=c("exclude","include"),
contradictions=c("remainders","positive","negative"),
@@ -389,9 +419,13 @@
contradictions <- match.arg(contradictions)
remainders <- match.arg(remainders)
dontcare <- match.arg(dontcare)
- preprocess <- match.arg(preprocess)
- dots <- list(...)
- mydata <- do.call(preprocess,c(list(mydata=mydata,nlevels=nlevels,outcome=outcome,conditions=conditions),dots))
+ if (!"truthTable" %in% class(mydata)){
+ preprocess <- match.arg(preprocess)
+ dots <- list(...)
+ mydata <- do.call(preprocess,c(list(mydata=mydata,nlevels=nlevels,outcome=outcome,conditions=conditions),dots))
+ mydata <- mydata$truthTable
+ } else mydata <- mydata$truthTable
+
## if (keepTruthTable) truthTable <- subset(mydata,OUT!="?") else truthTable <- NULL
if (keepTruthTable) {
truthTable <- mydata[mydata[["OUT"]]!="?",] ## subset(mydata,OUT!="?")
Modified: pkg/man/fs_truthTable.rd
===================================================================
--- pkg/man/fs_truthTable.rd 2009-01-15 15:25:13 UTC (rev 7)
+++ pkg/man/fs_truthTable.rd 2009-01-16 12:49:23 UTC (rev 8)
@@ -36,7 +36,7 @@
greater then 0.5), and the consistency of the empirical evidence for
each corner. By specifying the frequency thresholds for fuzzy-set
assessments (the \code{ncases_cutoff} argument), and assessing the
- consistency of fuzzy-set subset relations (the 'consistency_cutoff'
+ consistency of fuzzy-set subset relations (the \code{consistency_cutoff}
argument), we can finally construct a truthTable.
}
\value{
Modified: pkg/man/reduce.rd
===================================================================
--- pkg/man/reduce.rd 2009-01-15 15:25:13 UTC (rev 7)
+++ pkg/man/reduce.rd 2009-01-16 12:49:23 UTC (rev 8)
@@ -1,5 +1,7 @@
\name{reduce}
\alias{reduce}
+\alias{reduce.truthTable}
+\alias{reduce.default}
\alias{print.QCA}
\alias{summary.QCA}
\alias{[.QCA}
@@ -12,7 +14,15 @@
mvQCA, and fsQCA.
}
\usage{
-reduce(mydata, outcome, conditions,
+reduce(mydata,...)
+
+\method{reduce}{truthTable}(mydata, explain = c("positive", "negative"),
+ remainders = c("exclude","include"),
+ contradictions = c("remainders","positive","negative"),
+ dontcare = c("remainders", "positive", "negative"),
+ keepTruthTable = TRUE,...)
+
+\method{reduce}{default}(mydata, outcome, conditions,
explain = c("positive", "negative"),
remainders = c("exclude", "include"),
contradictions = c("remainders","positive", "negative"),
More information about the Asrr-commits
mailing list