[Rqda-commits] r63 - in pkg: . R

[noreply at r-forge.r-project.org]

Author: wincent
Date: 2009-03-17 04:42:46 +0100 (Tue, 17 Mar 2009)
New Revision: 63

Modified:
   pkg/ChangeLog
   pkg/R/AddVarWidget.R
   pkg/R/CaseButton.R
   pkg/R/Variables.R
Log:


Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2009-03-16 17:24:57 UTC (rev 62)
+++ pkg/ChangeLog	2009-03-17 03:42:46 UTC (rev 63)
@@ -1,3 +1,6 @@
+2009-03-17
+	* Variable/Attributes of Case.
+	
 2009-03-16
 	* The default order of codes is alphabetical.
 	* minor bug of "Add" buttons.

Modified: pkg/R/AddVarWidget.R
===================================================================
--- pkg/R/AddVarWidget.R	2009-03-16 17:24:57 UTC (rev 62)
+++ pkg/R/AddVarWidget.R	2009-03-17 03:42:46 UTC (rev 63)
@@ -1,10 +1,10 @@
-AddVarWidget <- function(ExistingItems=NULL,container=NULL,title=NULL,...){
+AddVarWidget <- function(ExistingItems=NULL,container=NULL,title=NULL,ID=NULL){
   ## modified from RGtk2 package
-  ## ExistingItems: existing data set for a case/file etc.
+  ## ExistingItems: existing data set for a case/file etc. It is data frame of 2 columns, the first is Variable
   ## container: similar to that of gWidget package.
   COLUMN <- c(Variable = 0, Value = 1,  editable = 2)
   articles <- NULL
-  
+
   create.model <- function()
     {
       ## create the array of data
@@ -14,6 +14,7 @@
       ## add item from ExistingItems
       ## needs modification
       if (!is.null(ExistingItems)){
+        articles <<- c(articles,unlist(apply(aa,1,function(x) list(list(Variable=x[1],Value=x[2],editable=TRUE))),FALSE))
         for (i in 1:length(articles))
           {
             iter <- model$append()$iter
@@ -90,10 +91,25 @@
       treeview$insertColumnWithAttributes(-1, "Value", renderer, text = COLUMN[["Value"]],editable = COLUMN[["editable"]])
     }
   
-  save.project <- function(button){
+  save.project <- function(button,data){
     ## push dataset into project file.
-    cat("testing.\n")
-  }
+     IterFirst <- data$getIterFirst()
+     cond <- IterFirst[[1]]
+     iter <- IterFirst$iter
+     ans <- c()
+     while(cond) {
+       dat <- unlist(data$get(iter, 0, 1))
+       ans <- c(ans,dat)
+       cond <- data$iterNext(iter)
+     }
+     n <- length(ans)
+     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,ID)
+     dbGetQuery(.rqda$qdacon,sprintf("delete from caseAttr where caseid='%s'",ID))
+     dbWriteTable(.rqda$qdacon, "caseAttr", ans, append = TRUE,row.names=FALSE)
+   }
   
   ## create window, etc
   window <- gtkWindowNew("toplevel", show = F)
@@ -123,7 +139,7 @@
   gSignalConnect(button, "clicked", remove.item, treeview)
   hbox$packStart(button, TRUE, TRUE, 0)
   button <- gtkButtonNewWithLabel("Save")
-  gSignalConnect(button, "clicked",save.project)
+  gSignalConnect(button, "clicked",save.project,model)
   hbox$packStart(button, TRUE, TRUE, 0)
   window$setDefaultSize(150, 350)
   window$showAll()

Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R	2009-03-16 17:24:57 UTC (rev 62)
+++ pkg/R/CaseButton.R	2009-03-17 03:42:46 UTC (rev 63)
@@ -256,8 +256,15 @@
 }
 CaseNamesWidgetMenu$"Add Variables..."$handler <- function(h,...){
   if (is_projOpen(env=.rqda,conName="qdacon")) {
+    if (!dbExistsTable(.rqda$qdacon,"caseAttr")) { ## create a table
+      dbGetQuery(.rqda$qdacon,"create table caseAttr (variable text, value text, caseID integer)")
+    }
+    SelectedCase <- svalue(.rqda$.CasesNamesWidget)
+    caseid <- dbGetQuery(.rqda$qdacon,sprintf("select id from cases where status=1 and name='%s'",SelectedCase))[,1]
     ## get existingItems first
-    AddVarWidget()
+    existingItems <- dbGetQuery(.rqda$qdacon,sprintf("select variable, value from caseAttr where caseid='%s'",caseid))
+    if (nrow(existingItems) == 0) existingItems <- NULL
+    AddVarWidget(ExistingItems=existingItems,title=SelectedCase,ID=caseid)
   }
 }
 CaseNamesWidgetMenu$"Sort by created time"$handler <- function(h,...){

Modified: pkg/R/Variables.R
===================================================================
--- pkg/R/Variables.R	2009-03-16 17:24:57 UTC (rev 62)
+++ pkg/R/Variables.R	2009-03-17 03:42:46 UTC (rev 63)
@@ -1,4 +1,4 @@
-## create a table with caseName, varName, value
+## create a table
 ## query the table
 ## reshape it to wide format
 ## reshape(DF,v.name="value",idvar="caseName",direction="wide",timevar="varName")