Ronggui
Suggestion of new widget for attributes
I think that it would be better if the dialog box to add a new attribute included the attribute class rather than we having to set the class in another dialog box. And I think that would be even better if users could define restrictions on valid values that could be typed when filling the attributes for each file. Finally, I think that instead of just two classes (character and numeric) we could also allow users to set the attribute as integer and factor. The integer class would be useful for attributes such as age. It could also be converted into a factor later.
I started the development of such an improved dialog box. In fact, I am considering the possibility of using the same code to create a “Data Entry” R package which would make it easier to enter data from questionnaires.
The code below does what I am suggesting:
library(gWidgetsRGtk2)
IsNumericInt <- function(s, cls)
{
ni <- try(as.numeric(s), silent = TRUE)
if(is.na(ni)){
gmessage(sprintf(gettext("'%s' is not a valid numeric value.",
domain = "R-RQDA"), s), type = "warning")
return(FALSE)
}
if(cls == "integer" && ni != try(as.integer(s), silent = TRUE)){
gmessage(sprintf(gettext("'%s' is not a valid integer value.",
domain = "R-RQDA"), s), type = "warning")
return(FALSE)
}
return(TRUE)
}
AttrDlg <- function(x)
{
attrdlg <- gwindow(title = gettext("Attribute", domain = "R-RQDA"),
parent = c(2, 2), visible = FALSE)
vbox <- ggroup(horizontal = FALSE, container = attrdlg)
glabel(gettext("Name:", domain = "R-RQDA"), container = vbox, anchor = c(-1, 1))
aName <- gedit(width = 25, container = vbox, anchor = c(-1, 1))
glabel(gettext("Class:", domain = "R-RQDA"), container = vbox, anchor = c(-1, 1))
aClass <- gradio(c("character", "factor", "integer", "numeric"), selected = 0,
horizontal = TRUE, container = vbox, anchor = c(-1, 1))
gseparator(container = vbox)
intLbl <- glabel(gettext("Set valid:", domain = "R-RQDA"))
intVal <- gradio(c(gettext("range"), gettext("values")),
selected = 0, horizontal = TRUE)
rLbl <- glabel(gettext("Valid range:", domain = "R-RQDA"))
hbox1 <- ggroup()
lMin <- glabel(gettext("Min:", domain = "R-RQDA"), container = hbox1, anchor = c(-1, 0))
aMin <- gedit(width = 6, container = hbox1, anchor = c(-1, 1))
lMax <- glabel(gettext("Max:", domain = "R-RQDA"), container = hbox1, anchor = c(-1, 0))
aMax <- gedit(width = 6, container = hbox1, anchor = c(-1, 1))
vvLbl <- glabel(gettext("Valid values (one per line):", domain = "R-RQDA"),
anchor = c(-1, 1))
aVV <- gtext(width = 25, height = 100, anchor = c(-1, 1))
addSpring(vbox)
hbox2 <- ggroup(container = vbox)
addSpring(hbox2)
btCancel <- gbutton(gettext("Cancel", domain = "R-RQDA"), container = hbox2)
btOK <- gbutton(gettext("OK", domain = "R-RQDA"), container = hbox2)
onClassChange <- function(...){
delete(vbox, intLbl)
delete(vbox, intVal)
delete(vbox, rLbl)
delete(vbox, hbox1)
delete(vbox, vvLbl)
delete(vbox, aVV)
delete(vbox, hbox2)
if(svalue(aClass) == "integer"){
add(vbox, intLbl, anchor = c(-1, 1))
add(vbox, intVal, anchor = c(-1, 1))
}
if(svalue(aClass) == "numeric" || (svalue(aClass) == "integer" && svalue(intVal) == gettext("range", domain = "R-RQDA"))){
add(vbox, rLbl, anchor = c(-1, 1))
add(vbox, hbox1)
} else if(svalue(aClass) == "factor" || (svalue(aClass) == "integer" && svalue(intVal) == gettext("values", domain = "R-RQDA"))){
add(vbox, vvLbl, anchor = c(-1, 1))
add(vbox, aVV, anchor = c(-1, 1))
}
add(vbox, hbox2)
}
onCancel <- function(...){
dispose(attrdlg)
}
onOK <- function(...){
# Get clean values
nm <- sub("^[ \t\r\n]*", "", svalue(aName))
nm <- sub("[ \t\r\n]*$", "", nm)
cl <- svalue(aClass)
vv <- strsplit(svalue(aVV), "\n")[[1]]
vv <- sub("^[ \t\n\r]*", "", vv)
vv <- sub("[ \t\n\r]*$", "", vv)
vv <- vv[vv != ""]
mi <- sub("^[ \t\r\n]*", "", svalue(aMin))
mi <- sub("[ \t\r\n]*$", "", mi)
mi <- sub("^NA$", "", mi)
ma <- sub("^[ \t\r\n]*", "", svalue(aMax))
ma <- sub("[ \t\r\n]*$", "", ma)
ma <- sub("^NA$", "", ma)
# Get "range of value" and "valid values" only when they are meaniful
if(length(vv) == 0)
vv <- NA
if(mi == "")
mi <- NA
if(ma == "")
ma <- NA
if(cl == "character" || cl == "numeric"){
vv <- NA
}
if(cl == "character" || cl == "factor"){
mi <- NA
ma <- NA
}
# Check if the name is valid
if(nchar(nm) == 0){
gmessage(gettext("The attribute name cannot be empty.",
domain = "R-RQDA"), type = "warning")
focus(aName)
return(invisible(NULL))
}
if(grepl("^[0-9]", nm)){
gmessage(gettext("The attribute name cannot begin with a number.",
domain = "R-RQDA"), type = "warning")
focus(aName)
return(invisible(NULL))
}
if(grepl("[@#$%^&*(){}<>?|/\\+-=,;:'\"`~]", nm) || grepl("\\[", nm) || grepl("\\]", nm)){
gmessage(gettext("Invalid character in the attribute name.",
domain = "R-RQDA"), type = "warning")
focus(aName)
return(invisible(NULL))
}
# Check if the values are valid
if(cl == "numeric" || (cl == "integer" && svalue(intVal) == "range")){
vv <- NA
if(mi != "" && !IsNumericInt(mi, cl)){
focus(aMin)
return(invisible(NULL))
}
if(ma != "" && !IsNumericInt(mi, cl)){
focus(aMin)
return(invisible(NULL))
}
if(cl == "numeric"){
mi <- as.numeric(mi)
ma <- as.numeric(ma)
} else {
mi <- as.integer(mi)
ma <- as.integer(ma)
}
}
if(cl == "integer" && svalue(intVal) == "values"){
mi <- NA
ma <- NA
for(v in vv){
if(!IsNumericInt(v, cl)){
focus(aVV)
return(invisible(NULL))
}
}
vv <- as.integer(vv)
}
# Check for duplicates
if(sum(duplicated(vv))){
gmessage(sprintf(ngettext(sum(duplicated(vv)),
"There is a duplicated value:\n%s",
"There are duplicated values:\n%s",
domain = "R-RQDA"),
paste(vv[duplicated(vv)], collapse = "\n")),
type = "warning")
focus(aVV)
return(invisible(NULL))
}
dispose(attrdlg)
cat("\n===========================\n\n")
print(list("name" = nm, "class" = cl, "valid.values" = vv, "min" = mi, "max" = ma))
cat("===========================\n")
}
addHandlerChanged(aClass, onClassChange)
addHandlerChanged(intVal, onClassChange)
addHandlerChanged(btCancel, onCancel)
addHandlerChanged(btOK, onOK)
visible(attrdlg) <- TRUE
}
AttrDlg()
I created the new package, so now it is easier to evaluate my suggestion: https://github.com/jalvesaq/DataEntry
I am wondering whether I should integrate this code into RQDA directly, or should I use the dataentry package (it seems only available on github but not CRAN). If the former way, how should I acknowledge your contribution appropriately?
I have submitted the package to CRAN, but I did not get any reply. I will submit it again. The advantage of integrating DataEntry code into RQDA is that you can easily make the adjustments that you might need, and there is no risk of conflict due to future changes in DataEntry. The advantage of using DataEntry directly is that you would not have to maintain the code.
Either way, tell me what I should do: (a) a pull request adding DataEntry code to RQDA; (b) change something in DataEntry to make it possible its use by other packages; (c) nothing, because you will take care of everything.
My name is already in the Contributors file. This is more than enough for me.
In that case, I think I can integrate the code into a new release and add a description in the contributors file.