[Rqda-commits] r67 - pkg pkg/R www

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Mar 19 11:47:57 CET 2009


Author: wincent
Date: 2009-03-19 11:47:56 +0100 (Thu, 19 Mar 2009)
New Revision: 67

Modified:
   pkg/ChangeLog
   pkg/R/AddVarWidget.R
   pkg/R/CaseButton.R
   pkg/R/FileButton.R
   www/ChangeLog.txt
   www/index.html
Log:
file/case attributes

Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2009-03-18 14:59:03 UTC (rev 66)
+++ pkg/ChangeLog	2009-03-19 10:47:56 UTC (rev 67)
@@ -1,3 +1,6 @@
+2009-03-19
+	* Add/modify File/Case attributes from popup menu.
+	
 2009-03-18
 	* upgrade databaseversion to "0.1.6" (three tables are added for attributes by UpgradeTables()).
 	* Attrs Tab for case/file attributes.

Modified: pkg/R/AddVarWidget.R
===================================================================
--- pkg/R/AddVarWidget.R	2009-03-18 14:59:03 UTC (rev 66)
+++ pkg/R/AddVarWidget.R	2009-03-19 10:47:56 UTC (rev 67)
@@ -230,19 +230,20 @@
   hbox <- gtkHBoxNew(TRUE, 4)
   vbox$packStart(hbox, FALSE, FALSE, 0)
   button <- gtkButtonNewWithLabel("Save and Close")
-  gSignalConnect(button, "clicked",saveFUN,list(model,window,list(...)))
+  gSignalConnect(button, "clicked",saveFUN,list(model,window,ExistingItems,list(...)))
   hbox$packStart(button, TRUE, TRUE, 0)
   window$setDefaultSize(200, 350)
   window$showAll()
   invisible(window)
 }
 
