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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Mar 21 07:07:18 CET 2009


Author: wincent
Date: 2009-03-21 07:07:18 +0100 (Sat, 21 Mar 2009)
New Revision: 70

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


Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2009-03-20 04:34:58 UTC (rev 69)
+++ pkg/ChangeLog	2009-03-21 06:07:18 UTC (rev 70)
@@ -1,5 +1,12 @@
+2009-03-21
+	* Another critical bugfix of CaseAttrFun() and FileAttrFun().
+	* View variables of case/file.
+	* change version number to 0.1-7.
+	
 2009-03-20
 	* Find a word and highlight it in the open file (via popup menu in File Tab).
+	* critical bugfix of CaseAttrFun() and FileAttrFun().
+	* fix bug of "add files..." to case popup menu.
 
 2009-03-19
 	* Add/modify File/Case attributes from popup menu.

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2009-03-20 04:34:58 UTC (rev 69)
+++ pkg/DESCRIPTION	2009-03-21 06:07:18 UTC (rev 70)
@@ -1,8 +1,8 @@
 Package: RQDA
 Type: Package
 Title: R-based Qualitative Data Analysis
-Version: 0.1-6
-Date: 2008-12-26
+Version: 0.1-7
+Date: 2009-03-21
 Author: HUANG Ronggui
 Maintainer: HUANG Ronggui <ronggui.huang at gmail.com>
 Depends: R (>= 2.5.0), DBI, RSQLite, gWidgets (>= 0.0-31), gWidgetsRGtk2 (>= 0.0-36)

Modified: pkg/R/AddVarWidget.R
===================================================================
--- pkg/R/AddVarWidget.R	2009-03-20 04:34:58 UTC (rev 69)
+++ pkg/R/AddVarWidget.R	2009-03-21 06:07:18 UTC (rev 70)
@@ -265,7 +265,7 @@
     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])))
+    apply(vars,1,FUN=function(x) dbGetQuery(.rqda$qdacon,sprintf("update caseAttr set value == '%s' where variable == '%s' and caseID=='%s'",x[2],x[1],MoreArgs$caseId)))
     }
     if (any(new_idx)){
     ## add the new variable to table
@@ -282,7 +282,7 @@
     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]]
+      idx <- match(variables[[1]],attrs2[[1]])
       attrs2[idx,] <- variables
     }
     EditVarWidget(ExistingItems=attrs2,saveFUN="saveFUN4CaseAttr",title=title,caseId=caseId)
@@ -318,7 +318,7 @@
     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])))
+    apply(vars,1,FUN=function(x) dbGetQuery(.rqda$qdacon,sprintf("update fileAttr set value == '%s' where variable == '%s' and fileID=='%s'",x[2],x[1],MoreArgs$fileId)))
     }
     if (any(new_idx)){
     ## add the new variable to table
@@ -335,7 +335,7 @@
     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]]
+      idx <- match(variables[[1]],attrs2[[1]])
       attrs2[idx,] <- variables
     }
     EditVarWidget(ExistingItems=attrs2,saveFUN="saveFUN4FileAttr",title=title,fileId=fileId)

Modified: pkg/R/CaseButton.R
===================================================================
--- pkg/R/CaseButton.R	2009-03-20 04:34:58 UTC (rev 69)
+++ pkg/R/CaseButton.R	2009-03-21 06:07:18 UTC (rev 70)
@@ -241,10 +241,10 @@
     ## The value of them depends on where they evaluated, should not placed inside RunOnSelected()
     RunOnSelected(fileoutofcase[['name']],multiple=TRUE,enclos=CurrentFrame,expr={
       if (length(Selected)> 0) {
-        Selected <- iconv(Selected,to="UTF-8")
+        Encoding(Selected) <- "UTF-8"
         fid <- fileoutofcase[fileoutofcase$name %in% Selected,"id"]
         selend <- nchar(fileoutofcase[fileoutofcase$name %in% Selected,"file"])
-        Dat <- data.frame(caseid=caseid,fid=fid,selfirst=0,selend,status=1,owner=.rqda$owner,date=date(),memo="")
+        Dat <- data.frame(caseid=caseid,fid=fid,selfirst=0,selend,status=1,owner=.rqda$owner,date=date(),memo=NA)
         dbWriteTable(.rqda$qdacon,"caselinkage",Dat,row.names=FALSE,append=TRUE)
         UpdateFileofCaseWidget()
       }})
