Commit 70d6c434 authored by Yong Liu's avatar Yong Liu

Refs #5753

parent 115f9fc0
......@@ -5371,6 +5371,63 @@ compareDataExport <- function(comparedScript, len, ...){
}
}
compareUnivariateSummary <- function(sdcObject, step, ...) {
if(existd("sdcObject") == FALSE || is.null(ActiveSdcObject()@numVars)){
gmessage("There is no dataset or numerical variable for viewing comparative univariate summary!", "No Dataset or Numerical Variable!",icon="warning")
} else{
lrDialog <- gwindow("comparative Univariate Summary for continuous key variables", parent=window, width=600, height=400)
maingroup = ggroup(horizontal=FALSE, expand=TRUE, container=lrDialog)
varFilter <- gedit(text="", container=maingroup, coerce.with = NULL, initial.msg = "please input filter letters by name")
addHandlerKeystroke(varFilter, handler = function(h, ...) {
filter <- svalue(varFilter)
dlist <- suppressWarnings(data.frame(
Number = suppressWarnings(paste("V",1:length(ActiveSdcVarsStr("numVars")),sep="")),
Name=ActiveSdcVarsStr("numVars"),
Label=c(do.call("cbind",getNameLabelList(ActiveSdcVarsStr("numVars")))), stringsAsFactors=FALSE))
if(filter != "") {
names <- ActiveSdcVarsStr("numVars")
sel <- sapply(names, function(x) all(grepl(tolower(filter), tolower(x), fixed=TRUE) > 0))
df[] <- dlist[sel,]
} else {
df[] <- dlist
}
})
labelgroup = gframe("Comparative Univariate Summary", horizontal=FALSE, container=maingroup, expand=TRUE)
d <- suppressWarnings(data.frame(
Number = suppressWarnings(paste("V",1:length(ActiveSdcVarsStr("numVars")),sep="")),
Name=ActiveSdcVarsStr("numVars"),
Label=c(do.call("cbind",getNameLabelList(ActiveSdcVarsStr("numVars")))), stringsAsFactors=FALSE))
df <- gtable(d, container=labelgroup, expand=TRUE)
addhandlerclicked(df, handler<-function(h,...) {
obj = svalue(h$obj, index=TRUE)
sdc <- ActiveSdcObject()
if(!is.null(obj) && length(obj) > 0 && !is.null(sdc@numVars)) {
name = as.character(h$obj[obj,2])
current <- read.table(text=summary(sdc@manipNumVars[name]), sep=":")
orig <- read.table(text=summary(sdc@origData[name]), sep=":")
Supdate <- data.frame(current["V1"],orig["V2"],current["V2"])
names(Supdate) <- c("",name, paste(name, ".m", SEP=""))
freqLayout[1,1,expand=TRUE] = gtable(Supdate)
visible(FreqGraph) <- TRUE
boxplot(data.frame(sdc@origData[name], sdc@manipNumVars[name]), na.action= na.exclude
, horizontal=FALSE, names=c(name, paste(name, ".m", SEP="")), main="Univariate comparison original vs. perturbed data")
}
})
######
FreqFrame = gframe(" Univariate Summary", container=maingroup, expand=TRUE, width=300, height=300)
FreqFrameGroup = ggroup(horizontal=TRUE, container=FreqFrame, expand=TRUE)
FreqGroup = ggroup(horizontal=FALSE, container=FreqFrameGroup, expand=TRUE)
freqLayout = glayout(container=FreqGroup, expand=TRUE)
freqLayout[1,1,expand=TRUE] = gtable(data.frame(Value=as.character(0),Label=as.character(0), N=as.character(0)))
freqLayout[1,2,expand=TRUE] = FreqGraph <- ggraphics(width=180, height=180)
svalue(df, index=TRUE) <- 1
}
}
linearRegression <- function(sdcObject, step, ...) {
if(existd("sdcObject") == FALSE){
gmessage("There is no dataset loaded for Comparison!", "No Dataset!",icon="warning")
......@@ -5723,6 +5780,7 @@ compareDataExport <- function(comparedScript, len, ...){
mbar$"Disclosure Risks and Data Utility"$"Categorical Key Variables"$"Comparative Frequencies"$handler= function(...) keyVariableFreq()
mbar$"Disclosure Risks and Data Utility"$"Continuous Key Variables"$"Linear Regression"$handler= function(...) linearRegression()
mbar$"Disclosure Risks and Data Utility"$"Continuous Key Variables"$"Test for Association"$handler= function(...) spearmanTest()
mbar$"Disclosure Risks and Data Utility"$"Continuous Key Variables"$"Comparative Univariate Summary"$handler= function(...) compareUnivariateSummary()
mbar$"Reports and Logs"$"Generate Report"$handler = exportReport
# mbar$Script$"Run"$handler = runScript
......
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