-saveAndClose <- function(button,data){
+saveFUN4CaseAttr <- function(button,data){
   ## the first arg must button, and data as second.
   ## push dataset into project file.
   model <- data[[1]]
   window <- data[[2]]
-  MoreArgs <- data[[3]]
+  ExistingItems <- data[[3]]
+  MoreArgs <- data[[4]]
   IterFirst <- model$getIterFirst()
   cond <- IterFirst[[1]]
   iter <- IterFirst$iter
@@ -256,27 +257,88 @@
   if (n >= 2){
     idx1 <- seq(1,to=n,by=2)
     idx2 <- seq(2,to=n,by=2)
-    ans <- data.frame(Variable=ans[idx1],Value=ans[idx2])
-    ans <- cbind(ans,caseID=MoreArgs$caseId)
+    ans <- data.frame(Variable=ans[idx1],Value=ans[idx2],stringsAsFactors=FALSE)
     ## cal which variable is added and which is modified
+    change_idx <- ans$Value != ExistingItems$value
+    mod_idx <- change_idx & (ExistingItems$value!= "NA")
+    new_idx <- change_idx & (! mod_idx)   
+    if (any(mod_idx)) {
     ## alter the table for the modified variable
+    vars <- ans[mod_idx,]
+    apply(vars,1,FUN=function(x) dbGetQuery(.rqda$qdacon,sprintf("update caseAttr set value == '%s' where variable == '%s'",x[2],x[1])))
+    }
+    if (any(new_idx)){
     ## add the new variable to table
-    print(ans)
-    ## dbWriteTable(.rqda$qdacon, "caseAttr", ans, append = TRUE,row.names=FALSE)
+    vars <- data.frame(variable=ans[new_idx,1],value=ans[new_idx,2],caseID=MoreArgs$caseId,date=date(),dateM=NA,owner=.rqda$owner)
+    dbWriteTable(.rqda$qdacon, "caseAttr", vars, append = TRUE,row.names=FALSE)
+    }
   }
   window$Destroy()## close
 }
 
 CaseAttrFun <- function(caseId,title=NULL){
-  attrs <-  dbGetQuery(.rqda$qdacon,"select name from attributes where status==1")[[1]]
-  if (length(attrs)==0) gmessage("add attribute in Attrs Tabe first.",con=T) else{
-    attrs2 <- data.frame(variable=attrs,value=NA)
+  attrs <-  dbGetQuery(.rqda$qdacon,"select name from attributes where status==1")$name
+  if (is.null(attrs)) gmessage("add attribute in Attrs Tabe first.",con=T) else{
+    attrs2 <- data.frame(variable=attrs,value="NA",stringsAsFactors=FALSE)
     variables <- dbGetQuery(.rqda$qdacon,sprintf("select variable, value from caseAttr where caseID==%i",caseId))
     if (nrow(variables)!=0){
       idx <- attrs2[[1]] %in% variables[[1]]
       attrs2[idx,] <- variables
     }
-    EditVarWidget(ExistingItems=attrs2,saveFUN="saveAndClose",title=title,caseId=caseId)
+    EditVarWidget(ExistingItems=attrs2,saveFUN="saveFUN4CaseAttr",title=title,caseId=caseId)
     ## get attrs list and turn it to a data frame, pass it to ExistingItems, then call EditVarWidget
   }
 }
+
+saveFUN4FileAttr <- function(button,data){
+  ## the first arg must button, and data as second.
+  ## push dataset into project file.
+  model <- data[[1]]
+  window <- data[[2]]
+  ExistingItems <- data[[3]]
+  MoreArgs <- data[[4]]
+  IterFirst <- model$getIterFirst()
+  cond <- IterFirst[[1]]
+  iter <- IterFirst$iter
+  ans <- c()
+  while(cond) {
+    dat <- unlist(model$get(iter, 0, 1))
+    ans <- c(ans,dat)
+    cond <- model$iterNext(iter)
+  }
+  n <- length(ans)
+  if (n >= 2){
+    idx1 <- seq(1,to=n,by=2)
+    idx2 <- seq(2,to=n,by=2)
+    ans <- data.frame(Variable=ans[idx1],Value=ans[idx2],stringsAsFactors=FALSE)
+    ## cal which variable is added and which is modified
+    change_idx <- ans$Value != ExistingItems$value
+    mod_idx <- change_idx & (ExistingItems$value!= "NA")
+    new_idx <- change_idx & (! mod_idx)   
+    if (any(mod_idx)) {
+    ## alter the table for the modified variable
+    vars <- ans[mod_idx,]
+    apply(vars,1,FUN=function(x) dbGetQuery(.rqda$qdacon,sprintf("update fileAttr set value == '%s' where variable == '%s'",x[2],x[1])))
+    }
+    if (any(new_idx)){
+    ## add the new variable to table
+    vars <- data.frame(variable=ans[new_idx,1],value=ans[new_idx,2],fileID=MoreArgs$fileId,date=date(),dateM=NA,owner=.rqda$owner)
+    dbWriteTable(.rqda$qdacon, "fileAttr", vars, append = TRUE,row.names=FALSE)
+    }
+  }
+  window$Destroy()## close
+}
+
+FileAttrFun <- function(fileId,title=NULL){
+  attrs <-  dbGetQuery(.rqda$qdacon,"select name from attributes where status==1")$name
+  if (is.null(attrs)) gmessage("add attribute in Attrs Tabe first.",con=T) else{
+    attrs2 <- data.frame(variable=attrs,value="NA",stringsAsFactors=FALSE)
+    variables <- dbGetQuery(.rqda$qdacon,sprintf("select variable, value from fileAttr where fileID==%i",fileId))
+    if (nrow(variables)!=0){
+      idx <- attrs2[[1]] %in% variables[[1]]
+      attrs2[idx,] <- variables
+    }
+    EditVarWidget(ExistingItems=attrs2,saveFUN="saveFUN4FileAttr",title=title,fileId=fileId)
+    ## get attrs list and turn it to a data frame, pass it to ExistingItems, then call EditVarWidget
+  }
+}

Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R	2009-03-18 14:59:03 UTC (rev 66)
+++ pkg/R/CaseButton.R	2009-03-19 10:47:56 UTC (rev 67)
@@ -257,7 +257,7 @@
     ## see CodeCatButton.R  for definition of MemoWidget
   }
 }
