Commit 115f9fc0 authored by Yong Liu's avatar Yong Liu

Refs #6371

parent 80c62b37
......@@ -3527,8 +3527,7 @@ sdcGUI <- function() {
#setup import gui
statusbar <- gstatusbar("")
filebutton <- gbutton("...", handler=buttonHandler)
okaccept <- gbutton("OK", handler=function(...){
doimportaction <- function(...) {
tryCatch({
wd <- WaitingDialog(Parent=importDialog)
focus(wd) <- TRUE
......@@ -3645,6 +3644,19 @@ sdcGUI <- function() {
gmessage(paste("There was a problem while importing your STATA file: ",e,"'"),"Import Error!",icon="error")
dispose(importDialog)
})
}
okaccept <- gbutton("OK", handler=function(...){
if(existd("sdcObject")) {
gconfirm("Do you want to reset the current dataset and import new dataset without saving?", icon="question", parent=window,
handler=function(h,...) {
Script.new()
putd("activescript.file", "Untitled Script")
svalue(leftFrameGroupLabel) <- "Untitled Script"
doimportaction()
})
} else {
doimportaction()
}
})
canceldiscard <- gbutton("Cancel ", handler=function(...){dispose(importDialog)})
......@@ -3752,16 +3764,9 @@ sdcGUI <- function() {
add(fbuttontool, okaccept)
resetcwd()
}
newDataImport <- function(...){
if(existd("sdcObject")) {
gconfirm("Do you want to reset the current dataset and import new dataset without saving?", icon="question", parent=window,
handler=function(h,...) {
Script.new()
newDataImportWithoutConfirm()
})
} else {
newDataImportWithoutConfirm()
}
newDataImportWithoutConfirm()
}
newDataExport <- function(...){
......@@ -5212,10 +5217,10 @@ compareDataExport <- function(comparedScript, len, ...){
gmessage("Please select key variables in Variable Manager!", "No Key Variables yet!",icon="warning")
} else {
populationDialog <- gwindow("Population Frequencies and Individual Risks", parent=window, width=800, hieght=500)
#dialoggroup <- ggroup(container=populationDialog,horizontal=FALSE)
dialoggroup <- ggroup(container=populationDialog,horizontal=FALSE)
sdc <- ActiveSdcObject()
nb <- gnotebook(container=populationDialog, closebuttons=FALSE)
nb <- gnotebook(container=dialoggroup, closebuttons=FALSE)
FreqTT <- ggroup(horizontal=FALSE, container=nb,label="Frequencies")
svalue(nb) <- 1
......@@ -5225,13 +5230,15 @@ compareDataExport <- function(comparedScript, len, ...){
ind <- !duplicated(apply(xtmp,1,function(x)paste(x,collapse="_")))
tabDat <- tabDat[ind,]
tabDat$risk <- round(tabDat$risk,5)
tabDat <- tabDat[order(as.numeric(tabDat$risk),decreasing=TRUE),]
tabDat <- tabDat[order(as.numeric(tabDat$risk),decreasing=TRUE),]
putd("freq.tabdata", tabDat)
FreqT <- gtable(data.frame(apply(tabDat,2,function(x)as.character(x)),stringsAsFactors=FALSE))
size(FreqT) <- c(500,500)
FreqTT_2 <- gframe('<span weight="bold" size="medium">Frequencies for combinations of cat. key variables</span>',
container=FreqTT,markup=TRUE, expand=TRUE)
tooltip(FreqT) <- "fk=sample frequency\nFk=(grossed up) population frequency"
add(FreqTT_2 , FreqT, expand=TRUE)
putd("freq.FreqT", FreqT)
barcharRiskTab <- ggroup(horizontal=FALSE, container=nb,label="Barchart of Individual Risks")
g <- ggraphics()
......@@ -5242,6 +5249,8 @@ compareDataExport <- function(comparedScript, len, ...){
add(barcharFreqTab, g1, expand=TRUE)
addHandlerChanged(nb, handler=function(h,...) {
sdc <- ActiveSdcObject()
tabDat <- getd("freq.tabdata")
if(h$pageno == 2) {
visible(g) <- TRUE
if(nrow(tabDat) > 10) {
......@@ -5255,9 +5264,33 @@ compareDataExport <- function(comparedScript, len, ...){
} else {
try(barplot(c(as.numeric(tabDat$Fk)), main="Population Frequencies for Categorical Combinations", horiz =TRUE, cex.names=0.5, names.arg=do.call(paste0, tabDat[names(sdc@manipKeyVars)]), las=1), silent=TRUE)
}
}
} else {
delete(FreqTT_2, getd("freq.FreqT"))
FreqT <- gtable(data.frame(apply(tabDat,2,function(x)as.character(x)),stringsAsFactors=FALSE))
tooltip(FreqT) <- "fk=sample frequency\nFk=(grossed up) population frequency"
add(FreqTT_2 , FreqT, expand=TRUE)
putd("freq.FreqT", FreqT)
}
})
gseparator(container=dialoggroup)
nm2_windowButtonGroup = ggroup(container=dialoggroup)
addSpring(nm2_windowButtonGroup)
gbutton("Refresh", container=nm2_windowButtonGroup,
handler=function(h,...) {
svalue(nb) <- 2
sdc <- ActiveSdcObject()
m1 <- ActiveSdcVars("risk")$individual
xtmp <- ActiveSdcVars("manipKeyVars")
tabDat <- cbind(xtmp,m1)
ind <- !duplicated(apply(xtmp,1,function(x)paste(x,collapse="_")))
tabDat <- tabDat[ind,]
tabDat$risk <- round(tabDat$risk,5)
tabDat <- tabDat[order(as.numeric(tabDat$risk),decreasing=TRUE),]
putd("freq.tabdata", tabDat)
svalue(nb) <- 1
})
gbutton("Close ", container=nm2_windowButtonGroup, handler=function(h,...) { dispose(populationDialog) })
gbutton("Help ", container=nm2_windowButtonGroup, handler=function(h,...) { helpR("measure_risk") })
svalue(nb) <- 1
}
}
......@@ -5670,7 +5703,7 @@ compareDataExport <- function(comparedScript, len, ...){
mbar$Data$"View"$"Compare dataset"$handler = compareDataset
mbar$Data$"Variable Manager"$handler = function(h, ...) CreateVariableManager()
mbar$Script$"Load"$handler = loadScript
mbar$Script$"Save As"$handler = saveAsScript
mbar$Script$"Export"$handler = saveAsScript
mbar$Script$"Save"$handler = saveScript
mbar$Script$"View"$handler = viewScript
mbar$"Anonymisation"$"On Categorical key Variables"$Recode$handler = selectKeyVariableInVC
......@@ -5868,8 +5901,7 @@ compareDataExport <- function(comparedScript, len, ...){
keyvariablerisktable = gtable(data.frame("number"=c(""), "risk.calculations"=c(""), "curr.count"=c(""),"orig.count"=c(""),
"curr.pct"=c(""),"orig.pct"=c(""),stringsAsFactors=FALSE), container=tmp, width=280, height=250, expand=TRUE)
keyvariableriskgraph = ggraphics(container=tmp, width=280, height=200)
keyvariableFreqGroup <- ggroup(container=tmp, width=280, height=250, expand=TRUE,horizontal=FALSE)
glabel("10 combinations of categories with highest risk", container=keyvariableFreqGroup)
keyvariableFreqGroup <- gframe('<span size="medium" weight="bold">10 combinations of categories with highest risk</span>',markup=TRUE, container=tmp, width=280, height=250, expand=TRUE,horizontal=FALSE)
keyvariableFreqTable <- gtable(data.frame("Frequency"=c(""),stringsAsFactors=FALSE), container=keyvariableFreqGroup, width=280, height=250, expand=TRUE)
putd("keyvariableFreqTable", keyvariableFreqTable)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment