Commit fbec5eee authored by Yong Liu's avatar Yong Liu
Browse files

Refs #6406, add a menu option:compare dataset to orignal

parent f0da7673
......@@ -2303,6 +2303,14 @@ sdcGUI <- function() {
lossgraphcombo[] <- namelist
svalue(lossgraphcombo, index=TRUE) <- 1
dispose(xprogress)
} else {
svalue(continuousvariablerisklabel) <- ""
visible(continuousvariableriskgraph) <- TRUE
barplot(0, axes = FALSE)
lossgraphcombo[] <- c("")
svalue(nm_util_print) <- ""
visible(continuousvariablelossgraph) <- TRUE
barplot(0, axes = FALSE)
}
}
......@@ -2907,13 +2915,37 @@ sdcGUI <- function() {
selectedNames <- c(names(sdcObject@manipKeyVars),names(sdcObject@manipNumVars), names(sdcObject@manipPramVars), names(sdcObject@manipStrataVar))
glayout <- glayout(container=compareDatasetDialogFrame,expand=TRUE)
glayout[1,1] <- onlydiff <- gcheckbox("Only show difference", handler=function(h,...){
updateDifference(glayout, svalue(variableList), svalue(h$obj))
sdcObject = ActiveSdcObject()
data <- extractManipData(sdcObject)
if(!is.null(sdcObject@deletedVars)) {
data <- data[!names(data) %in% sdcObject@deletedVars]
}
selected <- svalue(variableList)
newdf <- data[names(data) %in% selected]
olddf <- sdcObject@origData[names(sdcObject@origData) %in% selected]
updateDifference(glayout, newdf, olddf, svalue(h$obj))
})
glayout[1,2] <- gbutton("prev difference", handler=function(h,...){
updateDifference(glayout, svalue(variableList), svalue(onlydiff), -1)
sdcObject = ActiveSdcObject()
data <- extractManipData(sdcObject)
if(!is.null(sdcObject@deletedVars)) {
data <- data[!names(data) %in% sdcObject@deletedVars]
}
selected <- svalue(variableList)
newdf <- data[names(data) %in% selected]
olddf <- sdcObject@origData[names(sdcObject@origData) %in% selected]
updateDifference(glayout, newdf, olddf, svalue(onlydiff), -1)
})
glayout[1,3] <- gbutton("next difference", handler=function(h,...){
updateDifference(glayout, svalue(variableList), svalue(onlydiff), 1)
sdcObject = ActiveSdcObject()
data <- extractManipData(sdcObject)
if(!is.null(sdcObject@deletedVars)) {
data <- data[!names(data) %in% sdcObject@deletedVars]
}
selected <- svalue(variableList)
newdf <- data[names(data) %in% selected]
olddf <- sdcObject@origData[names(sdcObject@origData) %in% selected]
updateDifference(glayout, newdf, olddf, svalue(onlydiff), 1)
})
glayout[2,1] <- glabel("Original Dataset")
glayout[2,2] <- glabel("Current Dataset")
......@@ -2921,24 +2953,96 @@ sdcGUI <- function() {
glayout[3,1,expand=TRUE] <- gtable(data.frame(numeric(0)))
glayout[3,2,expand=TRUE] <- gtable(data.frame(numeric(0)))
tmp <- gframe("Variables")
variableList <- gcheckboxgroup(names(sdcObject@origData), container=tmp, handler=function(h,...){
updateDifference(glayout, svalue(variableList), svalue(onlydiff))
variableList <- gcheckboxgroup(names(sdcObject@origData), container=tmp, use.table= TRUE, expand=TRUE, handler=function(h,...){
sdcObject = ActiveSdcObject()
data <- extractManipData(sdcObject)
if(!is.null(sdcObject@deletedVars)) {
data <- data[!names(data) %in% sdcObject@deletedVars]
}
selected <- svalue(variableList)
newdf <- data[names(data) %in% selected]
olddf <- sdcObject@origData[names(sdcObject@origData) %in% selected]
updateDifference(glayout, newdf, olddf, svalue(onlydiff))
})
svalue(variableList) <- names(sdcObject@origData) %in% selectedNames
data <- extractManipData(sdcObject)
if(!is.null(sdcObject@deletedVars)) {
data <- data[!names(data) %in% sdcObject@deletedVars]
}
selected <- svalue(variableList)
newdf <- data[names(data) %in% selected]
olddf <- sdcObject@origData[names(sdcObject@origData) %in% selected]
updateDifference(glayout, newdf, olddf, svalue(onlydiff))
glayout[3,3] <- tmp
} else {
add(compareDatasetDialogFrame, gtable(data.frame(column="no available Dataset.")), expand=TRUE)
}
}
updateDifference <- function(glayout,selected, checked, step=0,...) {
sdcObject = ActiveSdcObject()
data <- extractManipData(sdcObject)
if(!is.null(sdcObject@deletedVars)) {
data <- data[!names(data) %in% sdcObject@deletedVars]
# Compare Data set
compareDatasetwithsteps <- function(comparedScript, step, ...){
compareDatasetDialog <- gwindow("Compare Dataset to Original", width=600, height=500)
putd("compareDatasetDialog",compareDatasetDialog)
compareDatasetDialogFrame <- ggroup(container=compareDatasetDialog, horizontal=FALSE,expand=TRUE)
if(existd("sdcObject")) {
sdcObject <- NULL
for( i in 1:length(comparedScript) ) {
trycatch <- try(eval(parse(text=comparedScript[i])))
if(class(trycatch)=="try-error"){
sdcObject <- NULL
}
}
data <- extractManipData(sdcObject)
if(!is.null(sdcObject@deletedVars)) {
data <- data[!names(data) %in% sdcObject@deletedVars]
}
svalue(compareDatasetDialog) <- paste("Dataset:", ncol(sdcObject@origData), "variables", nrow(sdcObject@origData), "records", sep=" ")
glayout <- glayout(container=compareDatasetDialogFrame,expand=TRUE)
glayout[1,1] <- onlydiff <- gcheckbox("Only show difference", handler=function(h,...){
selected <- svalue(variableList)
newdf <- data[names(data) %in% selected]
olddf <- sdcObject@origData[names(sdcObject@origData) %in% selected]
updateDifference(glayout, newdf, olddf, svalue(h$obj))
})
glayout[1,2] <- gbutton("prev difference", handler=function(h,...){
selected <- svalue(variableList)
newdf <- data[names(data) %in% selected]
olddf <- sdcObject@origData[names(sdcObject@origData) %in% selected]
updateDifference(glayout, newdf, olddf, svalue(onlydiff), -1)
})
glayout[1,3] <- gbutton("next difference", handler=function(h,...){
selected <- svalue(variableList)
newdf <- data[names(data) %in% selected]
olddf <- sdcObject@origData[names(sdcObject@origData) %in% selected]
updateDifference(glayout, newdf, olddf, svalue(onlydiff), 1)
})
glayout[2,1] <- glabel("Original Dataset")
glayout[2,2] <- glabel(paste("Dataset at Script Step ", step, ""))
glayout[2,3] <- glabel("Variable List")
glayout[3,1,expand=TRUE] <- gtable(data.frame(numeric(0)))
glayout[3,2,expand=TRUE] <- gtable(data.frame(numeric(0)))
tmp <- gframe("Variables")
variableList <- gcheckboxgroup(names(sdcObject@origData), container=tmp, use.table= TRUE, expand=TRUE, handler=function(h,...){
selected <- svalue(variableList)
newdf <- data[names(data) %in% selected]
olddf <- sdcObject@origData[names(sdcObject@origData) %in% selected]
updateDifference(glayout, newdf, olddf, svalue(onlydiff))
})
selectedNames <- c(names(sdcObject@manipKeyVars),names(sdcObject@manipNumVars), names(sdcObject@manipPramVars), names(sdcObject@manipStrataVar))
svalue(variableList) <- names(sdcObject@origData) %in% selectedNames
newdf <- data[names(data) %in% selectedNames]
olddf <- sdcObject@origData[names(sdcObject@origData) %in% selectedNames]
updateDifference(glayout, newdf, olddf, svalue(onlydiff))
glayout[3,3] <- tmp
} else {
add(compareDatasetDialogFrame, gtable(data.frame(column="no available Dataset.")), expand=TRUE)
}
newdf <- data[names(data) %in% selected]
olddf <- sdcObject@origData[names(sdcObject@origData) %in% selected]
}
updateDifference <- function(glayout,newdf, olddf, checked, step=0,...) {
newrows <- do.call("paste", newdf)
oldrows <- do.call("paste", olddf)
diff <- which(c(newrows == oldrows) %in% FALSE)
......@@ -3950,7 +4054,7 @@ compareDataExport <- function(comparedScript, len, ...){
if(existd("sdcObject") == FALSE){
gmessage("There is no dataset loaded for export!", "No Dataset!",icon="warning")
} else{
importDialog <- gwindow("Run util and Export Dataset", parent=window, width=100, height=100)
importDialog <- gwindow("Run until and Export Dataset", parent=window, width=100, height=100)
putd("importDialog",importDialog)
putd("dframe", NULL)
importDialogFrame <- ggroup(container=importDialog, horizontal=FALSE)
......@@ -4124,11 +4228,11 @@ compareDataExport <- function(comparedScript, len, ...){
layout[2:3, 1:7] <- fparams
layout[4, 1:7] <- frame.html
layout[5,1, expand=TRUE] <- gbutton("Compare datasets", handler=function(...){compareDataset()})
layout[5,2, expand=TRUE] <- gbutton("Compare summaries",
handler=function(...){compareSummaries(sdcObject, len)})
layout[6,6, expand=FALSE] <- csvaccept
layout[6,7, expand=FALSE] <- csvdiscard
#layout[5,1, expand=TRUE] <- gbutton("Compare datasets", handler=function(...){compareDataset()})
#layout[5,2, expand=TRUE] <- gbutton("Compare summaries",
# handler=function(...){compareSummaries(sdcObject, len)})
layout[5,6, expand=FALSE] <- csvaccept
layout[5,7, expand=FALSE] <- csvdiscard
add(importDialogFrame, layout, expand=TRUE)
}
}
......@@ -5813,7 +5917,7 @@ compareDataExport <- function(comparedScript, len, ...){
}),
Import=gaction("Import", icon="new", tooltip="Import dataset", handler=function(h,...) newDataImport()),
Export=gaction("Export", icon="convert", tooltip="Export dataset", handler=function(h,...) newDataExport()),
Compare=gaction("Compare", icon="find", tooltip="Compare current dataset to original dataset", handler=function(h,...) compareDataset()),
Compare=gaction("Compare", icon="copy", tooltip="Compare current dataset to original dataset", handler=function(h,...) compareDataset()),
Manager=gaction("Variable Manager", icon="index", handler=function(h,...) {
CreateVariableManager()
}),
......@@ -5871,6 +5975,19 @@ compareDataExport <- function(comparedScript, len, ...){
Script(list(cmd=c(cmdhist)))
}
}
leftgdflist$"Compare dataset to original"$handler <- function(h,...) {
gdf <- getd("leftgdf")
rto <- svalue(gdf, index=TRUE)
cmdhist <- gdf[]
cmdhist <- cmdhist[c(1:rto)]
compareDatasetwithsteps(cmdhist, rto)
}
leftgdflist$"View risk and info loss"$handler <- function(h,...) {
gdf <- getd("leftgdf")
rto <- svalue(gdf, index=TRUE)
cmdhist <- gdf[]
cmdhist <- cmdhist[c(1:rto)]
}
add3rdmousepopupmenu(leftgdf, leftgdflist)
......
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