summary.simulation.window {arvoRe} | R Documentation |
Usage
summary.simulation.window(Simlist, tempo1 = Sys.time(), tempo2 = Sys.time(), CicloVal, tipo.nodo = " ", digits = 3)
Arguments
Simlist |
|
tempo1 |
|
tempo2 |
|
CicloVal |
|
tipo.nodo |
|
digits |
|
Examples
##---- Should be DIRECTLY executable !! ----
##-- ==> Define data, use random,
##-- or do help(data=index) for the standard data sets.
## The function is currently defined as
function(Simlist, tempo1 = Sys.time(), tempo2 = Sys.time(), CicloVal, tipo.nodo = " ", digits = 3) {
require(abind)
require(gplots)
treatments.sim <- names(Simlist)
windheight <- 300
windwidth <- 750
summarysimulationWindow <- tktoplevel()
title <- "ÁrvoRe - Simulação Monte Carlo"
tkwm.title(summarysimulationWindow,title)
frameOverall <- tkwidget(summarysimulationWindow, "labelframe", borderwidth = 0, relief = "groove")
frameResume <- tkwidget(frameOverall, "labelframe", borderwidth = 2, relief = "groove")
framePanelButton <- tkwidget(frameResume, "labelframe", borderwidth = 0, relief = "groove")
framebutton <- tkwidget(summarysimulationWindow, "labelframe", borderwidth = 0, relief = "groove")
pBar <- tkwidget(frameResume, "NoteBook", height = windheight, width = windwidth)
tkpack(frameOverall, expand = 1, fill = "both") #, side = "left")
tkpack(frameResume, expand = 1, fill = "both", side = "top", anchor = "ne")
tkpack(framebutton, expand = 1, fill = "x", side = "bottom")
tkpack(pBar, expand = 1, fill = "both", side = "left")
tkpack(framePanelButton, fill = "both", side = "right") # , anchor = "ne"
PageNoteBook <- tcl(pBar, "insert", "end", "Page0", "-text", "Nodos")
timecounter <- 1
Alltreatmentstable <- data.frame(Treatment = array(,0), Data = array(,0), Mean = array(,0),
Variance = array(,0), Sd = array(,0), Median = array(,0),
Min = array(,0),Max = array(,0),
Quartil1 = array(,0), Quartil2 = array(,0), CovDcDe = array(,0),
Time = array(,0))
for (i in treatments.sim) {
tempo <- tempo2[timecounter] - tempo1[timecounter]
timecounter <- timecounter + 1
# Cria uma página para este tratamento -------------------------------------------------
position <- which( treatments.sim == i)
pagetclname <- paste("Page",position, sep = "")
pagelabel <- i
PageNoteBook <- tcl(pBar, "insert", "end", pagetclname, "-text", pagelabel)
object.page.name <- paste("PageNoteBook", position, sep = "")
assign(object.page.name, PageNoteBook)
PageNoteBook.Window <- .Tk.newwin(PageNoteBook)
object.page.window.name <- paste("PageNoteBook.Window", position, sep = "")
assign(object.page.window.name, PageNoteBook.Window)
frameWindow <- tkwidget(PageNoteBook.Window, "labelframe", borderwidth = 2, relief = "groove", text = "Relatório")
# -------------------------------------------------
frameUpper <- tkframe(frameWindow, relief="groove", borderwidth = 0)
frameUpperLeft <- tkwidget(frameUpper, "labelframe", borderwidth = 2, relief = "groove", text = "Custo")
frameUpperRight <- tkwidget(frameUpper, "labelframe", borderwidth = 2, relief = "groove", text = "Efetividade")
frameLower <- tkframe(frameWindow, relief="groove", borderwidth=2)
# The node root name
node.root.name <- paste("Nodo : ", i, sep = "")
node.root.name.label <- tklabel(frameUpper, text = node.root.name)
tkgrid(node.root.name.label, sticky = "nw", columnspan = 1)
# The time of simulation
time.text <- paste("Tempo decorrido (segundos) : ", format(round(tempo, digits = digits), nsmall = digits), sep = "")
time.sim <- tklabel(frameUpper, text = time.text)
tkgrid(time.sim, sticky = "nw", columnspan = 1)
# A Efetividade -------------------------------------------------
Mktable <- Simlist[[i]]
Data <- Mktable$Effectiveness
# Remover esta linha se sumarizar saídas de funções de simulação
Data <- apply(Data,2,sum, na.rm = TRUE)
ntreat <- length(Data)
statisticsData <- summary(Data, na.rm = TRUE)
meanData <- mean(Data)
if ( tipo.nodo[position] == "M") {
varData <- ( 1 / (ntreat*(ntreat-1)) ) * sum( (Data - meanData)^2)
} else {
varData <- var( Data, na.rm = TRUE )
}
sdData <- sqrt(varData)
medianData <- statisticsData[3]
minData <- statisticsData[1]
maxData <- statisticsData[6]
quartil1 <- statisticsData[2]
quartil3 <- statisticsData[5]
DataEff <- Data
# Guarda as informações importantes
line.data.summary <- data.frame(Treatment = pagelabel, Data = "Effectiveness", Mean = meanData,
Variance = varData, Sd = sdData, Median = medianData,
Min = minData, Max = maxData,
Quartil1 = quartil1, Quartil2 = quartil3,
CovDcDe = 0, Time = tempo)
Alltreatmentstable <- abind(Alltreatmentstable, line.data.summary, along=1)
# print(line.data.summary)
# print(Alltreatmentstable)
Alltreatmentstable <- as.data.frame(Alltreatmentstable)
Alltreatmentstable$Treatment <- as.character(Alltreatmentstable$Treatment)
Alltreatmentstable$Data <- as.character(Alltreatmentstable$Data)
Alltreatmentstable$Mean <- as.numeric(as.character(Alltreatmentstable$Mean))
Alltreatmentstable$Variance <- as.numeric(as.character(Alltreatmentstable$Variance))
Alltreatmentstable$Sd <- as.numeric(as.character(Alltreatmentstable$Sd))
Alltreatmentstable$Median <- as.numeric(as.character(Alltreatmentstable$Median))
Alltreatmentstable$Min <- as.numeric(as.character(Alltreatmentstable$Min))
Alltreatmentstable$Max <- as.numeric(as.character(Alltreatmentstable$Max))
Alltreatmentstable$Quartil1 <- as.numeric(as.character(Alltreatmentstable$Quartil1))
Alltreatmentstable$Quartil2 <- as.numeric(as.character(Alltreatmentstable$Quartil2))
Alltreatmentstable$CovDcDe <- as.numeric(as.character(Alltreatmentstable$CovDcDe))
Alltreatmentstable$Time <- as.numeric(as.character(Alltreatmentstable$Time))
if ( tipo.nodo[position] == "M") {
varData <- var( Data, na.rm = TRUE )
sdData <- sqrt(varData)
}
lableminsize <- tklabel(frameUpperRight,text = paste(rep("_",50),collapse="",sep=""))
lableminsize2 <- tklabel(frameUpperRight,text = paste(rep("_",50),collapse="",sep=""))
# label0 <- tklabel(frameUpperRight,text= "Tempo decorrido (segundos)")
# label1 <- tklabel(frameUpperRight,text= format(tempo, nsmall = digits) )
label2 <- tklabel(frameUpperRight,text= "Valor Médio")
label3 <- tklabel(frameUpperRight,text= format(round(meanData, digits = digits), nsmall = digits) )
label4 <- tklabel(frameUpperRight,text= "Variância")
label5 <- tklabel(frameUpperRight,text= format(round(varData, digits = digits), nsmall = digits) )
label6 <- tklabel(frameUpperRight,text= "Desvio Padrão")
label7 <- tklabel(frameUpperRight,text= format(round(sdData, digits = digits), nsmall = digits) )
label8 <- tklabel(frameUpperRight,text= "Mediana")
label9 <- tklabel(frameUpperRight,text= format(round(medianData, digits = digits), nsmall = digits) )
label10 <- tklabel(frameUpperRight,text= "Mínimo")
label11 <- tklabel(frameUpperRight,text= format(round(minData, digits = digits), nsmall = digits) )
label12 <- tklabel(frameUpperRight,text= "Máximo")
label13 <- tklabel(frameUpperRight,text= format(round(maxData, digits = digits), nsmall = digits) )
label14 <- tklabel(frameUpperRight,text= "1st. Quartil")
label15 <- tklabel(frameUpperRight,text= format(round(quartil1, digits = digits), nsmall = digits) )
label16 <- tklabel(frameUpperRight,text= "3rd. Quartil")
label17 <- tklabel(frameUpperRight,text= format(round(quartil3, digits = digits), nsmall = digits) )
tkgrid(lableminsize, row = 1, column = 0, columnspan = 2)
# tkgrid(label0, row = 2, column = 0,sticky="w")
# tkgrid(label1, row = 2, column = 1,sticky="e")
tkgrid(label2, row = 3, column = 0,sticky="w")
tkgrid(label3, row = 3, column = 1,sticky="e")
tkgrid(label4, row = 4, column = 0,sticky="w")
tkgrid(label5, row = 4, column = 1,sticky="e")
tkgrid(label6, row = 5, column = 0,sticky="w")
tkgrid(label7, row = 5, column = 1,sticky="e")
tkgrid(label8, row = 6, column = 0,sticky="w")
tkgrid(label9, row = 6, column = 1,sticky="e")
tkgrid(label10, row = 7, column = 0,sticky="w")
tkgrid(label11, row = 7, column = 1,sticky="e")
tkgrid(label12, row = 8, column = 0,sticky="w")
tkgrid(label13, row = 8, column = 1,sticky="e")
tkgrid(label14, row = 9, column = 0,sticky="w")
tkgrid(label15, row = 9, column = 1,sticky="e")
tkgrid(label16, row = 10, column = 0,sticky="w")
tkgrid(label17, row = 10, column = 1,sticky="e")
tkgrid(lableminsize2, row = 11, column = 0, columnspan = 2)
# O Custo -------------------------------------------------
Data <- apply( Mktable$Cost, 2, sum, na.rm = TRUE)
ntreat <- length(Data)
statisticsData <- summary(Data, na.rm = TRUE)
meanData <- mean(Data)
if ( tipo.nodo[position] == "M") {
varData <- ( 1 / (ntreat*(ntreat-1)) ) * sum( (Data - meanData)^2)
} else {
varData <- var( Data, na.rm = TRUE )
}
sdData <- sqrt(varData)
medianData <- statisticsData[3]
minData <- statisticsData[1]
maxData <- statisticsData[6]
quartil1 <- statisticsData[2]
quartil3 <- statisticsData[5]
CovCE <- sum( (DataEff - mean(DataEff) * (Data - meanData)) / ( ntreat * (ntreat - 1) ) , na.rm = TRUE)
# print(CovCE)
nlAllt <- dim(Alltreatmentstable)[1]
Alltreatmentstable$CovDcDe[ nlAllt ] <- CovCE
# Guarda as informações importantes
line.data.summary <- data.frame(Treatment = pagelabel, Data = "Cost", Mean = meanData,
Variance = varData, Sd = sdData, Median = medianData,
Min = minData, Max = maxData,
Quartil1 = quartil1, Quartil2 = quartil3,
CovDcDe = CovCE, Time = tempo)
Alltreatmentstable <- abind(Alltreatmentstable, line.data.summary, along=1)
# print(line.data.summary)
# print(Alltreatmentstable)
Alltreatmentstable <- as.data.frame(Alltreatmentstable)
Alltreatmentstable$Treatment <- as.character(Alltreatmentstable$Treatment)
Alltreatmentstable$Data <- as.character(Alltreatmentstable$Data)
Alltreatmentstable$Mean <- as.numeric(as.character(Alltreatmentstable$Mean))
Alltreatmentstable$Variance <- as.numeric(as.character(Alltreatmentstable$Variance))
Alltreatmentstable$Sd <- as.numeric(as.character(Alltreatmentstable$Sd))
Alltreatmentstable$Median <- as.numeric(as.character(Alltreatmentstable$Median))
Alltreatmentstable$Min <- as.numeric(as.character(Alltreatmentstable$Min))
Alltreatmentstable$Max <- as.numeric(as.character(Alltreatmentstable$Max))
Alltreatmentstable$Quartil1 <- as.numeric(as.character(Alltreatmentstable$Quartil1))
Alltreatmentstable$Quartil2 <- as.numeric(as.character(Alltreatmentstable$Quartil2))
Alltreatmentstable$CovDcDe <- as.numeric(as.character(Alltreatmentstable$CovDcDe))
Alltreatmentstable$Time <- as.numeric(as.character(Alltreatmentstable$Time))
if ( tipo.nodo[position] == "M") {
varData <- var( Data, na.rm = TRUE )
sdData <- sqrt(varData)
}
lableminsize <- tklabel(frameUpperLeft,text = paste(rep("_",50),collapse="",sep=""))
lableminsize2 <- tklabel(frameUpperLeft,text = paste(rep("_",50),collapse="",sep=""))
# label0 <- tklabel(frameUpperLeft,text= "Tempo decorrido (segundos)")
# label1 <- tklabel(frameUpperLeft,text= format(tempo, nsmall = digits) )
label2 <- tklabel(frameUpperLeft,text= "Valor Médio")
label3 <- tklabel(frameUpperLeft,text= format(round(meanData, digits = digits), nsmall = digits) )
label4 <- tklabel(frameUpperLeft,text= "Variância")
label5 <- tklabel(frameUpperLeft,text= format(round(varData, digits = digits), nsmall = digits) )
label6 <- tklabel(frameUpperLeft,text= "Desvio Padrão")
label7 <- tklabel(frameUpperLeft,text= format(round(sdData, digits = digits), nsmall = digits) )
label8 <- tklabel(frameUpperLeft,text= "Mediana")
label9 <- tklabel(frameUpperLeft,text= format(round(medianData, digits = digits), nsmall = digits) )
label10 <- tklabel(frameUpperLeft,text= "Mínimo")
label11 <- tklabel(frameUpperLeft,text= format(round(minData, digits = digits), nsmall = digits) )
label12 <- tklabel(frameUpperLeft,text= "Máximo")
label13 <- tklabel(frameUpperLeft,text= format(round(maxData, digits = digits), nsmall = digits) )
label14 <- tklabel(frameUpperLeft,text= "1st. Quartil")
label15 <- tklabel(frameUpperLeft,text= format(round(quartil1, digits = digits), nsmall = digits) )
label16 <- tklabel(frameUpperLeft,text= "3rd. Quartil")
label17 <- tklabel(frameUpperLeft,text= format(round(quartil3, digits = digits), nsmall = digits) )
tkgrid(lableminsize, row = 1, column = 0, columnspan = 2)
# tkgrid(label0, row = 2, column = 0,sticky="w")
# tkgrid(label1, row = 2, column = 1,sticky="e")
tkgrid(label2, row = 3, column = 0,sticky="w")
tkgrid(label3, row = 3, column = 1,sticky="e")
tkgrid(label4, row = 4, column = 0,sticky="w")
tkgrid(label5, row = 4, column = 1,sticky="e")
tkgrid(label6, row = 5, column = 0,sticky="w")
tkgrid(label7, row = 5, column = 1,sticky="e")
tkgrid(label8, row = 6, column = 0,sticky="w")
tkgrid(label9, row = 6, column = 1,sticky="e")
tkgrid(label10, row = 7, column = 0,sticky="w")
tkgrid(label11, row = 7, column = 1,sticky="e")
tkgrid(label12, row = 8, column = 0,sticky="w")
tkgrid(label13, row = 8, column = 1,sticky="e")
tkgrid(label14, row = 9, column = 0,sticky="w")
tkgrid(label15, row = 9, column = 1,sticky="e")
tkgrid(label16, row = 10, column = 0,sticky="w")
tkgrid(label17, row = 10, column = 1,sticky="e")
tkgrid(lableminsize2, row = 11, column = 0, columnspan = 2)
tkgrid(frameUpperLeft, frameUpperRight, sticky="ns")
tkgrid(frameUpper,sticky="ns")
tkgrid(frameLower,sticky="ns")
tkpack(frameWindow, expand = 1, fill = "both")
tkgrid(PageNoteBook.Window)
# The CE -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
Data <- apply(Mktable$Cost,2,sum, na.rm = TRUE) / apply(Mktable$Effectiveness, 2, sum, na.rm = TRUE)
Data <- replace( Data, Data == Inf, NA)
statisticsData <- summary(Data, na.rm = TRUE)
meanData <- statisticsData[4]
varData <- var(Data, na.rm = TRUE)
sdData <- sqrt(varData)
medianData <- statisticsData[3]
minData <- statisticsData[1]
maxData <- statisticsData[6]
quartil1 <- statisticsData[2]
quartil3 <- statisticsData[5]
# Guarda as informações importantes
line.data.summary <- data.frame(Treatment = pagelabel, Data = "C/E", Mean = meanData,
Variance = varData, Sd = sdData, Median = medianData,
Min = minData, Max = maxData,
Quartil1 = quartil1, Quartil2 = quartil3,
CovDcDe = NA, Time = tempo)
Alltreatmentstable <- abind(Alltreatmentstable, line.data.summary, along=1)
}
# Uma limpeza na memória...
rm(Data, statisticsData, Mktable, CovCE, nlAllt, meanData, varData, sdData, medianData, minData, maxData,
quartil1, quartil3)
# Ajusta o Alltreatmentstable
rownames(Alltreatmentstable) <- NULL
Alltreatmentstable <- as.data.frame(Alltreatmentstable)
Alltreatmentstable$Treatment <- as.character(Alltreatmentstable$Treatment)
Alltreatmentstable$Data <- as.character(Alltreatmentstable$Data)
Alltreatmentstable$Mean <- as.numeric(as.character(Alltreatmentstable$Mean))
Alltreatmentstable$Variance <- as.numeric(as.character(Alltreatmentstable$Variance))
Alltreatmentstable$Sd <- as.numeric(as.character(Alltreatmentstable$Sd))
Alltreatmentstable$Median <- as.numeric(as.character(Alltreatmentstable$Median))
Alltreatmentstable$Min <- as.numeric(as.character(Alltreatmentstable$Min))
Alltreatmentstable$Max <- as.numeric(as.character(Alltreatmentstable$Max))
Alltreatmentstable$Quartil1 <- as.numeric(as.character(Alltreatmentstable$Quartil1))
Alltreatmentstable$Quartil2 <- as.numeric(as.character(Alltreatmentstable$Quartil2))
Alltreatmentstable$CovDcDe <- as.numeric(as.character(Alltreatmentstable$CovDcDe))
Alltreatmentstable$Time <- as.numeric(as.character(Alltreatmentstable$Time))
Alltreatmentstable <- Alltreatmentstable[ order(Alltreatmentstable$Data),]
# print(Alltreatmentstable)
assign("Alltreatmentstable", Alltreatmentstable, env = .GlobalEnv)
# The data to plot
AllTreatCost <- Alltreatmentstable[Alltreatmentstable$Data == "Cost",]
AllTreatEffectiveness <- Alltreatmentstable[Alltreatmentstable$Data == "Effectiveness",]
AllTreatCE <- Alltreatmentstable[Alltreatmentstable$Data == "C/E",]
# Initial colors to treatments points
treatments.colors.plot <- 1:length(AllTreatCost$Treatment)
# The treatments names
treatments.label.plot <- AllTreatCost$Treatment
n.treat <- c(0,length(treatments.sim):1,0,length(treatments.sim))
for (i in n.treat) {
pagetclname <- paste("Page",i, sep="")
tcl(pBar,"raise",pagetclname)
}
tcl(pBar,"itemconfigure", "Page0", "-state", "disabled") # Set Page0 page to disabled.
OnOK <- function()
{
tkdestroy(summarysimulationWindow)
tkwm.deiconify(tt)
tkfocus(tt)
}
OnGraph <- function(Mktable, Alltreatmentstable) {
selectedpage.number <- tclvalue(tcl(pBar,"raise")) # Retorna a página selecionada
selectedpage.number <- as.numeric(substr(selectedpage.number,5,nchar(selectedpage.number)))
selected.treatment <- treatments.sim[selectedpage.number]
Mktable <- Simlist[[selected.treatment]]
onGraph.summary.simwindow(Mktable, Alltreatmentstable, selected.treatment)
}
OnText <- function() {
StatsData <- Alltreatmentstable[ order(Alltreatmentstable$Treatment, Alltreatmentstable$Data),]
assign("StatsData", StatsData, .EnvironmentArvoRe)
Costdata <- subset(StatsData, Data == "Cost")
Effectivenessdata <- subset(StatsData, Data == "Effectiveness")
CEdata <- subset(StatsData, Data == "C/E")
statsSWindow <- tktoplevel()
title.window <- "ÁrvoRe - MC Simulação - Estatísticas"
tkwm.title(statsSWindow, title.window)
frameOverall <- tkwidget(statsSWindow, "labelframe", borderwidth = 2, relief = "groove")
frameButtons <- tkframe(statsSWindow, relief="groove", borderwidth = 0)
OnNM <- function() {
WTPVal <- as.numeric(tclvalue(WTPvar))
selected.treatment <- treatments.sim[1]
Mktable <- Simlist[[selected.treatment]]
# The NMB -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
DataCost <- apply(Mktable$Cost,2,sum, na.rm = TRUE)
DataEffectiveness <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE)
Data <- DataEffectiveness * WTPVal - DataCost
NMBtable <- data.frame( Cost = DataCost,
Effectiveness = DataEffectiveness,
NMB = Data)
namesvariables <- c(".Cost", ".Effectiveness", ".NMB")
names(NMBtable) <- paste(selected.treatment,namesvariables,sep="")
if (length(treatments.sim) > 1) {
for (i in 2:length(treatments.sim) ) {
selected.treatment <- treatments.sim[i]
Mktable <- Simlist[[selected.treatment]]
# The NMB -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
DataCost <- apply(Mktable$Cost,2,sum, na.rm = TRUE)
DataEffectiveness <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE)
Data <- DataEffectiveness * WTPVal - DataCost
newNMBtable <- data.frame( Cost = DataCost,
Effectiveness = DataEffectiveness,
NMB = Data)
names(newNMBtable) <- paste(selected.treatment,namesvariables,sep="")
# Guarda as informações importantes
NMBtable <- abind(NMBtable, newNMBtable, along=2)
}
}
Trial <- 1:length(DataCost)
NMBtable <- abind(Trial, NMBtable, along=2)
names(NMBtable) <- c("Trial", names(NMBtable))
tituloNMB <- "Estatísticas - Net Monetary Benefits"
NMBtable <- as.matrix(NMBtable)
displayInTable(NMBtable, title = tituloNMB, height=min(10,dim(NMBtable)[1]), width= min(10,dim(NMBtable)[2]),
nrow=dim(NMBtable)[1],ncol=dim(NMBtable)[2],
titlerows = FALSE, titlecols = TRUE, editable = FALSE,
returntt = FALSE)
}
OnNH <- function() {
WTPVal <- as.numeric(tclvalue(WTPvar))
selected.treatment <- treatments.sim[1]
Mktable <- Simlist[[selected.treatment]]
# The NHB -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
DataCost <- apply(Mktable$Cost,2,sum, na.rm = TRUE)
DataEffectiveness <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE)
Data <- DataEffectiveness - DataCost / WTPVal
NHBtable <- data.frame( Cost = DataCost,
Effectiveness = DataEffectiveness,
NHB = Data)
namesvariables <- c(".Cost", ".Effectiveness", ".NHB")
names(NHBtable) <- paste(selected.treatment,namesvariables,sep="")
if (length(treatments.sim) > 1) {
for (i in 2:length(treatments.sim) ) {
selected.treatment <- treatments.sim[i]
Mktable <- Simlist[[selected.treatment]]
# The NMB -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
DataCost <- apply(Mktable$Cost,2,sum, na.rm = TRUE)
DataEffectiveness <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE)
Data <- DataEffectiveness - DataCost / WTPVal
newNHBtable <- data.frame( Cost = DataCost,
Effectiveness = DataEffectiveness,
NHB = Data)
names(newNHBtable) <- paste(selected.treatment,namesvariables,sep="")
# Guarda as informações importantes
NHBtable <- abind(NHBtable, newNHBtable, along=2)
}
}
Trial <- 1:length(DataCost)
NHBtable <- abind(Trial, NHBtable, along=2)
names(NHBtable) <- c("Trial", names(NHBtable))
tituloNHB <- "Estatísticas - Rede de Benefício Saúde (NHB)"
NHBtable <- as.matrix(NHBtable)
displayInTable(NHBtable, title = tituloNHB, height=min(10,dim(NHBtable)[1]), width= min(10,dim(NHBtable)[2]),
nrow=dim(NHBtable)[1],ncol=dim(NHBtable)[2],
titlerows = FALSE, titlecols = TRUE, editable = FALSE,
returntt = FALSE)
}
OnCE <- function() {
selected.treatment <- treatments.sim[1]
Mktable <- Simlist[[selected.treatment]]
# The CE -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
DataCost <- apply(Mktable$Cost,2,sum, na.rm = TRUE)
DataEffectiveness <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE)
CEtable <- data.frame( Cost = DataCost,
Effectiveness = DataEffectiveness,
CE = DataCost / DataEffectiveness)
namesvariables <- c(".Cost", ".Effectiveness", ".CE")
names(CEtable) <- paste(selected.treatment,namesvariables,sep="")
if (length(treatments.sim) > 1) {
for (i in 2:length(treatments.sim) ) {
selected.treatment <- treatments.sim[i]
Mktable <- Simlist[[selected.treatment]]
# The CE -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
DataCost <- apply(Mktable$Cost,2,sum, na.rm = TRUE)
DataEffectiveness <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE)
newCEtable <- data.frame( Cost = DataCost,
Effectiveness = DataEffectiveness,
CE = DataCost / DataEffectiveness)
names(newCEtable) <- paste(selected.treatment,namesvariables,sep="")
# Guarda as informações importantes
CEtable <- abind(CEtable, newCEtable, along=2)
}
}
Trial <- 1:length(DataCost)
CEtable <- abind(Trial, CEtable, along=2)
names(CEtable) <- c("Trial", names(CEtable))
tituloCE <- "Estatísticas - Análise de Custo-Efetividade"
CEtable <- as.matrix(CEtable)
displayInTable(CEtable, title = tituloCE, height=min(10,dim(CEtable)[1]), width= min(10,dim(CEtable)[2]),
nrow=dim(CEtable)[1],ncol=dim(CEtable)[2],
titlerows = FALSE, titlecols = TRUE, editable = FALSE,
returntt = FALSE)
}
label1 <- "Rede de Benefício Monetário (NMB)"
label2 <- "Rede de Benefício Saúde (NHB)"
label3 <- "Custo-Efetividade (CE)"
.Width.but <- max(nchar(c(label1, label2, label3))) + 2
.Height.but <- 1
NM.but <-tkbutton(frameOverall,text=label1, width=.Width.but, height=.Height.but, command=OnNM)
NH.but <-tkbutton(frameOverall,text=label2, width=.Width.but, height=.Height.but, command=OnNH)
CE.but <-tkbutton(frameOverall,text=label3, width=.Width.but, height=.Height.but, command=OnCE)
tkgrid(NM.but, sticky = "s", padx = 5, pady = 5)
tkgrid(NH.but, sticky = "s", padx = 5, pady = 5)
tkgrid(CE.but, sticky = "s", padx = 5, pady = 5)
WTPvar <- tclVar(0.1)
WTPValue <- tkentry(frameOverall,width="20",textvariable=WTPvar)
tkgrid(tklabel(frameOverall,text="Valor do willingness-to-pay (WTP)"),
row = 4, column = 0, columnspan = 2, sticky = "n")
tkgrid(WTPValue, row = 5, column = 0, columnspan = 2, sticky = "n")
tkgrid(tklabel(frameOverall,text=" "),
row = 6, column = 0, columnspan = 2, sticky = "n")
tkgrid( frameOverall, sticky = "n", columnspan = 2, padx = 5, pady = 5)
tkgrid( frameButtons, sticky = "s")
OnOK <- function() {
tkdestroy(statsSWindow)
tkfocus(summarysimulationWindow)
}
tkbind(statsSWindow, "<Return>",OnOK)
tkbind(statsSWindow, "<Escape>",OnOK)
OK.but <-tkbutton(frameButtons,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
# Cancel.but <-tkbutton(framebutton,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
tkgrid(OK.but, sticky = "s", columnspan = 2, padx = 5, pady = 5)
}
OnExport <- function() {
filetypeWindow <- tktoplevel()
title <- "ÁrvoRe - Exportar"
tkwm.title(filetypeWindow,title)
frameOverall <- tkframe(filetypeWindow)
frameUpper <- tkframe(frameOverall, relief="groove", borderwidth=2)
frameLower <- tkframe(frameOverall, borderwidth=2)
tkgrid(tklabel(frameUpper,text="Selecione o tipo de arquivo:"))
filetypes <- c("CSV (separado por vírgulas)","TXT (texto separado por tabulações)","Todos arquivos")
fileextensions <- c(".csv", ".txt", " ")
widthcombo <- max( nchar(filetypes) )
comboBox <- tkwidget(frameUpper,"ComboBox", width = widthcombo, editable = FALSE, values = filetypes)
tkgrid(comboBox)
OnOK <- function() {
filetypeChoice <- filetypes[as.numeric(tclvalue(tcl(comboBox,"getvalue")))+1]
fileextChoice <- fileextensions[as.numeric(tclvalue(tcl(comboBox,"getvalue")))+1]
tkdestroy(filetypeWindow)
filetypes <- paste("{{ ", filetypeChoice, "}", " {", fileextChoice, "}}", sep = "")
fileName <- tclvalue(tkgetSaveFile(filetypes=filetypes))
if (!nchar(fileName))
tkfocus(summarysimulationWindow)
else {
selectedpage.number <- tclvalue(tcl(pBar,"raise")) # Retorna a página selecionada
selectedpage.number <- as.numeric(substr(selectedpage.number,5,nchar(selectedpage.number)))
selected.treatment <- treatments.sim[selectedpage.number]
Mktable <- Simlist[[selected.treatment]]
if (tipo.nodo[selectedpage.number] == "C") {
ResumeSim <- data.frame(Cost = apply(Mktable$Cost,2,sum, na.rm = TRUE),
Effectiveness = apply(Mktable$Effectiveness,2,sum, na.rm = TRUE))
ResumeSim <- data.frame(Trial = 0:(dim(ResumeSim)[1] - 1), ResumeSim)
ans <- substr(fileName,nchar(fileName)-3,nchar(fileName))
if ( fileextChoice == ".csv" ) {
if (ans == ".csv") {
write.csv2(ResumeSim, file = fileName, row.names = FALSE)
} else {
fileName <- paste(fileName, ".csv", sep = "")
write.csv2(ResumeSim, file = fileName, row.names = FALSE)
}
}
if ( fileextChoice == ".txt" ) {
if (ans == ".txt") {
write.table(ResumeSim, file = fileName, sep = "\t")
} else {
fileName <- paste(fileName, ".txt", sep = "")
write.table(ResumeSim, file = fileName, sep = "\t")
}
}
if ( fileextChoice == " " ) {
if (ans == ".txt") {
write.table(ResumeSim, file = fileName, sep = "\t")
} else {
fileName <- paste(fileName, ".txt", sep = "")
write.table(ResumeSim, file = fileName, sep = "\t")
}
}
} else {
if (tipo.nodo[selectedpage.number] == "M") {
# Summary Coort
ResumeSim <- data.frame(Cost = apply(Mktable$Cost,2,sum, na.rm = TRUE),
Effectiveness = apply(Mktable$Effectiveness,2,sum, na.rm = TRUE))
ResumeSim <- data.frame(Individual = 1:(dim(ResumeSim)[1]), ResumeSim)
ans <- substr(fileName,nchar(fileName)-3,nchar(fileName))
if ( fileextChoice == ".csv" ) {
if (ans == ".csv") {
write.csv2(ResumeSim, file = fileName, row.names = FALSE)
} else {
fileName <- paste(fileName, ".csv", sep = "")
write.csv2(ResumeSim, file = fileName, row.names = FALSE)
}
}
if ( fileextChoice == ".txt" ) {
if (ans == ".txt") {
write.table(ResumeSim, file = fileName, sep = "\t")
} else {
fileName <- paste(fileName, ".txt", sep = "")
write.table(ResumeSim, file = fileName, sep = "\t")
}
}
if ( fileextChoice == " " ) {
if (ans == ".txt") {
write.table(ResumeSim, file = fileName, sep = "\t")
} else {
fileName <- paste(fileName, ".txt", sep = "")
write.table(ResumeSim, file = fileName, sep = "\t")
}
}
# Full detail
Cycle <- 0:(dim(Mktable$Path)[1] - 1)
ResumeSim.Cost <- data.frame( Cycle, Mktable$Cost )
ResumeSim.Effectiveness <- data.frame( Cycle, Mktable$Effectiveness )
ResumeSim.Path <- data.frame( Cycle, Mktable$Path )
# print(fileName)
ans <- substr(fileName,nchar(fileName)-3,nchar(fileName))
if ( substr(fileName,nchar(fileName)-3,nchar(fileName)-3) == "." ) {
ans.root.file.name <- substr(fileName,1,nchar(fileName)-4)
} else {
ans.root.file.name <- fileName
}
if ( fileextChoice == ".csv" ) {
if (ans == ".csv") {
# print("Estou salvando")
fileName <- paste(ans.root.file.name," Cost", ans, sep = "")
write.csv2(ResumeSim.Cost, file = fileName, row.names = FALSE)
fileName <- paste(ans.root.file.name," Effectiveness", ans, sep = "")
write.csv2(ResumeSim.Effectiveness, file = fileName, row.names = FALSE)
fileName <- paste(ans.root.file.name," Path", ans, sep = "")
write.csv2(ResumeSim.Path, file = fileName, row.names = FALSE)
} else {
# print("Estou salvando")
fileName <- paste(ans.root.file.name, " Cost", ".csv", sep = "")
write.csv2(ResumeSim.Cost, file = fileName, row.names = FALSE)
fileName <- paste(ans.root.file.name, " Effectiveness", ".csv", sep = "")
write.csv2(ResumeSim.Effectiveness, file = fileName, row.names = FALSE)
fileName <- paste(ans.root.file.name, " Path", ".csv", sep = "")
write.csv2(ResumeSim.Path, file = fileName, row.names = FALSE)
}
}
if ( fileextChoice == ".txt" ) {
if (ans == ".txt") {
write.table(ResumeSim, file = fileName, sep = "\t")
} else {
fileName <- paste(fileName, ".txt", sep = "")
write.table(ResumeSim, file = fileName, sep = "\t")
}
}
if ( fileextChoice == " " ) {
if (ans == ".txt") {
write.table(ResumeSim, file = fileName, sep = "\t")
} else {
fileName <- paste(fileName, ".txt", sep = "")
write.table(ResumeSim, file = fileName, sep = "\t")
}
}
} else {
cat("Aviso: não é possível exportar resultados para nodo Terminal")
}
}
tkfocus(summarysimulationWindow)
}
}
OnCancel <- function() {
tkdestroy(filetypeWindow)
tkfocus(summarysimulationWindow)
}
.Width.but <- 10
.Height.but <- 1
OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
Cancel.but <-tkbutton(frameLower,text="Cancelar", width=.Width.but, height=.Height.but, command=OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
tkgrid(frameUpper,sticky="nwe")
tkgrid(frameLower,sticky="nwe")
tkgrid(frameOverall)
tkbind(filetypeWindow, "<Return>",OnOK)
tkbind(filetypeWindow, "<Escape>",OnOK)
tkfocus(filetypeWindow)
}
OnStatsRep <- function() {
StatsData <- Alltreatmentstable[ order(Alltreatmentstable$Treatment, Alltreatmentstable$Data),]
assign("StatsData", StatsData, .EnvironmentArvoRe)
Costdata <- subset(StatsData, Data == "Cost")
Effectivenessdata <- subset(StatsData, Data == "Effectiveness")
CEdata <- subset(StatsData, Data == "C/E")
# print(StatsData)
statsSWindow <- tktoplevel()
title.window <- "ÁrvoRe - MC Simulação - Estatísticas"
tkwm.title(statsSWindow, title.window)
frameOverall <- tkwidget(statsSWindow, "labelframe", borderwidth = 2, relief = "groove")
frameButtons <- tkframe(statsSWindow, relief="groove", borderwidth = 0)
OnNM <- function() {
WTPVal <- as.numeric(tclvalue(WTPvar))
NMBtable <- data.frame(Treatment = array(,0), Mean = array(,0),
Variance = array(,0), Sd = array(,0), Median = array(,0),
Min = array(,0), Max = array(,0),
Quartil1 = array(,0), Quartil2 = array(,0))
for (i in 1:length(treatments.sim) ) {
selected.treatment <- treatments.sim[i]
Mktable <- Simlist[[selected.treatment]]
# The NMB -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
Data <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE) *
WTPVal - apply(Mktable$Cost,2,sum, na.rm = TRUE)
statisticsData <- summary(Data, na.rm = TRUE)
meanData <- statisticsData[4]
varData <- var(Data, na.rm = TRUE, use = "complete.obs")
sdData <- sqrt(varData)
medianData <- statisticsData[3]
minData <- statisticsData[1]
maxData <- statisticsData[6]
quartil1 <- statisticsData[2]
quartil3 <- statisticsData[5]
# Guarda as informações importantes
line.data.summary <- data.frame(Treatment = selected.treatment, Mean = meanData,
Variance = varData, Sd = sdData, Median = medianData,
Min = minData, Max = maxData,
Quartil1 = quartil1, Quartil2 = quartil3)
NMBtable <- abind(NMBtable, line.data.summary, along=1)
}
tituloNMB <- "Estatísticas - Rede de Benefício Monetário (NMB)"
NMBtable <- as.matrix(NMBtable)
displayInTable(NMBtable, title = tituloNMB, height=min(10,dim(NMBtable)[1]), width= min(10,dim(NMBtable)[2]),
nrow=dim(NMBtable)[1],ncol=dim(NMBtable)[2],
titlerows = FALSE, titlecols = TRUE, editable = FALSE,
returntt = FALSE)
}
OnNH <- function() {
WTPVal <- as.numeric(tclvalue(WTPvar))
NMBtable <- data.frame(Treatment = array(,0), Mean = array(,0),
Variance = array(,0), Sd = array(,0), Median = array(,0),
Min = array(,0), Max = array(,0),
Quartil1 = array(,0), Quartil2 = array(,0))
for (i in 1:length(treatments.sim) ) {
selected.treatment <- treatments.sim[i]
Mktable <- Simlist[[selected.treatment]]
# The NHB -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
Data <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE) *
apply(Mktable$Cost,2,sum, na.rm = TRUE) / WTPVal
statisticsData <- summary(Data, na.rm = TRUE)
meanData <- statisticsData[4]
varData <- var(Data, na.rm = TRUE, use = "complete.obs")
sdData <- sqrt(varData)
medianData <- statisticsData[3]
minData <- statisticsData[1]
maxData <- statisticsData[6]
quartil1 <- statisticsData[2]
quartil3 <- statisticsData[5]
# Guarda as informações importantes
line.data.summary <- data.frame(Treatment = selected.treatment, Mean = meanData,
Variance = varData, Sd = sdData, Median = medianData,
Min = minData, Max = maxData,
Quartil1 = quartil1, Quartil2 = quartil3)
NMBtable <- abind(NMBtable, line.data.summary, along=1)
}
tituloNMB <- "Estatísticas - Rede de Benefício Monetário (NMB)"
NMBtable <- as.matrix(NMBtable)
displayInTable(NMBtable, title = tituloNMB, height=min(10,dim(NMBtable)[1]), width= min(10,dim(NMBtable)[2]),
nrow=dim(NMBtable)[1],ncol=dim(NMBtable)[2],
titlerows = FALSE, titlecols = TRUE, editable = FALSE,
returntt = FALSE)
}
OnCE <- function() {
tituloCE <- "Estatísticas - Análise de Custo-Efetividade"
StatsData <- as.matrix(StatsData)
displayInTable(StatsData, title = tituloCE, height=min(10,dim(StatsData)[1]), width= min(10,dim(StatsData)[2]),
nrow=dim(StatsData)[1],ncol=dim(StatsData)[2],
titlerows = FALSE, titlecols = TRUE, editable = FALSE,
returntt = FALSE)
}
OnICER <- function(Alltreatmentstable) {
icer.sim.window(Alltreatmentstable)
}
OnINB <- function(Alltreatmentstable) {
inb.sim.window(Alltreatmentstable)
}
.Width.but <- 40
.Height.but <- 1
NM.but <-tkbutton(frameOverall,text="Rede de Benefício Monetário (NMB)", width=.Width.but, height=.Height.but, command=OnNM)
NH.but <-tkbutton(frameOverall,text="Rede de Benefício Saúde (NHB)", width=.Width.but, height=.Height.but, command=OnNH)
CE.but <-tkbutton(frameOverall,text="Custo-Efetividade (CE)", width=.Width.but, height=.Height.but, command=OnCE)
ICER.but <-tkbutton(frameOverall,text="Razão adicional de C-E (ICER)", width=.Width.but, height=.Height.but,
command= function() OnICER(StatsData))
INB.but <-tkbutton(frameOverall,text="Incremento da rede de benefícios (INB)", width=.Width.but,
height=.Height.but, command= function() OnINB(StatsData))
tkgrid(NM.but, sticky = "s", padx = 5, pady = 5)
tkgrid(NH.but, sticky = "s", padx = 5, pady = 5)
tkgrid(CE.but, sticky = "s", padx = 5, pady = 5)
tkgrid(ICER.but, sticky = "s", padx = 5, pady = 5)
tkgrid(INB.but, sticky = "s", padx = 5, pady = 5)
WTPvar <- tclVar(0.1)
WTPValue <- tkentry(frameOverall,width="20",textvariable=WTPvar)
tkgrid(tklabel(frameOverall,text="Valor do willingness-to-pay (WTP)"),
columnspan = 2, sticky = "n")
tkgrid(WTPValue, columnspan = 2, sticky = "n")
tkgrid(tklabel(frameOverall,text=" "),
columnspan = 2, sticky = "n")
tkgrid( frameOverall, sticky = "n", columnspan = 2, padx = 5, pady = 5)
tkgrid( frameButtons, sticky = "s")
OnOK <- function() {
tkdestroy(statsSWindow)
tkfocus(summarysimulationWindow)
}
tkbind(statsSWindow, "<Return>",OnOK)
tkbind(statsSWindow, "<Escape>",OnOK)
OK.but <-tkbutton(frameButtons,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
# Cancel.but <-tkbutton(framebutton,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
tkgrid(OK.but, sticky = "s", columnspan = 2, padx = 5, pady = 5)
tkfocus(statsSWindow)
}
.Width.but <- 18
.Height.but <- 1
OK.but <-tkbutton(framebutton,text="OK", width=.Width.but, height=.Height.but,
command=OnOK)
StatsRep.but <-tkbutton(framePanelButton,text="Estatísticas", width=.Width.but, height=.Height.but,
command=OnStatsRep)
Graph.but <-tkbutton(framePanelButton,text="Gráficos", width=.Width.but, height=.Height.but,
command = function() OnGraph(Mktable, Alltreatmentstable) )
TextRep.but <-tkbutton(framePanelButton,text="Relatório Texto", width=.Width.but, height=.Height.but,
command=OnText)
Export.but <-tkbutton(framePanelButton,text="Exportar Relatório", width=.Width.but, height=.Height.but,
command=OnExport)
tkbind(summarysimulationWindow, "<Return>",OnOK)
tkbind(summarysimulationWindow, "<Escape>",OnOK)
tkgrid(StatsRep.but, sticky = "s", padx = 5, pady = 5)
tkgrid(Graph.but, sticky = "s", padx = 5, pady = 5)
tkgrid(TextRep.but, sticky = "s", padx = 5, pady = 5)
tkgrid(Export.but, sticky = "s", padx = 5, pady = 5)
tkgrid(OK.but, sticky = "s", padx = 5, pady = 5)
# posiciona.janela.centro(tt, summarysimulationWindow)
tkfocus(summarysimulationWindow)
}
[Package
arvoRe version 0.1.7
Index]