-CaseNamesWidgetMenu$"Add Variables..."$handler <- function(h,...){
+CaseNamesWidgetMenu$"Add/modify Variables..."$handler <- function(h,...){
   if (is_projOpen(env=.rqda,conName="qdacon")) {
     SelectedCase <- svalue(.rqda$.CasesNamesWidget)
     if (length(SelectedCase!=0)){

Modified: pkg/R/FileButton.R
===================================================================
--- pkg/R/FileButton.R	2009-03-18 14:59:03 UTC (rev 66)
+++ pkg/R/FileButton.R	2009-03-19 10:47:56 UTC (rev 67)
@@ -203,6 +203,14 @@
       UpdateFileofCatWidget()
     }
   }
+FileNamesWidgetMenu$"Add/modify Variables..."$handler <- function(h,...){
+  if (is_projOpen(env=.rqda,conName="qdacon")) {
+    Selected <- svalue(.rqda$.fnames_rqda)
+    if (length(Selected !=0 )){
+    fileId <- dbGetQuery(.rqda$qdacon,sprintf("select id from source where status=1 and name='%s'",Selected))[,1]
+    FileAttrFun(fileId=fileId,title=Selected)
+  }
+}}
 FileNamesWidgetMenu$"File Memo"$handler <- function(h,...){
  if (is_projOpen(env=.rqda,conName="qdacon")) {
  MemoWidget("File",.rqda$.fnames_rqda,"source")
@@ -256,3 +264,4 @@
     } else gmessage("No file is found.",con=TRUE)
     }
   }
+

Modified: www/ChangeLog.txt
===================================================================
--- www/ChangeLog.txt	2009-03-18 14:59:03 UTC (rev 66)
+++ www/ChangeLog.txt	2009-03-19 10:47:56 UTC (rev 67)
@@ -1,5 +1,29 @@
+2009-03-19
+	* Add/modify File/Case attributes from popup menu.
+	
+2009-03-18
+	* upgrade databaseversion to "0.1.6" (three tables are added for attributes by UpgradeTables()).
+	* Attrs Tab for case/file attributes.
+	* fix some minor bugs.
+
+2009-03-17
+	* Variable/Attributes of Case.
+	* Improvement of mark case button.
+	* The default order of case is alphabetical,that is sort(case).
+	
+2009-03-16
+	* The default order of codes is alphabetical.
+	* minor bug of "Add" buttons.
+	* minor modification of OpenProjectButton() to make it more informative.
+
+2009-03-12
+	* Fix minor bug of "Search File..." of popup menu in File Tab.
+
 2009-03-11
-      * New function of AddNewFileFun, add to popup menu of file Tab.
+	* New function of AddNewFileFun, Add new file from popup menu of file Tab.
+	* Fix minor bug of enc().
+	* Show files with/without memo only (from popup menu of file tab).
+	* Show codes with/without memo only (from popup menu of code tab).
 
 2009-01-14
 	* Add citation file.
@@ -8,7 +32,7 @@
 	* Add namespace
 	* RQDA-internal.rd is no loner needed (can be found in rev 57 or version 0.1-6)
 	
-2008-12-28
+2008-12-28 (as 0.1.6, submitted to CRAN)
 	* RQDA needs gWidgets (>= 0.0-31), gWidgetsRGtk2 (>= 0.0-36). Add it to DESCRIPTION file.
 	
 2008-12-24

Modified: www/index.html
===================================================================
--- www/index.html	2009-03-18 14:59:03 UTC (rev 66)
+++ www/index.html	2009-03-19 10:47:56 UTC (rev 67)
@@ -39,7 +39,7 @@
 <li>Facilitator helps to categorize codes,which is key to theory building. I deliberately avoid using tree-like categorization
 <li>Facilitator helps to categorize files
 <li>Search files by keywords
-<li>There is a case category, which is crucial feature to bridge qualitative and quantitative research
+<li>There is a case category and related attributes of cases, which is crucial feature to bridge qualitative and quantitative research
 <li>Search information about selected case from the Internet vis popup menu
 <li>Temporary delete files and codes
 <li> Rename the files,code, code category, case and others



More information about the Rqda-commits mailing list