Commit 80c62b37 authored by Yong Liu's avatar Yong Liu

5752

parent b3e77e3c
......@@ -5264,9 +5264,77 @@ compareDataExport <- function(comparedScript, len, ...){
keyVariableFreq <- function(sdcObject, step, ...) {
if(existd("sdcObject") == FALSE){
gmessage("There is no dataset loaded for viewing frequencies!", "No Dataset!",icon="warning")
gmessage("There is no dataset loaded for viewing comparative frequencies!", "No Dataset!",icon="warning")
} else{
lrDialog <- gwindow("viewing comparative frequencies for categorical key variables", parent=window, width=600, height=400)
lrDialog <- gwindow("Comparative Frequencies for Categorical 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", expand=TRUE)
addHandlerKeystroke(varFilter, handler = function(h, ...) {
filter <- svalue(varFilter)
dlist <- suppressWarnings(data.frame(
Number = suppressWarnings(paste("V",1:length(ActiveSdcVarsStr()),sep="")),
Name=ActiveSdcVarsStr(),
Label=c(do.call("cbind",getNameLabelList(ActiveSdcVarsStr()))), stringsAsFactors=FALSE))
if(filter != "") {
names <- ActiveSdcVarsStr()
sel <- sapply(names, function(x) all(grepl(tolower(filter), tolower(x), fixed=TRUE) > 0))
df[] <- dlist[sel,]
} else {
df[] <- dlist
}
})
addSpring(maingroup)
labelgroup = ggroup(horizontal=TRUE, container=maingroup)
glabel("Categorical Key Variables", container=labelgroup)
addSpring(labelgroup)
d <- suppressWarnings(data.frame(
Number = suppressWarnings(paste("V",1:length(ActiveSdcVarsStr()),sep="")),
Name=ActiveSdcVarsStr(),
Label=c(do.call("cbind",getNameLabelList(ActiveSdcVarsStr()))), stringsAsFactors=FALSE))
df <- gtable(d, container=maingroup, expand=TRUE)
addhandlerclicked(df, handler<-function(h,...) {
obj = svalue(h$obj, index=TRUE)
if(!is.null(obj) && length(obj) > 0) {
name = as.character(h$obj[obj,2])
sdc <- ActiveSdcObject()
counts <- table(sdc@manipKeyVars[name])
Supdate <- as.data.frame(counts)
Supdate <- cbind(1:nrow(Supdate), Supdate)
colnames(Supdate) <- c("Value","Label", "N")
freqLayout[1,1,expand=TRUE] = gtable(Supdate);
visible(FreqGraph) <- TRUE
barplot(counts, main=name, horiz=TRUE)
origcounts <- table(sdc@origData[name])
origSupdate <- as.data.frame(origcounts)
origSupdate <- cbind(1:nrow(origSupdate), origSupdate)
colnames(origSupdate) <- c("Value","Label", "N")
origfreqLayout[1,1,expand=TRUE] = gtable(origSupdate);
visible(origFreqGraph) <- TRUE
barplot(origcounts, main=name, horiz=TRUE)
}
})
######
FreqFrame = gframe("Current Frequencies", container=maingroup, expand=TRUE, width=300, height=200)
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)
######
origFreqFrame = gframe("Original Frequencies", container=maingroup, expand=TRUE, width=300, height=200)
origFreqFrameGroup = ggroup(horizontal=TRUE, container=origFreqFrame, expand=TRUE)
origFreqGroup = ggroup(horizontal=FALSE, container=origFreqFrameGroup, expand=TRUE)
origfreqLayout = glayout(container=origFreqGroup, expand=TRUE)
origfreqLayout[1,1,expand=TRUE] = gtable(data.frame(Value=as.character(0),Label=as.character(0), N=as.character(0)))
origfreqLayout[1,2,expand=TRUE] = origFreqGraph <- ggraphics(width=180, height=180)
svalue(df, index=TRUE) <- 1
}
}
......@@ -5619,10 +5687,9 @@ compareDataExport <- function(comparedScript, len, ...){
mbar$"Disclosure Risks and Data Utility"$"Categorical Key Variables"$"L-diversity"$handler= function(...) ldiv1()
mbar$"Disclosure Risks and Data Utility"$"Categorical Key Variables"$"PRAM output"$handler = viewpram1
mbar$"Disclosure Risks and Data Utility"$"Categorical Key Variables"$"Linear Regression"$handler= function(...) linearRegression()
mbar$"Disclosure Risks and Data Utility"$"Categorical Key Variables"$"Frequencies for Categorical Key Variables"$handler= function(...) keyVariableFreq()
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"$"Linear Regression"$handler= function(...) linearRegression()
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