@@ -265,6 +265,11 @@
     CaseAttrFun(caseId=caseid,title=SelectedCase)
   }
 }}
+CaseNamesWidgetMenu$"View Variables"$handler <- function(h,...){
+  if (is_projOpen(env=.rqda,conName="qdacon")) {
+   viewCaseAttr()
+  }
+}
 CaseNamesWidgetMenu$"Sort by created time"$handler <- function(h,...){
 CaseNamesUpdate(.rqda$.CasesNamesWidget)
 }

Modified: pkg/R/FileButton.R
===================================================================
--- pkg/R/FileButton.R	2009-03-20 04:34:58 UTC (rev 69)
+++ pkg/R/FileButton.R	2009-03-21 06:07:18 UTC (rev 70)
@@ -160,7 +160,7 @@
     gbutton("Save To Project",con=get(".AddNewFileWidget2",env=.rqda),handler=function(h,...){
       ## require a title for the file
       Ftitle <- ginput("Enter the title", icon="info")
-      if (Ftitle!="") {Encoding(Ftitle) <- "UTF-8"}
+      if (!is.na(Ftitle)) {Encoding(Ftitle) <- "UTF-8"}
       if (nrow(dbGetQuery(.rqda$qdacon,sprintf("select name from source where name=='%s'",Ftitle)))!=0) {
         Ftitle <- paste("New",Ftitle)
       }## Make sure it is unique
@@ -211,6 +211,11 @@
     FileAttrFun(fileId=fileId,title=Selected)
   }
 }}
+FileNamesWidgetMenu$"View Variables"$handler <- function(h,...){
+  if (is_projOpen(env=.rqda,conName="qdacon")) {
+   viewFileAttr()
+  }
+}
 FileNamesWidgetMenu$"File Memo"$handler <- function(h,...){
  if (is_projOpen(env=.rqda,conName="qdacon")) {
  MemoWidget("File",.rqda$.fnames_rqda,"source")

Modified: pkg/R/Variables.R
===================================================================
--- pkg/R/Variables.R	2009-03-20 04:34:58 UTC (rev 69)
+++ pkg/R/Variables.R	2009-03-21 06:07:18 UTC (rev 70)
@@ -1,11 +1,3 @@
-## create a table
-## query the table
-## reshape it to wide format
-## reshape(DF,v.name="value",idvar="caseName",direction="wide",timevar="varName")
-## use AddVarWidget to add/change values
-## use gdf to view and change the value
-
-
 UpgradeTables <- function(){
   Fields <- dbListFields(.rqda$qdacon,"project")
   if (!"databaseversion" %in% Fields) {
@@ -109,3 +101,29 @@
   }
           )
 }
+
+viewCaseAttr <- function(){
+DF <- dbGetQuery(.rqda$qdacon,"select variable,value, caseId from caseAttr")
+DF <- reshape(DF,v.name="value",idvar="caseID",direction="wide",timevar="variable")
+names(DF) <- gsub("^value.","",names(DF))
+caseName <- dbGetQuery(.rqda$qdacon,"select name,id from cases where status==1")
+if (nrow(caseName)!=0){
+names(caseName) <- c("case","caseID")
+Encoding(caseName$case) <- "UTF-8"
+DF <- merge(caseName,DF)
+gtable(DF,con=TRUE)
+}
+}
+
+viewFileAttr <- function(){
+DF <- dbGetQuery(RQDA:::.rqda$qdacon,"select variable,value, fileId from fileAttr")
+DF <- reshape(DF,v.name="value",idvar="fileID",direction="wide",timevar="variable")
+names(DF) <- gsub("^value.","",names(DF))
+fileName <- dbGetQuery(.rqda$qdacon,"select name,id from source where status==1")
+if (nrow(fileName)!=0){
+names(fileName) <- c("file","fileID")
+Encoding(fileName$case) <- "UTF-8"
+DF <- merge(fileName,DF)
+gtable(DF,con=TRUE)
+}
+}



More information about the Rqda-commits mailing list