[Arvore-commits] r3 - pkg/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 8 06:37:57 CEST 2008
Author: isix
Date: 2008-08-08 06:37:57 +0200 (Fri, 08 Aug 2008)
New Revision: 3
Modified:
pkg/man/ArvoRe-package.Rd
pkg/man/aceptability.sim.window.Rd
pkg/man/acewindow.Rd
pkg/man/addnodewindows.Rd
pkg/man/arvore.Rd
pkg/man/convert2matrix.Rd
pkg/man/destinynodewindows.Rd
pkg/man/dialog.simulation.window.Rd
pkg/man/dialog.variable.window.Rd
pkg/man/displayInTable.Rd
pkg/man/export.tree.graph.Rd
pkg/man/icer.sim.window.Rd
pkg/man/inb.sim.window.Rd
pkg/man/inbwindow.Rd
pkg/man/markov.coort.table.Rd
pkg/man/markov.nodes.properties.Rd
pkg/man/nodenamewindows.Rd
pkg/man/notesnodewindows.Rd
pkg/man/planoacewindow.Rd
pkg/man/plot.tree.Rd
pkg/man/probwindows.Rd
pkg/man/properties.tree.Rd
pkg/man/set.model.type.Rd
pkg/man/set.value.Rd
pkg/man/splashscreenArvoRe.Rd
pkg/man/summary.simulation.window.Rd
pkg/man/typenodewindows.Rd
pkg/man/utilitywindows.Rd
Log:
Modified: pkg/man/ArvoRe-package.Rd
===================================================================
--- pkg/man/ArvoRe-package.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/ArvoRe-package.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -15,7 +15,7 @@
Package: \tab ArvoRe\cr
Type: \tab Package\cr
Version: \tab 1.0\cr
-Date: \tab 2008-06-25\cr
+Date: \tab 2008-07-10\cr
License: \tab What license is it under?\cr
}
~~ An overview of how to use the package, including the most important ~~
Modified: pkg/man/aceptability.sim.window.Rd
===================================================================
--- pkg/man/aceptability.sim.window.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/aceptability.sim.window.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -103,14 +103,14 @@
PoinsOriginal <- 10
WTPL1Value <- tkentry(Frame1,width="20",textvariable=WTPL1var)
- tkgrid(tklabel(Frame1,text="Valor do willingness-to-pay (WTP)"),
+ tkgrid(tklabel(Frame1,text="Valor mínimo do willingness-to-pay (WTP)"),
columnspan = 2, sticky = "n")
tkgrid(WTPL1Value, columnspan = 2, sticky = "n")
tkgrid(tklabel(Frame1,text=" "),
columnspan = 2, sticky = "n")
WTPL2Value <- tkentry(Frame1,width="20",textvariable=WTPL2var)
- tkgrid(tklabel(Frame1,text="Valor do willingness-to-pay (WTP)"),
+ tkgrid(tklabel(Frame1,text="Valor máximo do willingness-to-pay (WTP)"),
columnspan = 2, sticky = "n")
tkgrid(WTPL2Value, columnspan = 2, sticky = "n")
tkgrid(tklabel(Frame1,text=" "),
@@ -118,7 +118,7 @@
### Numeric format settings ###
numericSpinBox <- tkwidget(Frame1, "SpinBox", editable=FALSE, range = c(0,100,1), width = 3)
- labeldigits <- tklabel(Frame1,text="Número de intervalor:")
+ labeldigits <- tklabel(Frame1,text="Número de intervalos:")
tkgrid(labeldigits, numericSpinBox, sticky = "nw", padx = 5, pady = 5)
tcl(numericSpinBox, "setvalue", paste("@", PoinsOriginal,sep = ""))
@@ -147,7 +147,7 @@
Data.standart.CE <- subset(Data.CEA.CE, NT == respostaListbox)
ans <- data.frame( Standart = rep(0,length(WTP)))
- names.ans <- c("Standart")
+ names.ans <- c("Padrão")
for (i in 1:dim(Data.alternative.Cost)[1]) {
@@ -156,7 +156,7 @@
var.inb <- ( WTP^2
) * Data.alternative.Effectiveness$Variance[i] +
Data.alternative.Cost$Variance[i] -
- 2 * WTP * ( 00000 )
+ 2 * WTP * ( Data.alternative.Cost$CovDcDe[i] )
inb.stat.test <- inb/var.inb^0.5
Strategy <- Data.alternative.Cost$Treatment[i]
p.val.inb <- pnorm(inb.stat.test)
@@ -172,7 +172,7 @@
OnAC <- function(WTP, ACProbabilities) {
ACGraphWindow <- tktoplevel()
- title.window <- "ÁrvoRe - MC Simulação - Graphics"
+ title.window <- "ÁrvoRe - MC Simulação - Gráficos"
tkwm.title(ACGraphWindow, title.window)
frametext <- "Gráfico"
@@ -184,8 +184,8 @@
tkgrid(frameButton, sticky = "swe")
# Image setings.
- g.imgHeight <- 600/2
- g.imgWidth <- 800/2
+ g.imgHeight <- 480
+ g.imgWidth <- 640
# Canvas window configurations
C.Height <- min(c(g.imgHeight, 768))
@@ -244,6 +244,10 @@
xlab = xlabel, ylab = ylabel, ylim = c(ylim1,ylim2))
}
}
+ smartlegend( x="right", y= "top", inset=0,
+ legend = c(treatments.label.plot),
+ fill=c(treatments.colors.plot),
+ bg = "gray")
dev.off()
} else {
if (img.type == "jpg") {
@@ -271,7 +275,11 @@
xlab = xlabel, ylab = ylabel, ylim = c(ylim1,ylim2))
}
}
-
+ smartlegend( x="right", y= "top", inset=0,
+ legend = c(treatments.label.plot),
+ fill=c(treatments.colors.plot),
+ bg = "gray")
+
dev.off()
} else {
bmp(filename = .Filename, width = img.width, height = img.height,
@@ -298,7 +306,11 @@
xlab = xlabel, ylab = ylabel, ylim = c(ylim1,ylim2))
}
}
-
+ smartlegend( x="right", y= "top", inset=0,
+ legend = c(treatments.label.plot),
+ fill=c(treatments.colors.plot),
+ bg = "gray")
+
dev.off()
}
}
@@ -446,7 +458,7 @@
OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
tkbind(exportImgGraphWindow, "<Return>",OnOK)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
+ Cancel.but <-tkbutton(frameLower,text="Cancelar", width=.Width.but, height=.Height.but, command=OnCancel)
tkbind(exportImgGraphWindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5, columnspan = 2, sticky = "s")
@@ -500,7 +512,7 @@
tkbind(ACsimtableWindow, "<Return>",OnOK)
tkbind(ACsimtableWindow, "<Escape>",OnOK)
- posiciona.janela.no.mouse(ACsimtableWindow, 250, 310)
+ posiciona.janela.no.mouse(ACsimtableWindow, 310, 310)
tkfocus(ACsimtableWindow)
Modified: pkg/man/acewindow.Rd
===================================================================
--- pkg/man/acewindow.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/acewindow.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -133,6 +133,9 @@
}
ans <- as.data.frame(ans)
+ names(ans) <- c("Procedimento", "Custo médio", "Custo adicional", "Efetividade média",
+ "Efetividade adicional", "Razão C-E", "ICER")
+
displayInTable(as.matrix(ans), title="Análise de Custo-Efetividade",
height=10,width=8,nrow=dim(ans)[1],ncol=dim(ans)[2],
titlerows = FALSE, titlecols = TRUE, returntt = FALSE)
Modified: pkg/man/addnodewindows.Rd
===================================================================
--- pkg/man/addnodewindows.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/addnodewindows.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -53,7 +53,7 @@
title <- "ÁrvoRe - Novo Nodo"
tkwm.title(addnodeWindow,title)
- NomeVar <- tclVar("New Node")
+ NomeVar <- tclVar("Novo Nodo")
NomeEntryWidget <- tkentry(addnodeWindow,width="20",textvariable=NomeVar)
tkgrid(tklabel(addnodeWindow,text="Nome do nodo"))
tkgrid(NomeEntryWidget)
@@ -124,7 +124,7 @@
tkfocus(tt)
}
- Cancel.but <-tkbutton(addnodeWindow,text=" Cancel ",command=OnCancel)
+ Cancel.but <-tkbutton(addnodeWindow,text=" Cancelar ",command=OnCancel)
tkbind(addnodeWindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
Modified: pkg/man/arvore.Rd
===================================================================
--- pkg/man/arvore.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/arvore.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -190,7 +190,7 @@
tkadd(analysisMenu,"separator")
tkadd(analysisMenu,"command",label="Resumo da ACE (ICER)...",command=function() acewindow(TheTree))
tkadd(analysisMenu,"command",label="Plano Custo-Efetividade",command=function() planoacewindow(TheTree))
- tkadd(analysisMenu,"command",label="Net Benefit (INB)",command=function() inbwindow(TheTree))
+ tkadd(analysisMenu,"command",label="Rede de Benefício (INB)",command=function() inbwindow(TheTree))
tkadd(analysisMenu,"separator")
tkadd(analysisMenu,"command",label="Resumo da árvore",command=function() show.summary.tree.window())
tkadd(analysisMenu,"separator")
Modified: pkg/man/convert2matrix.Rd
===================================================================
--- pkg/man/convert2matrix.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/convert2matrix.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -109,7 +109,16 @@
}
}
+ x <- as.matrix(x)
+ y <- as.matrix(y)
+ probMAT <- as.matrix(probMAT)
+ typeMAT <- as.matrix(typeMAT)
+ effectivenessMAT <- as.matrix(effectivenessMAT)
+ utilityMAT <- as.matrix(utilityMAT)
+ destinyMAT <- as.matrix(destinyMAT)
+
# ordena as matrizes para nao haver problema com a plot.tree - June 21, 2008
+if(dim(x)[1] != 1) {
for (i in 1:dim(x)[2]) {
if ( sum(is.na(x[,i])) == 0 ) { # whatcolorder <- c(whatcolorder, i)
y <- y[order(x[,i]),]
@@ -121,6 +130,7 @@
x <- x[order(x[,i]),]
}
}
+ }
x <- as.matrix(x)
y <- as.matrix(y)
@@ -144,7 +154,6 @@
rownames(utilityMAT) <- NULL
colnames(destinyMAT) <- NULL
rownames(destinyMAT) <- NULL
-
dl <- dim(destinyMAT)[1]
destinyarray <- array(0,dl)
for (i in 1:dl) {
Modified: pkg/man/destinynodewindows.Rd
===================================================================
--- pkg/man/destinynodewindows.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/destinynodewindows.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -110,9 +110,9 @@
tkfocus(tt)
}
- OK.but <-tkbutton(destinyWindow,text=" OK ",command=OnOK)
+ OK.but <-tkbutton(destinyWindow,text=" OK ",command=OnOK)
tkbind(destinyWindow, "<Return>",OnOK)
- Cancel.but <-tkbutton(destinyWindow,text=" Cancel ",command=OnCancel)
+ Cancel.but <-tkbutton(destinyWindow,text=" Cancelar ",command=OnCancel)
tkbind(destinyWindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
Modified: pkg/man/dialog.simulation.window.Rd
===================================================================
--- pkg/man/dialog.simulation.window.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/dialog.simulation.window.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -66,7 +66,7 @@
if (node.type == "M") {
############ MARKOV ############
dialogsimulationwindow <- tktoplevel()
- title <- "ÁrvoRe - Markov Simulation"
+ title <- "ÁrvoRe - Simulação Markov"
tkwm.title(dialogsimulationwindow,title)
Seedvar <- tclVar(0)
@@ -132,7 +132,7 @@
}
}
- OK.but <-tkbutton(dialogsimulationwindow,text=" OK ",command=OnOK)
+ OK.but <-tkbutton(dialogsimulationwindow,text=" OK ",command=OnOK)
tkbind(Seed.Value, "<Return>",OnOK)
tkbind(Individuos.Value, "<Return>",OnOK)
@@ -144,7 +144,7 @@
tkfocus(tt)
}
- Cancel.but <-tkbutton(dialogsimulationwindow, text=" Cancel ", command=OnCancel)
+ Cancel.but <-tkbutton(dialogsimulationwindow, text=" Cancelar ", command=OnCancel)
tkbind(dialogsimulationwindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
@@ -155,7 +155,7 @@
if (node.type == "D") {
############ DECISION ############
dialogsimulationwindow <- tktoplevel()
- title <- "ÁrvoRe - Markov Simulation"
+ title <- "ÁrvoRe - Simulação Markov"
tkwm.title(dialogsimulationwindow,title)
Seedvar <- tclVar(0)
@@ -289,7 +289,7 @@
}
}
- OK.but <-tkbutton(dialogsimulationwindow,text=" OK ",command=OnOK)
+ OK.but <-tkbutton(dialogsimulationwindow,text=" OK ",command=OnOK)
tkbind(Seed.Value, "<Return>",OnOK)
tkbind(Individuos.Value, "<Return>",OnOK)
@@ -301,7 +301,7 @@
tkfocus(tt)
}
- Cancel.but <-tkbutton(dialogsimulationwindow, text=" Cancel ", command=OnCancel)
+ Cancel.but <-tkbutton(dialogsimulationwindow, text=" Cancelar ", command=OnCancel)
tkbind(dialogsimulationwindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
@@ -312,7 +312,7 @@
if (node.type == "C") {
############ CHANCE ############
dialogsimulationwindow <- tktoplevel()
- title <- "ÁrvoRe - Markov Simulation"
+ title <- "ÁrvoRe - Simulação Markov"
tkwm.title(dialogsimulationwindow,title)
Seedvar <- tclVar(0)
@@ -375,7 +375,7 @@
}
}
- OK.but <-tkbutton(dialogsimulationwindow,text=" OK ",command=OnOK)
+ OK.but <-tkbutton(dialogsimulationwindow,text=" OK ",command=OnOK)
tkbind(Seed.Value, "<Return>",OnOK)
tkbind(Trialss.Value, "<Return>",OnOK)
@@ -387,7 +387,7 @@
tkfocus(tt)
}
- Cancel.but <-tkbutton(dialogsimulationwindow, text=" Cancel ", command=OnCancel)
+ Cancel.but <-tkbutton(dialogsimulationwindow, text=" Cancelar ", command=OnCancel)
tkbind(dialogsimulationwindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
Modified: pkg/man/dialog.variable.window.Rd
===================================================================
--- pkg/man/dialog.variable.window.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/dialog.variable.window.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -166,7 +166,7 @@
.Height.but <- 1
OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOkAdd)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCanceladd)
+ Cancel.but <-tkbutton(frameLower,text="Cancelar", width=.Width.but, height=.Height.but, command=OnCanceladd)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
@@ -310,7 +310,7 @@
.Height.but <- 1
OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOkAdd)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCanceladd)
+ Cancel.but <-tkbutton(frameLower,text="Cancelar", width=.Width.but, height=.Height.but, command=OnCanceladd)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
Modified: pkg/man/displayInTable.Rd
===================================================================
--- pkg/man/displayInTable.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/displayInTable.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -190,7 +190,7 @@
.Height.but <- 1
OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
+ 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)
Modified: pkg/man/export.tree.graph.Rd
===================================================================
--- pkg/man/export.tree.graph.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/export.tree.graph.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -175,7 +175,7 @@
OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
tkbind(exportgraphWindow, "<Return>",OnOK)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
+ Cancel.but <-tkbutton(frameLower,text="Cancelar", width=.Width.but, height=.Height.but, command=OnCancel)
tkbind(exportgraphWindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5, columnspan = 2, sticky = "s")
Modified: pkg/man/icer.sim.window.Rd
===================================================================
--- pkg/man/icer.sim.window.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/icer.sim.window.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -110,6 +110,27 @@
Data.alternative.CE <- subset(Data.CEA.CE, NT != respostaListbox)
Data.standart.CE <- subset(Data.CEA.CE, NT == respostaListbox)
+# print(Data.alternative.Cost)
+# print(Data.standart.Cost)
+# print(Data.alternative.Effectiveness)
+# print(Data.standart.Effectiveness)
+# print(Data.alternative.CE)
+# print(Data.standart.CE)
+
+# Data.alternative.Cost$Mean <- as.numeric(as.character(Data.alternative.Cost$Mean))
+# Data.alternative.Effectiveness$Mean <- as.numeric(as.character(Data.alternative.Effectiveness$Mean))
+# Data.alternative.Cost$Variance <- as.numeric(as.character(Data.alternative.Cost$Variance))
+# Data.alternative.Effectiveness$Variance <- as.numeric(as.character(Data.alternative.Effectiveness$Variance))
+# Data.alternative.Cost$CovDcDe <- as.numeric(as.character(Data.alternative.Cost$CovDcDe))
+# Data.alternative.Effectiveness$CovDcDe <- as.numeric(as.character(Data.alternative.Effectiveness$CovDcDe))
+# Data.standart.Cost$Mean <- as.numeric(as.character(Data.standart.Cost$Mean))
+# Data.standart.Effectiveness$Mean <- as.numeric(as.character(Data.standart.Effectiveness$Mean))
+# Data.standart.Cost$Variance <- as.numeric(as.character(Data.standart.Cost$Variance))
+# Data.standart.Effectiveness$Variance <- as.numeric(as.character(Data.standart.Effectiveness$Variance))
+# Data.standart.Cost$CovDcDe <- as.numeric(as.character(Data.standart.Cost$CovDcDe))
+# Data.standart.Effectiveness$CovDcDe <- as.numeric(as.character(Data.standart.Effectiveness$CovDcDe))
+
+
ans <- data.frame( Strategy = Data.standart.Cost$Treatment[1],
Cost = Data.standart.Cost$Mean[1],
Incr.Cost = NA,
@@ -125,18 +146,32 @@
for (i in 1:dim(Data.alternative.Cost)[1]) {
+ ans$Strategy <- as.character(ans$Strategy)
+ ans$Cost <- as.numeric(as.character(ans$Cost))
+ ans$Incr.Cost <- as.numeric(as.character(ans$Incr.Cost))
+ ans$Effectiveness <- as.numeric(as.character(ans$Effectiveness))
+ ans$Incr.Eff. <- as.numeric(as.character(ans$Incr.Eff.))
+ ans$CE.ratio <- as.numeric(as.character(ans$CE.ratio))
+ ans$ICER <- as.numeric(as.character(ans$ICER))
+ ans$Var.ICER <- as.numeric(as.character(ans$Var.ICER))
+ ans$Sd.ICER <- as.numeric(as.character(ans$Sd.ICER))
+ ans$LL_IC95 <- as.numeric(as.character(ans$LL_IC95))
+ ans$UL_IC95 <- as.numeric(as.character(ans$UL_IC95))
+
+
icer <- (Data.alternative.Cost$Mean[i] - Data.standart.Cost$Mean[1]) /
(Data.alternative.Effectiveness$Mean[i] - Data.standart.Effectiveness$Mean[1])
- var.icer <- ( icer
- ) *
- (
- ( Data.alternative.Effectiveness$Variance[i] / Data.alternative.Effectiveness$Mean[i]^2 ) +
- ( Data.alternative.Cost$Variance[i] / Data.alternative.Cost$Mean[i]^2 ) -
- 2 * ( 00000 ) /
+ var.icer <- ( icer ) * (
+ ( Data.alternative.Effectiveness$Variance[i] / Data.alternative.Effectiveness$Mean[i]^2 ) +
+ ( Data.alternative.Cost$Variance[i] / Data.alternative.Cost$Mean[i]^2 ) -
+ 2 * ( Data.alternative.Cost$CovDcDe[i] ) /
( Data.alternative.Effectiveness$Mean[i] / Data.alternative.Cost$Mean[i] )
)
+ print(var.icer)
+ var.icer <- as.numeric(as.character(var.icer))
+
ans.line <- data.frame( Strategy = Data.alternative.Cost$Treatment[i],
Cost = Data.alternative.Cost$Mean[i],
Incr.Cost = Data.alternative.Cost$Mean[i] - Data.standart.Cost$Mean[1],
@@ -145,11 +180,12 @@
CE.ratio = Data.alternative.Cost$Mean[i] / Data.alternative.Effectiveness$Mean[i],
ICER = icer,
Var.ICER = var.icer,
- Sd.ICER = var.icer^0.5,
+ Sd.ICER = (var.icer)^(1/2),
LL_IC95 = icer - qnorm(1 - 0.05/2) * var.icer^0.5,
UL_IC95 = icer + qnorm(1 - 0.05/2) * var.icer^0.5
)
- ans <- abind(ans, ans.line, along = 1)
+ ans <- rbind(ans, ans.line) #, along = 1)
+ ans <- as.data.frame(ans)
}
ans <- as.data.frame(ans)
@@ -159,6 +195,7 @@
displayInTable(as.matrix(ans), title="ICER - Análise de Custo-Efetividade",
height=10,width=8,nrow=dim(ans)[1],ncol=dim(ans)[2],
titlerows = FALSE, titlecols = TRUE, returntt = FALSE)
+ rm(ans)
}
OnCancel <- function() {
Modified: pkg/man/inb.sim.window.Rd
===================================================================
--- pkg/man/inb.sim.window.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/inb.sim.window.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -113,7 +113,7 @@
OnOK <- function() {
respostaListbox <- n.treat[as.numeric(tkcurselection(tl))+1]
- WTPVal <- as.integer(tclvalue(WTPvar))
+ WTPVal <- as.numeric(tclvalue(WTPvar))
Data.alternative.Cost <- subset(Data.CEA.Cost, NT != respostaListbox)
Data.standart.Cost <- subset(Data.CEA.Cost, NT == respostaListbox)
@@ -142,7 +142,7 @@
var.inb <- ( WTPVal^2
) * Data.alternative.Effectiveness$Variance[i] +
Data.alternative.Cost$Variance[i] -
- 2 * WTPVal * ( 00000 )
+ 2 * WTPVal * ( Data.alternative.Cost$CovDcDe[i] )
alfa <- 0.05 # the significance
ans.line <- data.frame( Strategy = Data.alternative.Cost$Treatment[i],
@@ -164,7 +164,7 @@
# print(ans)
- displayInTable(as.matrix(ans), title="ICER - Análise de Custo-Efetividade",
+ displayInTable(as.matrix(ans), title="INB - Análise de Custo-Efetividade",
height=10,width=8,nrow=dim(ans)[1],ncol=dim(ans)[2],
titlerows = FALSE, titlecols = TRUE, returntt = FALSE)
}
Modified: pkg/man/inbwindow.Rd
===================================================================
--- pkg/man/inbwindow.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/inbwindow.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -37,6 +37,7 @@
## The function is currently defined as
function(TheTree) {
require(abind)
+ require(gplots)
plotINBtableWindow <- tktoplevel()
title <- "ÁrvoRe - INB"
@@ -192,6 +193,10 @@
lines(wtp, inb[i,], col = treatments.colors.plot[i])
points(wtp, inb[i,], col = treatments.colors.plot[i], pch = "*")
}
+ smartlegend( x="left", y= "top", inset=0, #smartlegend parameters
+ legend = c(treatments.label.plot), #legend parameters
+ fill=c(treatments.colors.plot), #legend parameters
+ bg = "transparent")
dev.off()
} else {
if (img.type == "jpg") {
@@ -224,6 +229,11 @@
lines(wtp, inb[i,], col = treatments.colors.plot[i])
points(wtp, inb[i,], col = treatments.colors.plot[i], pch = "*")
}
+ smartlegend( x="left", y= "top", inset=0, #smartlegend parameters
+ legend = c(treatments.label.plot), #legend parameters
+ fill=c(treatments.colors.plot), #legend parameters
+ bg = "transparent")
+
dev.off()
} else {
bmp(filename = .Filename, width = img.width, height = img.height,
@@ -255,17 +265,58 @@
lines(wtp, inb[i,], col = treatments.colors.plot[i])
points(wtp, inb[i,], col = treatments.colors.plot[i], pch = "*")
}
+ smartlegend( x="left", y= "top", inset=0, #smartlegend parameters
+ legend = c(treatments.label.plot), #legend parameters
+ fill=c(treatments.colors.plot), #legend parameters
+ bg = "transparent")
+
dev.off()
}
}
}
-
+
+ build.cedata <- function() {
+ # The CEDATA
+ respostaListbox <- Data.CEA$Node.N[as.numeric(tkcurselection(tl))+1]
+ Data.alternative <- Data.CEA[Data.CEA$Node.N != respostaListbox,]
+ Data.standart <- Data.CEA[Data.CEA$Node.N == respostaListbox, ]
+
+ ans <- data.frame( Strategy = as.character(Data.standart$Node.name),
+ Cost = Data.standart$Mean.Cost,
+ Incr.Cost = 0,
+ Effectiveness = Data.standart$Mean.Effectiveness,
+ Incr.Eff = 0,
+ CE.ratio = Data.standart$Mean.Cost / Data.standart$Mean.Effectiveness,
+ ICER = NA
+ )
+
+ for (i in 1:dim(Data.alternative)[1]) {
+ ans.line <- data.frame( Strategy = as.character(Data.alternative$Node.name[i]),
+ Cost = Data.alternative$Mean.Cost[i],
+ Incr.Cost = Data.alternative$Mean.Cost[i] - Data.standart$Mean.Cost,
+ Effectiveness = Data.alternative$Mean.Effectiveness[i],
+ Incr.Eff = Data.alternative$Mean.Effectiveness[i] - Data.standart$Mean.Effectiveness,
+ CE.ratio = Data.alternative$Mean.Cost[i] / Data.alternative$Mean.Effectiveness[i],
+ ICER = ((Data.alternative$Mean.Cost[i] - Data.standart$Mean.Cost) /
+ (Data.alternative$Mean.Effectiveness[i] - Data.standart$Mean.Effectiveness))
+ )
+ ans <- abind(ans, ans.line, along = 1)
+
+ }
+ ans <- as.data.frame(ans)
+# print(ans)
+
+ ans$Incr.Cost <- as.numeric(as.character(ans$Incr.Cost))
+ ans$Incr.Eff <- as.numeric(as.character(ans$Incr.Eff))
+ ans$Strategy <- as.character(ans$Strategy)
+ return(ans)
+ }
# The CEDATA
respostaListbox <- Data.CEA$Node.N[as.numeric(tkcurselection(tl))+1]
Data.alternative <- Data.CEA[Data.CEA$Node.N != respostaListbox,]
Data.standart <- Data.CEA[Data.CEA$Node.N == respostaListbox, ]
- ans <- data.frame( Strategy = Data.standart$Node.name,
+ ans <- data.frame( Strategy = as.character(Data.standart$Node.name),
Cost = Data.standart$Mean.Cost,
Incr.Cost = 0,
Effectiveness = Data.standart$Mean.Effectiveness,
@@ -275,7 +326,7 @@
)
for (i in 1:dim(Data.alternative)[1]) {
- ans.line <- data.frame( Strategy = Data.alternative$Node.name[i],
+ ans.line <- data.frame( Strategy = as.character(Data.alternative$Node.name[i]),
Cost = Data.alternative$Mean.Cost[i],
Incr.Cost = Data.alternative$Mean.Cost[i] - Data.standart$Mean.Cost,
Effectiveness = Data.alternative$Mean.Effectiveness[i],
@@ -292,10 +343,11 @@
ans$Incr.Cost <- as.numeric(as.character(ans$Incr.Cost))
ans$Incr.Eff <- as.numeric(as.character(ans$Incr.Eff))
-
+ ans$Strategy <- as.character(ans$Strategy)
+
# end CEDATA
- plot.it.to.image(WTParray, ans, treatments.colors.plot, treatments.label.plot,
+ plot.it.to.image(WTParray, ans, treatments.colors.plot, treatments.label.plot = ans$Strategy,
.Filename = .Filename, img.type = img.type,
img.width = g.imgWidth, img.height = g.imgHeight)
@@ -304,163 +356,239 @@
tkcreate(fCanvas, "image", g.imgWidth/2, g.imgHeight/2, image = image1, anchor = "center")
tkconfigure(fCanvas, scrollregion = c(0,0,g.imgWidth,g.imgHeight))
- OnExportGraphic <- function(...) {
- exportImgGraphWindow <- tktoplevel()
- title <- "ÁrvoRe - Exportar Imagem"
- tkwm.title(exportImgGraphWindow,title)
+ OnExportGraphic <- function() {
- framePlot <- tkframe(exportImgGraphWindow)
- frameUpper <- tkframe(framePlot, relief="groove", borderwidth=0)
- frameUpperLeft <- tkframe(frameUpper, relief="groove", borderwidth=2)
- frameUpperRigth <- tkframe(frameUpper, relief="groove", borderwidth=2)
- frameLower <- tkframe(framePlot, relief="groove", borderwidth=0)
+ LIVal <- as.numeric(tclvalue(LIvar))
+# print(LIVal)
+ LSVal <- as.numeric(tclvalue(LSvar))
+# print(LSVal)
+ NPVal <- as.numeric(tclvalue(NPvar))
+# print(NPVal)
- tkgrid( tklabel(frameUpper,text="Formato de imagem"),sticky="n", columnspan = 2)
+ do.it <- TRUE
+ if ( !(is.numeric(LIVal)) || (is.na(LIVal)) ) {
+ do.it <- FALSE
+ msg <- paste("O valor fornecido para o limite inferior não é válido.")
+ tkmessageBox(message=msg)
+ tkfocus(plotINBtableWindow)
+ }
+ if ( !(is.numeric(LSVal)) || (is.na(LSVal)) ) {
+ do.it <- FALSE
+ msg <- paste("O valor fornecido para o limite superior não é válido.")
+ tkmessageBox(message=msg)
+ tkfocus(plotINBtableWindow)
+ }
+ if ( !do.it && ( LIVal > LSVal )) {
+ do.it <- FALSE
+ msg <- paste("O limite inferior deve ser menor que o limite superior.")
+ tkmessageBox(message=msg)
+ tkfocus(plotINBtableWindow)
+ }
+ if ( !(is.numeric(NPVal)) || (is.na(NPVal)) || (NPVal < 2) ) {
+ do.it <- FALSE
+ NPVal <- as.integer(NPVal)
+ msg <- paste("O valor fornecido para o número de intervalos não é válido.")
+ tkmessageBox(message=msg)
+ tkfocus(plotINBtableWindow)
+ }
+
+ if (do.it) {
+ file.remove(.Filename)
+ WTParray <- seq(LIVal, LSVal, round( (LSVal - LIVal ) / NPVal))
+
+ respostaListbox <- Data.CEA$Node.N[as.numeric(tkcurselection(tl))+1]
+
+ Data.alternative <- Data.CEA[Data.CEA$Node.N != respostaListbox,]
+ Data.standart <- Data.CEA[Data.CEA$Node.N == respostaListbox, ]
+
+ ans <- data.frame( Strategy = Data.standart$Node.name,
+ Cost = Data.standart$Mean.Cost,
+ Incr.Cost = 0,
+ Effectiveness = Data.standart$Mean.Effectiveness,
+ Incr.Eff = 0,
+ CE.ratio = Data.standart$Mean.Cost / Data.standart$Mean.Effectiveness,
+ ICER = NA
+ )
- rbValue <- tclVar("jpg")
- QualityValue <- tclVar("90")
-
- rb1 <- tkradiobutton(frameUpper)
- tkconfigure(rb1,variable=rbValue,value="bmp")
- tkgrid( tklabel(frameUpperLeft,text="Bitmap .bmp "),rb1, sticky = "ne")
-
- rb2 <- tkradiobutton(frameUpper)
- tkconfigure(rb2,variable=rbValue,value="jpg")
- tkgrid( tklabel(frameUpperLeft,text="Jpeg .jpg "),rb2, sticky = "ne")
-
- rb3 <- tkradiobutton(frameUpper)
- tkconfigure(rb3,variable=rbValue,value="png")
- tkgrid( tklabel(frameUpperLeft,text="Portable network graphics .png "),rb3, sticky = "ne")
-
- SliderValueLabel <- tklabel(frameUpperRigth, text = as.character(tclvalue(QualityValue)) )
- sliderlabel <- tklabel(frameUpperRigth, text = "Valor da qualidade de imagem : ")
- sliderlabel2 <- tklabel(frameUpperRigth,text = "\%")
- tkgrid(sliderlabel, SliderValueLabel, sliderlabel2)
- tkconfigure(SliderValueLabel, textvariable = QualityValue)
- sliderImg <- tkscale(frameUpperRigth, from = 100, to = 1,
- showvalue = F, variable = QualityValue,
- resolution = 1, orient = "horizontal")
- tkgrid(sliderImg,sticky="ew")
-
- ### Image size settings ###
- numericSpinBox <- tkwidget(frameUpperRigth, "SpinBox", editable=TRUE, range = c(100,10000,1), width = 5)
- labeldigits <- tklabel(frameUpperRigth,text="Altura da imagem")
- tkgrid(labeldigits, numericSpinBox, sticky = "nw", padx = 5, pady = 5)
- tcl(numericSpinBox, "setvalue", paste("@", g.imgHeight,sep = ""))
-
- numericSpinBox2 <- tkwidget(frameUpperRigth, "SpinBox", editable=TRUE, range = c(100,10000,1), width = 5)
- labeldigits <- tklabel(frameUpperRigth,text="Largura da imagem")
- tkgrid(labeldigits, numericSpinBox2, sticky = "nw", padx = 5, pady = 5)
- tcl(numericSpinBox2, "setvalue", paste("@", g.imgWidth,sep = ""))
-
- tkgrid(frameUpperLeft, frameUpperRigth,sticky="ns")
- tkgrid(frameUpper,sticky="ns")
- tkgrid(frameLower,sticky="ns")
-
- Onformat <- function() {
- ansVar <- as.character(tclvalue(rbValue))
- if (ansVar != "jpg") {
- tkconfigure(SliderValueLabel, state = "disabled")
- tkconfigure(sliderlabel, state = "disabled")
- tkconfigure(sliderlabel2, state = "disabled")
- tkconfigure(SliderValueLabel, state = "disabled")
- tkconfigure(sliderImg, state = "disabled")
- } else {
- tkconfigure(SliderValueLabel, state = "normal")
- tkconfigure(sliderlabel, state = "normal")
- tkconfigure(sliderlabel2, state = "normal")
- tkconfigure(SliderValueLabel, state = "normal")
- tkconfigure(sliderImg, state = "normal")
+ for (i in 1:dim(Data.alternative)[1]) {
+ ans.line <- data.frame( Strategy = Data.alternative$Node.name[i],
+ Cost = Data.alternative$Mean.Cost[i],
+ Incr.Cost = Data.alternative$Mean.Cost[i] - Data.standart$Mean.Cost,
+ Effectiveness = Data.alternative$Mean.Effectiveness[i],
+ Incr.Eff = Data.alternative$Mean.Effectiveness[i] - Data.standart$Mean.Effectiveness,
+ CE.ratio = Data.alternative$Mean.Cost[i] / Data.alternative$Mean.Effectiveness[i],
+ ICER = ((Data.alternative$Mean.Cost[i] - Data.standart$Mean.Cost) /
+ (Data.alternative$Mean.Effectiveness[i] - Data.standart$Mean.Effectiveness))
+ )
+ ans <- abind(ans, ans.line, along = 1)
+
}
- }
+ cedata <- as.data.frame(ans)
+ # print(ans)
- OnOK <- function(...)
- {
- img.height <- as.numeric(tclvalue(tcl(numericSpinBox,"getvalue")))
- if ((is.numeric(img.height) )&&(!is.na(img.height))) g.imgHeight <- img.height
+ cedata$Incr.Cost <- as.numeric(as.character(cedata$Incr.Cost))
+ cedata$Incr.Eff <- as.numeric(as.character(cedata$Incr.Eff))
+ cedata$Strategy <- as.character(cedata$Strategy)
- img.width <- as.numeric(tclvalue(tcl(numericSpinBox2,"getvalue")))
- if ((is.numeric(img.width) )&&(!is.na(img.width))) g.imgWidth <- img.width
+# print(cedata)
- ImgFormatselected <- as.character(tclvalue(rbValue))
- ImgQualityselected <- as.numeric(as.character(tclvalue(QualityValue)))
- if (ImgFormatselected == "png") {
- .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Portable network graphics Image Files} {.png}} {{All files} *}"))
- if (!nchar(.Filename))
- tkfocus(plotINBtableWindow)
- else {
- ans <- substr(.Filename,nchar(.Filename)-3,nchar(.Filename))
- if ( ans != ".png" ) .Filename <- paste(.Filename, ".png", sep="")
-
- if (!file.exists(.Filename)) file.remove(.Filename)
+ exportImgGraphWindow <- tktoplevel()
+ title <- "ÁrvoRe - Exportar Imagem"
+ tkwm.title(exportImgGraphWindow,title)
+
+ framePlot <- tkframe(exportImgGraphWindow)
+ frameUpper <- tkframe(framePlot, relief="groove", borderwidth=0)
+ frameUpperLeft <- tkframe(frameUpper, relief="groove", borderwidth=2)
+ frameUpperRigth <- tkframe(frameUpper, relief="groove", borderwidth=2)
+ frameLower <- tkframe(framePlot, relief="groove", borderwidth=0)
+
+ tkgrid( tklabel(frameUpper,text="Formato de imagem"),sticky="n", columnspan = 2)
- plot.it.to.image(wtp, cedata, treatments.colors.plot, treatments.label.plot,
- .Filename = .Filename, img.type = ImgFormatselected,
- img.width = g.imgWidth, img.height = g.imgHeight)
+ rbValue <- tclVar("jpg")
+ QualityValue <- tclVar("90")
+
+ rb1 <- tkradiobutton(frameUpper)
+ tkconfigure(rb1,variable=rbValue,value="bmp")
+ tkgrid( tklabel(frameUpperLeft,text="Bitmap .bmp "),rb1, sticky = "ne")
+
+ rb2 <- tkradiobutton(frameUpper)
+ tkconfigure(rb2,variable=rbValue,value="jpg")
+ tkgrid( tklabel(frameUpperLeft,text="Jpeg .jpg "),rb2, sticky = "ne")
+
+ rb3 <- tkradiobutton(frameUpper)
+ tkconfigure(rb3,variable=rbValue,value="png")
+ tkgrid( tklabel(frameUpperLeft,text="Portable network graphics .png "),rb3, sticky = "ne")
+
+ SliderValueLabel <- tklabel(frameUpperRigth, text = as.character(tclvalue(QualityValue)) )
+ sliderlabel <- tklabel(frameUpperRigth, text = "Valor da qualidade de imagem : ")
+ sliderlabel2 <- tklabel(frameUpperRigth,text = "\%")
+ tkgrid(sliderlabel, SliderValueLabel, sliderlabel2)
+ tkconfigure(SliderValueLabel, textvariable = QualityValue)
+ sliderImg <- tkscale(frameUpperRigth, from = 100, to = 1,
+ showvalue = F, variable = QualityValue,
+ resolution = 1, orient = "horizontal")
+ tkgrid(sliderImg,sticky="ew")
+
+ ### Image size settings ###
+ numericSpinBox <- tkwidget(frameUpperRigth, "SpinBox", editable=TRUE, range = c(100,10000,1), width = 5)
+ labeldigits <- tklabel(frameUpperRigth,text="Altura da imagem")
+ tkgrid(labeldigits, numericSpinBox, sticky = "nw", padx = 5, pady = 5)
+ tcl(numericSpinBox, "setvalue", paste("@", g.imgHeight,sep = ""))
+
+ numericSpinBox2 <- tkwidget(frameUpperRigth, "SpinBox", editable=TRUE, range = c(100,10000,1), width = 5)
+ labeldigits <- tklabel(frameUpperRigth,text="Largura da imagem")
+ tkgrid(labeldigits, numericSpinBox2, sticky = "nw", padx = 5, pady = 5)
+ tcl(numericSpinBox2, "setvalue", paste("@", g.imgWidth,sep = ""))
+
+ tkgrid(frameUpperLeft, frameUpperRigth,sticky="ns")
+ tkgrid(frameUpper,sticky="ns")
+ tkgrid(frameLower,sticky="ns")
+
+ Onformat <- function() {
+ ansVar <- as.character(tclvalue(rbValue))
+ if (ansVar != "jpg") {
+ tkconfigure(SliderValueLabel, state = "disabled")
+ tkconfigure(sliderlabel, state = "disabled")
+ tkconfigure(sliderlabel2, state = "disabled")
+ tkconfigure(SliderValueLabel, state = "disabled")
+ tkconfigure(sliderImg, state = "disabled")
+ } else {
+ tkconfigure(SliderValueLabel, state = "normal")
+ tkconfigure(sliderlabel, state = "normal")
+ tkconfigure(sliderlabel2, state = "normal")
+ tkconfigure(SliderValueLabel, state = "normal")
+ tkconfigure(sliderImg, state = "normal")
}
- } else {
- if (ImgFormatselected == "jpg") {
- .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Jpeg Image Files} {.jpg}} {{All files} *}"))
+ }
+
+ OnOK <- function(...)
+ {
+ img.height <- as.numeric(tclvalue(tcl(numericSpinBox,"getvalue")))
+ if ((is.numeric(img.height) )&&(!is.na(img.height))) g.imgHeight <- img.height
+
+ img.width <- as.numeric(tclvalue(tcl(numericSpinBox2,"getvalue")))
+ if ((is.numeric(img.width) )&&(!is.na(img.width))) g.imgWidth <- img.width
+
+ ImgFormatselected <- as.character(tclvalue(rbValue))
+ ImgQualityselected <- as.numeric(as.character(tclvalue(QualityValue)))
+ if (ImgFormatselected == "png") {
+ .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Portable network graphics Image Files} {.png}} {{All files} *}"))
if (!nchar(.Filename))
tkfocus(plotINBtableWindow)
else {
ans <- substr(.Filename,nchar(.Filename)-3,nchar(.Filename))
- if ( ans != ".jpg" ) .Filename <- paste(.Filename, ".jpg", sep="")
-
- if (!file.exists(.Filename)) file.remove(.Filename)
+ if ( ans != ".png" ) .Filename <- paste(.Filename, ".png", sep="")
- plot.it.to.image(wtp, cedata, treatments.colors.plot, treatments.label.plot,
- .Filename = .Filename, img.type = ImgFormatselected,
- img.quality = ImgQualityselected,
- img.width = g.imgWidth, img.height = g.imgHeight)
- }
- } else {
- .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Bitmap Image Files} {.bmp}} {{All files} *}"))
- if (!nchar(.Filename))
- tkfocus(plotINBtableWindow)
- else {
- ans <- substr(.Filename,nchar(.Filename)-3,nchar(.Filename))
- if ( ans != ".bmp" ) .Filename <- paste(.Filename, ".bmp", sep="")
-
if (!file.exists(.Filename)) file.remove(.Filename)
- plot.it.to.image(wtp, cedata, treatments.colors.plot, treatments.label.plot,
+ plot.it.to.image(WTParray, cedata, treatments.colors.plot, treatments.label.plot = cedata$Strategy,
.Filename = .Filename, img.type = ImgFormatselected,
img.width = g.imgWidth, img.height = g.imgHeight)
}
+ } else {
+ if (ImgFormatselected == "jpg") {
+ .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Jpeg Image Files} {.jpg}} {{All files} *}"))
+ if (!nchar(.Filename))
+ tkfocus(plotINBtableWindow)
+ else {
+ ans <- substr(.Filename,nchar(.Filename)-3,nchar(.Filename))
+ if ( ans != ".jpg" ) .Filename <- paste(.Filename, ".jpg", sep="")
+
+ if (!file.exists(.Filename)) file.remove(.Filename)
+
+ plot.it.to.image(WTParray, cedata, treatments.colors.plot, treatments.label.plot = cedata$Strategy,
+ .Filename = .Filename, img.type = ImgFormatselected,
+ img.quality = ImgQualityselected,
+ img.width = g.imgWidth, img.height = g.imgHeight)
+ }
+ } else {
+ .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Bitmap Image Files} {.bmp}} {{All files} *}"))
+ if (!nchar(.Filename))
+ tkfocus(plotINBtableWindow)
+ else {
+ ans <- substr(.Filename,nchar(.Filename)-3,nchar(.Filename))
+ if ( ans != ".bmp" ) .Filename <- paste(.Filename, ".bmp", sep="")
+
+ if (!file.exists(.Filename)) file.remove(.Filename)
+
+ plot.it.to.image(WTParray, cedata, treatments.colors.plot, treatments.label.plot = cedata$Strategy,
+ .Filename = .Filename, img.type = ImgFormatselected,
+ img.width = g.imgWidth, img.height = g.imgHeight)
+ }
+ }
}
+ tkdestroy(exportImgGraphWindow)
+ tkwm.deiconify(plotINBtableWindow)
+ tkfocus(plotINBtableWindow)
}
- tkdestroy(exportImgGraphWindow)
- tkwm.deiconify(plotINBtableWindow)
- tkfocus(plotINBtableWindow)
- }
+
+ OnCancel <- function()
+ {
+ tkdestroy(exportImgGraphWindow)
+ tkwm.deiconify(plotINBtableWindow)
+ tkfocus(plotINBtableWindow)
+ }
+
+ .Width.but <- 10
+ .Height.but <- 1
+
+ OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
+ tkbind(exportImgGraphWindow, "<Return>",OnOK)
+ Cancel.but <-tkbutton(frameLower,text="Cancelar", width=.Width.but, height=.Height.but, command=OnCancel)
+ tkbind(exportImgGraphWindow, "<Escape>",OnCancel)
+ tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5, columnspan = 2, sticky = "s")
- OnCancel <- function()
- {
- tkdestroy(exportImgGraphWindow)
- tkwm.deiconify(plotINBtableWindow)
- tkfocus(plotINBtableWindow)
+ tkbind(rb1, "<Enter>",Onformat)
+ tkbind(rb2, "<Enter>",Onformat)
+ tkbind(rb3, "<Enter>",Onformat)
+ tkbind(rb1, "<Leave>",Onformat)
+ tkbind(rb2, "<Leave>",Onformat)
+ tkbind(rb3, "<Leave>",Onformat)
+
+ tkgrid(framePlot)
+ tkfocus(exportImgGraphWindow)
+ # posiciona.janela.no.mouse(exportImgGraphWindow)
}
-
- .Width.but <- 10
- .Height.but <- 1
-
- OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
- tkbind(exportImgGraphWindow, "<Return>",OnOK)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
- tkbind(exportImgGraphWindow, "<Escape>",OnCancel)
- tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5, columnspan = 2, sticky = "s")
-
- tkbind(rb1, "<Enter>",Onformat)
- tkbind(rb2, "<Enter>",Onformat)
- tkbind(rb3, "<Enter>",Onformat)
- tkbind(rb1, "<Leave>",Onformat)
- tkbind(rb2, "<Leave>",Onformat)
- tkbind(rb3, "<Leave>",Onformat)
-
- tkgrid(framePlot)
- tkfocus(exportImgGraphWindow)
-# posiciona.janela.no.mouse(exportImgGraphWindow)
}
Build.INB <- function(wtp, cedata, to.export = FALSE) {
@@ -483,7 +611,88 @@
}
- OnExportText <- function(Original.Dada) {
+ OnExportText <- function() {
+ LIVal <- as.numeric(tclvalue(LIvar))
+# print(LIVal)
+ LSVal <- as.numeric(tclvalue(LSvar))
+# print(LSVal)
+ NPVal <- as.numeric(tclvalue(NPvar))
+# print(NPVal)
+
+ do.it <- TRUE
+ if ( !(is.numeric(LIVal)) || (is.na(LIVal)) ) {
+ do.it <- FALSE
+ msg <- paste("O valor fornecido para o limite inferior não é válido.")
+ tkmessageBox(message=msg)
+ tkfocus(plotINBtableWindow)
+ }
+ if ( !(is.numeric(LSVal)) || (is.na(LSVal)) ) {
+ do.it <- FALSE
+ msg <- paste("O valor fornecido para o limite superior não é válido.")
+ tkmessageBox(message=msg)
+ tkfocus(plotINBtableWindow)
+ }
+ if ( !do.it && ( LIVal > LSVal )) {
+ do.it <- FALSE
+ msg <- paste("O limite inferior deve ser menor que o limite superior.")
+ tkmessageBox(message=msg)
+ tkfocus(plotINBtableWindow)
+ }
+ if ( !(is.numeric(NPVal)) || (is.na(NPVal)) || (NPVal < 2) ) {
+ do.it <- FALSE
+ NPVal <- as.integer(NPVal)
+ msg <- paste("O valor fornecido para o número de intervalos não é válido.")
+ tkmessageBox(message=msg)
+ tkfocus(plotINBtableWindow)
+ }
+
+ if (do.it) {
+ file.remove(.Filename)
+ WTParray <- seq(LIVal, LSVal, round( (LSVal - LIVal ) / NPVal))
+
+ respostaListbox <- Data.CEA$Node.N[as.numeric(tkcurselection(tl))+1]
+
+ Data.alternative <- Data.CEA[Data.CEA$Node.N != respostaListbox,]
+ Data.standart <- Data.CEA[Data.CEA$Node.N == respostaListbox, ]
+
+ ans <- data.frame( Strategy = Data.standart$Node.name,
+ Cost = Data.standart$Mean.Cost,
+ Incr.Cost = 0,
+ Effectiveness = Data.standart$Mean.Effectiveness,
+ Incr.Eff = 0,
+ CE.ratio = Data.standart$Mean.Cost / Data.standart$Mean.Effectiveness,
+ ICER = NA
+ )
+
+ for (i in 1:dim(Data.alternative)[1]) {
+ ans.line <- data.frame( Strategy = Data.alternative$Node.name[i],
+ Cost = Data.alternative$Mean.Cost[i],
+ Incr.Cost = Data.alternative$Mean.Cost[i] - Data.standart$Mean.Cost,
+ Effectiveness = Data.alternative$Mean.Effectiveness[i],
+ Incr.Eff = Data.alternative$Mean.Effectiveness[i] - Data.standart$Mean.Effectiveness,
+ CE.ratio = Data.alternative$Mean.Cost[i] / Data.alternative$Mean.Effectiveness[i],
+ ICER = ((Data.alternative$Mean.Cost[i] - Data.standart$Mean.Cost) /
+ (Data.alternative$Mean.Effectiveness[i] - Data.standart$Mean.Effectiveness))
+ )
+ ans <- abind(ans, ans.line, along = 1)
+
+ }
+ ans <- as.data.frame(ans)
+# print(ans)
+
+ ans$Incr.Cost <- as.numeric(as.character(ans$Incr.Cost))
+ ans$Incr.Eff <- as.numeric(as.character(ans$Incr.Eff))
+ ans$Strategy <- as.character(ans$Strategy)
+
+ inb <- ans$Incr.Eff[1] * WTParray - ans$Incr.Cost[1]
+ for (i in 2:dim(ans)[1]) {
+ balde.inb <- ans$Incr.Eff[i] * WTParray - ans$Incr.Cost[i]
+ inb <- rbind(inb, balde.inb)
+ }
+ rownames(inb) <- ans$Strategy
+ colnames(inb) <- paste("WTP = ", WTParray,sep = "")
+ Original.Dada <- inb
+
filetypeWindow <- tktoplevel()
title <- "ÁrvoRe - Exportar"
tkwm.title(filetypeWindow,title)
@@ -515,10 +724,10 @@
ans <- substr(fileName,nchar(fileName)-3,nchar(fileName))
if ( fileextChoice == ".csv" ) {
if (ans == ".csv") {
- write.csv2(Original.Dada, file = fileName, row.names = FALSE)
+ write.csv2(Original.Dada, file = fileName, row.names = TRUE)
} else {
fileName <- paste(fileName, ".csv", sep = "")
- write.csv2(Original.Dada, file = fileName, row.names = FALSE)
+ write.csv2(Original.Dada, file = fileName, row.names = TRUE)
}
}
if ( fileextChoice == ".txt" ) {
@@ -550,7 +759,7 @@
.Height.but <- 1
OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
+ 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)
@@ -561,6 +770,7 @@
tkbind(filetypeWindow, "<Escape>",OnOK)
tkfocus(filetypeWindow)
+ }
}
OnOKINB <- function() {
@@ -635,10 +845,11 @@
ans$Incr.Cost <- as.numeric(as.character(ans$Incr.Cost))
ans$Incr.Eff <- as.numeric(as.character(ans$Incr.Eff))
+ ans$Strategy <- as.character(ans$Strategy)
# INB <- ans$Incr.Eff * WTParray - Incr.Cost
- plot.it.to.image(WTParray, ans, treatments.colors.plot, treatments.label.plot,
+ plot.it.to.image(WTParray, ans, treatments.colors.plot, treatments.label.plot = ans$Strategy,
.Filename = .Filename, img.type = img.type,
img.width = g.imgWidth, img.height = g.imgHeight)
@@ -665,7 +876,7 @@
tkgrid(OK.WTP.but, sticky = "s", padx = 5, pady = 5, columnspan = 2)
OK.but <- tkbutton(frameButton,text="OK", width=.Width.but, height=.Height.but, command=OnCancel)
- ExportText.but <- tkbutton(frameButton,text="Relatório", width=.Width.but, height=.Height.but, command = function() OnExportText(Build.INB(WTParray, ans, to.export = TRUE)) )
+ ExportText.but <- tkbutton(frameButton,text="Relatório", width=.Width.but, height=.Height.but, command = function() OnExportText() )
Export.but <- tkbutton(frameButton,text="Exportar", width=.Width.but, height=.Height.but, command=OnExportGraphic)
tkgrid(OK.but, ExportText.but, Export.but, sticky = "s", padx = 5, pady = 5)
Modified: pkg/man/markov.coort.table.Rd
===================================================================
--- pkg/man/markov.coort.table.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/markov.coort.table.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -52,21 +52,19 @@
MatrixTheTree <- convert2matrix(TheTree)
x <- MatrixTheTree$x # Structure matrix
y <- MatrixTheTree$y # Node name matrix
- typeMAT <- MatrixTheTree$typeMAT # Node type matrix
+ #~ typeMAT <- MatrixTheTree$typeMAT # Node type matrix
utilityMAT <- MatrixTheTree$utilityMAT # Node Cost matrix
effectivenessMAT <- MatrixTheTree$effectivenessMAT # Node effectiveness matrix
probMAT <- MatrixTheTree$probMAT # Node probability matrix
destinyMAT <- MatrixTheTree$destinyMAT # Terminal node destiny matrix
-
+
num.col.x <- dim(x)[2]
num.lin.x <- dim(x)[1]
SummaryTreeTable <- subset(TheTree, Level == 2)
col.pos <- as.numeric(SummaryTreeTable$Level)
MARKOV.states <- as.numeric(SummaryTreeTable$Node.N) # MARKOV.states
-# print(MARKOV.states)
MARKOV.states.init.prob <- as.numeric(SummaryTreeTable$Prob) # MARKOV.states
-# print(MARKOV.states.init.prob)
MARKOV.states.init.cost.rwd <- as.numeric(markov.propertiesMAT$Initial.cost) # MARKOV.states
MARKOV.states.incr.cost.rwd <- as.numeric(markov.propertiesMAT$Incremental.cost) # MARKOV.states
MARKOV.states.final.cost.rwd <- as.numeric(markov.propertiesMAT$Final.cost) # MARKOV.states
@@ -75,14 +73,16 @@
MARKOV.states.final.effectiveness.rwd <- as.numeric(markov.propertiesMAT$Final.effectiveness) # MARKOV.states
MARKOV.states.names <- SummaryTreeTable$Node.name
-# print(MARKOV.states.names)
+ # Aplica desconto nas payoffs de quem não volta para a árvore associada.
+ MARKOV.discount.costs <- SummaryTreeTable$Payoff1
+ MARKOV.discount.effectiveness <- SummaryTreeTable$Payoff2
+
# listas para comportar matrizes associadas a cada Markov state
MARKOV.states.arvores <- list()
MARKOV.states.rotulos <- list()
MARKOV.states.destino <- list()
MARKOV.states.probs <- list()
- MARKOV.states.utilities <- list()
MARKOV.states.costs <- list()
MARKOV.states.effectiveness <- list()
@@ -96,7 +96,7 @@
sub.probMAT <- probMAT[selected.lines, col.pos[i]:num.col.x]
sub.utilityMAT <- utilityMAT[selected.lines, col.pos[i]:num.col.x]
sub.effectivenessMAT <- effectivenessMAT[selected.lines, col.pos[i]:num.col.x]
- sub.typeMAT <- utilityMAT[selected.lines, col.pos[i]:num.col.x]
+ #~ sub.typeMAT <- utilityMAT[selected.lines, col.pos[i]:num.col.x]
sub.destiny <- destinyMAT[selected.lines]
# se a fragmentação resulta em matriz linha, então é preciso definir que isso é
@@ -109,7 +109,7 @@
sub.probMAT <- matrix(1.0, 1, n.mat)
sub.utilityMAT <- matrix(c(0,sub.utilityMAT), 1, n.mat)
sub.effectivenessMAT <- matrix(c(0,sub.effectivenessMAT), 1, n.mat)
- sub.typeMAT <- matrix(c("D",sub.typeMAT), 1, n.mat)
+ #~ sub.typeMAT <- matrix(c("D",sub.typeMAT), 1, n.mat)
} else {
sub.probMAT[,1] <- 1.0 # Agora o nodo raiz recebe prob = 1.
}
@@ -117,7 +117,7 @@
# ajusta custo e efetividade: serão acumulados através dos nodos.
sub.utilityMAT <- apply(sub.utilityMAT, 1, sum)
sub.effectivenessMAT <- apply(sub.effectivenessMAT, 1, sum)
-
+
# abaixo se manda cada matriz de sub-árvore para suas listas.
MARKOV.states.arvores[[i]] <- sub.x
MARKOV.states.rotulos[[i]] <- sub.y
@@ -125,7 +125,6 @@
MARKOV.states.probs[[i]] <- sub.probMAT
MARKOV.states.costs[[i]] <- sub.utilityMAT
MARKOV.states.effectiveness[[i]] <- sub.effectivenessMAT
- MARKOV.states.utilities[[i]] <- sub.utilityMAT / sub.effectivenessMAT
}
# ajusta nomes nas listas.
@@ -135,30 +134,17 @@
names(MARKOV.states.probs) <- names(MARKOV.states.arvores)
names(MARKOV.states.costs) <- names(MARKOV.states.arvores)
names(MARKOV.states.effectiveness) <- names(MARKOV.states.arvores)
- names(MARKOV.states.utilities) <- names(MARKOV.states.arvores)
-# print(" MOSTRANDO... MARKOV.states.arvores")
-# print(MARKOV.states.arvores)
-# assign("MARKOV.states.arvores", MARKOV.states.arvores, globalenv())
-# print(" MOSTRANDO... MARKOV.states.rotulos")
-# print(MARKOV.states.rotulos)
-# assign("MARKOV.states.rotulos", MARKOV.states.rotulos, globalenv())
-# print(" MOSTRANDO... MARKOV.states.destino")
-# print(MARKOV.states.destino)
-# assign("MARKOV.states.destino", MARKOV.states.destino, globalenv())
-# print(" MOSTRANDO... MARKOV.states.probs")
-# print(MARKOV.states.probs)
-# assign("MARKOV.states.probs", MARKOV.states.probs, globalenv())
-# print(" MOSTRANDO... MARKOV.states.utilities")
-# print(MARKOV.states.utilities)
-# assign("MARKOV.states.utilities", MARKOV.states.utilities, globalenv())
-# print(" MOSTRANDO... MARKOV.states.costs")
-# print(MARKOV.states.costs)
-# assign("MARKOV.states.costs", MARKOV.states.costs, globalenv())
-# print(" MOSTRANDO... MARKOV.states.effectiveness")
-# print(MARKOV.states.effectiveness)
-# assign("MARKOV.states.effectiveness", MARKOV.states.effectiveness, globalenv())
-
+ # ajuste para quem não retorna à árvore associada
+ for (i in 1:length(MARKOV.states.names)) {
+ MARKOV.states.costs[[as.character(MARKOV.states[i])]] <- MARKOV.states.costs[[as.character(MARKOV.states[i])]] -
+ MARKOV.discount.costs[as.numeric(i)] +
+ MARKOV.discount.costs[as.numeric(MARKOV.states.destino[[as.character(MARKOV.states[i])]])]
+ MARKOV.states.effectiveness[[as.character(MARKOV.states[i])]] <- MARKOV.states.effectiveness[[as.character(MARKOV.states[i])]] -
+ MARKOV.discount.effectiveness[as.numeric(i)] +
+ MARKOV.discount.effectiveness[as.numeric(MARKOV.states.destino[[as.character(MARKOV.states[i])]])]
+ }
+
# Busca por estados absorventes
if (absorventstatedeath == 1) {
nodos.test.absorvent <- names(MARKOV.states.destino)
@@ -166,9 +152,7 @@
for (i in nodos.test.absorvent) {
destinyofthisstate <- MARKOV.states.destino[[i]]
-# print(destinyofthisstate)
checkdestiny <- ( destinyofthisstate == i )
-# print(checkdestiny)
if ( sum(checkdestiny) == length(destinyofthisstate) ) {
# cat("Ele é absorvente '", i, "' chamado '", MARKOV.states.rotulos[[i]][1,1],"'\n")
absorventstate <- c(absorventstate, i)
@@ -196,13 +180,13 @@
# control variables
.stop.sim <- TRUE
- .stage <- 0
- .stage.reward <- 0
- .stage.cost <- 0
- .stage.eff <- 0
- .total.reward <- 0 # ajusta a soma do ciclo zero para zero.
- .total.cost <- 0
- .total.eff <- 0
+ .stage <- 1
+ .stage.cost <- sum(Coorte.Cost)
+ .stage.eff <- sum(Coorte.Effec)
+ .stage.reward <- .stage.cost
+ .total.cost <- .stage.cost
+ .total.eff <- .stage.eff
+ .total.reward <- .stage.cost # ajusta a soma do ciclo zero para zero.
while( ! eval( parse(text = markov.termination) ) ) {
.stage <- .stage + 1
@@ -211,7 +195,7 @@
Coorte.Effec.LINE <- matrix(0,1,initial.coort)
for (i in 1:num.markov.states ) {
- positions <- which(Coorte.Ind[.stage,] == MARKOV.states[i])
+ positions <- which(Coorte.Ind[.stage - 1,] == MARKOV.states[i])
indvs <- length(positions)
if ( indvs != 0 ) {
arvore <- MARKOV.states.arvores[[as.character(MARKOV.states[i])]]
@@ -220,7 +204,6 @@
probabilidades <- MARKOV.states.probs[[as.character(MARKOV.states[i])]]
custos <- MARKOV.states.costs[[as.character(MARKOV.states[i])]]
efetividades <- MARKOV.states.effectiveness[[as.character(MARKOV.states[i])]]
- utilidades <- MARKOV.states.utilities[[as.character(MARKOV.states[i])]]
sorteado <- runif(indvs,0,1)
linprobs <- cumsum(apply(probabilidades, 1, prod)) # observa a probabilidade de cada ramo acontecer numa runif
valn <- length(linprobs)
@@ -234,6 +217,13 @@
Coorte.Cost.LINE[1,positions] <- ans.cost
Coorte.Effec.LINE[1,positions] <- ans.effectiveness
}
+ .stage.cost <- sum(Coorte.Cost.LINE)
+ .stage.eff <- sum(Coorte.Effec.LINE)
+ .stage.reward <- .stage.cost
+ .total.cost <- .total.cost + .stage.cost
+ .total.eff <- .total.eff + .stage.eff
+ .total.reward <- .total.cost # ajusta a soma do ciclo zero para zero.
+
Coorte.Ind <- rbind(Coorte.Ind, Coorte.Ind.LINE)
Coorte.Cost <- rbind(Coorte.Cost, Coorte.Cost.LINE)
Coorte.Effec <- rbind(Coorte.Effec, Coorte.Effec.LINE)
@@ -241,41 +231,25 @@
# Definições para a soma de valores no final da simulação (the final reward)
for (i in num.markov.states:1) {
- positions <- which( Coorte.Ind[.stage + 1,] <= MARKOV.states[i] )
- Coorte.Cost[.stage + 1,positions] <- MARKOV.states.final.cost.rwd[i]
- Coorte.Effec[.stage + 1,positions] <- MARKOV.states.final.effectiveness.rwd[i]
+ positions <- which( Coorte.Ind[.stage,] <= MARKOV.states[i] )
+ Coorte.Cost[.stage,positions] <- MARKOV.states.final.cost.rwd[i] + Coorte.Cost[.stage,positions]
+ Coorte.Effec[.stage,positions] <- MARKOV.states.final.effectiveness.rwd[i] + Coorte.Effec[.stage,positions]
}
-# print(" MOSTRANDO... Coorte.Ind")
-# print(Coorte.Ind)
-# print(" MOSTRANDO... Coorte.Cost")
-# print(Coorte.Cost)
-# print(" MOSTRANDO... Coorte.Effec")
-# print(Coorte.Effec)
-
# Aplica NA para individuos dos estados absorventes considerados morte
if (absorventstatedeath == 1) {
SurvivalCurve <- replace(Coorte.Ind, which( Coorte.Ind == absorventstate), NA)
# Coorte.Ind <- replace(Coorte.Ind, which( Coorte.Ind == absorventstate), NA)
-# Coorte.Cost2 <- replace(Coorte.Ind, which( SurvivalCurve == NA), NA)
-# Coorte.Effec2 <- replace(Coorte.Ind, which( SurvivalCurve == NA), NA)
+# Coorte.Cost <- replace(Coorte.Cost, which( SurvivalCurve == NA), NA)
+ Coorte.Effec <- replace(Coorte.Effec, which( is.na(SurvivalCurve)), NA)
SurvivalCurve <- apply(!is.na(SurvivalCurve), 1, sum)
SurvivalCurve <- as.array(SurvivalCurve)
names(SurvivalCurve) <- paste("Cycle ", 0:(length(SurvivalCurve)-1), sep = "")
-# print(SurvivalCurve)
} else {
SurvivalCurve <- rep( dim(Coorte.Ind)[2], dim(Coorte.Ind)[1])
names(SurvivalCurve) <- paste("Cycle ", 0:(length(SurvivalCurve)-1), sep = "")
-# print(SurvivalCurve)
}
-# print(" MOSTRANDO... Coorte.Ind")
-# print(Coorte.Ind)
-# print(" MOSTRANDO... Coorte.Cost")
-# print(Coorte.Cost)
-# print(" MOSTRANDO... Coorte.Effec")
-# print(Coorte.Effec)
-
ans <- list(Path = Coorte.Ind, Cost = Coorte.Cost, Effectiveness = Coorte.Effec, Survival = SurvivalCurve)
return(ans) # And return the result
}
Modified: pkg/man/markov.nodes.properties.Rd
===================================================================
--- pkg/man/markov.nodes.properties.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/markov.nodes.properties.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -160,7 +160,7 @@
tkfocus(tt)
}
- Cancel.but <-tkbutton(markovnodeWindow, width=.Width.but, height=.Height.but, text="Cancel", command=OnCancel)
+ Cancel.but <-tkbutton(markovnodeWindow, width=.Width.but, height=.Height.but, text="Cancelar", command=OnCancel)
tkbind(markovnodeWindow, "<Escape>",OnCancel)
Modified: pkg/man/nodenamewindows.Rd
===================================================================
--- pkg/man/nodenamewindows.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/nodenamewindows.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -66,7 +66,7 @@
tkfocus(nodenameWindow)
}
}
- OK.but <-tkbutton(nodenameWindow,text=" OK ",command=OnOK)
+ OK.but <-tkbutton(nodenameWindow,text=" OK ",command=OnOK)
tkbind(entry.Value, "<Return>",OnOK)
OnCancel <- function()
@@ -75,7 +75,7 @@
tkfocus(tt)
}
- Cancel.but <-tkbutton(nodenameWindow, text=" Cancel ", command=OnCancel)
+ Cancel.but <-tkbutton(nodenameWindow, text=" Cancelar ", command=OnCancel)
tkbind(nodenameWindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
Modified: pkg/man/notesnodewindows.Rd
===================================================================
--- pkg/man/notesnodewindows.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/notesnodewindows.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -65,7 +65,7 @@
refreshF5()
tkfocus(tt)
}
- OK.but <-tkbutton(notesWindow, text=" OK ", command=OnOK)
+ OK.but <-tkbutton(notesWindow, text=" OK ", command=OnOK)
tkbind(entry.Value, "<Return>", OnOK)
OnCancel <- function()
@@ -74,7 +74,7 @@
tkfocus(tt)
}
- Cancel.but <-tkbutton(notesWindow, text=" Cancel ", command=OnCancel)
+ Cancel.but <-tkbutton(notesWindow, text=" Cancelar ", command=OnCancel)
tkbind(notesWindow, "<Escape>", OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
Modified: pkg/man/planoacewindow.Rd
===================================================================
--- pkg/man/planoacewindow.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/planoacewindow.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -53,8 +53,8 @@
tkgrid(frameButton, sticky = "swe")
# Image setings.
- g.imgHeight <- 600/2
- g.imgWidth <- 800/2
+ g.imgHeight <- 480
+ g.imgWidth <- 640
# Canvas window configurations
C.Height <- min(c(g.imgHeight, 768))
@@ -96,26 +96,26 @@
img.type <- "png"
img.quality <- 90
- plot.it.to.image <- function(AllTreatCost, AllTreatEffectiveness, treatments.colors.plot,
+ plot.it.to.image <- function(AllTreatEffectiveness, AllTreatCost, treatments.colors.plot,
treatments.label.plot,
.Filename, img.type = "png", img.quality = 90,
- img.width = 400, img.height = 400, ...) {
+ img.width = 600, img.height = 600, ...) {
if (img.type == "png") {
png(file=.Filename, width = img.width, height = img.height, bg = "white", restoreConsole = FALSE)
Graphtitle <- "Plano Custo-Efetividade"
xlabel <- "Efetividade"
ylabel <- "Custo"
- plot(AllTreatEffectiveness, AllTreatCost,
- col = treatments.colors.plot, pch = "*", main = Graphtitle,
+ plot(c(0,AllTreatEffectiveness), c(0,AllTreatCost),
+ col = c(0,treatments.colors.plot), pch = "*", main = Graphtitle,
xlab = xlabel, ylab = ylabel)
- smartlegend( x="left", y= "top", inset=0, #smartlegend parameters
+ for (i in 1:length(AllTreatEffectiveness)) {
+ lines(c(0,AllTreatEffectiveness[i]), c(0,AllTreatCost[i]), col = treatments.colors.plot[i])
+ }
+ smartlegend( x="center", y= "top", inset=0, #smartlegend parameters
legend = c(treatments.label.plot), #legend parameters
fill=c(treatments.colors.plot), #legend parameters
bg = "gray")
- for (i in length(AllTreatEffectiveness)) {
- lines(c(0,AllTreatEffectiveness[i]), c(0,AllTreatCost[i]), col = treatments.colors.plot[i])
- }
dev.off()
} else {
if (img.type == "jpg") {
@@ -125,16 +125,16 @@
Graphtitle <- "Plano Custo-Efetividade"
xlabel <- "Efetividade"
ylabel <- "Custo"
- plot(AllTreatEffectiveness, AllTreatCost,
- col = treatments.colors.plot, pch = "*", main = Graphtitle,
+ plot(c(0,AllTreatEffectiveness), c(0,AllTreatCost),
+ col = c(0,treatments.colors.plot), pch = "*", main = Graphtitle,
xlab = xlabel, ylab = ylabel)
- smartlegend( x="left", y= "top", inset=0, #smartlegend parameters
+ for (i in 1:length(AllTreatEffectiveness)) {
+ lines(c(0,AllTreatEffectiveness[i]), c(0,AllTreatCost[i]), col = treatments.colors.plot[i])
+ }
+ smartlegend( x="center", y= "top", inset=0, #smartlegend parameters
legend = c(treatments.label.plot), #legend parameters
fill=c(treatments.colors.plot), #legend parameters
bg = "gray")
- for (i in length(AllTreatEffectiveness)) {
- lines(c(0,AllTreatEffectiveness[i]), c(0,AllTreatCost[i]), col = treatments.colors.plot[i])
- }
dev.off()
} else {
bmp(filename = .Filename, width = img.width, height = img.height,
@@ -143,16 +143,16 @@
Graphtitle <- "Plano Custo-Efetividade"
xlabel <- "Efetividade"
ylabel <- "Custo"
- plot(AllTreatEffectiveness, AllTreatCost,
- col = treatments.colors.plot, pch = "*", main = Graphtitle,
+ plot(c(0,AllTreatEffectiveness), c(0,AllTreatCost),
+ col = c(0,treatments.colors.plot), pch = "*", main = Graphtitle,
xlab = xlabel, ylab = ylabel)
- smartlegend( x="left", y= "top", inset=0, #smartlegend parameters
+ for (i in 1:length(AllTreatEffectiveness)) {
+ lines(c(0,AllTreatEffectiveness[i]), c(0,AllTreatCost[i]), col = treatments.colors.plot[i])
+ }
+ smartlegend( x="center", y= "top", inset=0, #smartlegend parameters
legend = c(treatments.label.plot), #legend parameters
fill=c(treatments.colors.plot), #legend parameters
bg = "gray")
- for (i in length(AllTreatEffectiveness)) {
- lines(c(0,AllTreatEffectiveness[i]), c(0,AllTreatCost[i]), col = treatments.colors.plot[i])
- }
dev.off()
}
}
@@ -310,7 +310,7 @@
OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
tkbind(exportImgGraphWindow, "<Return>",OnOK)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
+ Cancel.but <-tkbutton(frameLower,text="Cancelar", width=.Width.but, height=.Height.but, command=OnCancel)
tkbind(exportImgGraphWindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5, columnspan = 2, sticky = "s")
Modified: pkg/man/plot.tree.Rd
===================================================================
--- pkg/man/plot.tree.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/plot.tree.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -45,7 +45,6 @@
function(TheTree, line.type = "squared", show.probability = TRUE,
show.payoffs = TRUE, show.notes = FALSE, node.name.font.size = 12,
payoffs.font.size = 0, notes.font.size = 0) {
-
require(grid)
MatrixTheTree <- convert2matrix(TheTree)
Modified: pkg/man/probwindows.Rd
===================================================================
--- pkg/man/probwindows.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/probwindows.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -64,7 +64,7 @@
tkfocus(probWindow)
}
}
- OK.but <-tkbutton(probWindow,text=" OK ",command=OnOK)
+ OK.but <-tkbutton(probWindow,text=" OK ",command=OnOK)
tkbind(entry.Value, "<Return>",OnOK)
OnCancel <- function()
@@ -73,7 +73,7 @@
tkfocus(tt)
}
- Cancel.but <-tkbutton(probWindow,text=" Cancel ",command=OnCancel)
+ Cancel.but <-tkbutton(probWindow,text=" Cancelar ",command=OnCancel)
tkbind(probWindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
Modified: pkg/man/properties.tree.Rd
===================================================================
--- pkg/man/properties.tree.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/properties.tree.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -60,7 +60,7 @@
frameFontPlot <- tkwidget(frameRight, "labelframe", borderwidth = 2, relief = "groove", text = titleframe)
### Method settings ###
- metodos <- c("Simple Decision (simple payoff)", "Cost-Effectiveness")
+ metodos <- c("Decisão simples (simple payoff)", "Custo-Efetividade")
method.arvore <- c("SD", "CE")
methodBox <- tkwidget(frameUpper, "ComboBox", editable=FALSE, values=metodos, width = 30)
@@ -206,7 +206,7 @@
}
OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
+ 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)
tkbind(propertiesWindow, "<Return>",OnOK)
Modified: pkg/man/set.model.type.Rd
===================================================================
--- pkg/man/set.model.type.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/set.model.type.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -42,6 +42,7 @@
} else {
cat("Error!! \n")
}
+ refreshF5()
assign(".workstatus", "unsaved", .EnvironmentArvoRe)
}
}
Modified: pkg/man/set.value.Rd
===================================================================
--- pkg/man/set.value.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/set.value.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -161,7 +161,7 @@
.Height.but <- 1
OK.but <-tkbutton(FrameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
- Cancel.but <-tkbutton(FrameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
+ Cancel.but <-tkbutton(FrameLower,text="Cancelar", width=.Width.but, height=.Height.but, command=OnCancel)
tkbind(setvalueWindow, "<Escape>",OnCancel)
Modified: pkg/man/splashscreenArvoRe.Rd
===================================================================
--- pkg/man/splashscreenArvoRe.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/splashscreenArvoRe.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -47,6 +47,7 @@
}
}
posiciona.janela.tela(splashArvoRe)
+ tkfocus(splashArvoRe)
tcl("tkwait","window",splashArvoRe)
}
}
Modified: pkg/man/summary.simulation.window.Rd
===================================================================
--- pkg/man/summary.simulation.window.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/summary.simulation.window.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -73,7 +73,8 @@
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), Time = array(,0))
+ Quartil1 = array(,0), Quartil2 = array(,0), CovDcDe = array(,0),
+ Time = array(,0))
for (i in treatments.sim) {
@@ -120,10 +121,14 @@
# 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)
+ statisticsData <- summary(Data, na.rm = TRUE)
- meanData <- mean(Data, na.rm = TRUE)
- varData <- ( 1 / (ntreat*(ntreat-1)) ) * sum( (Data - meanData)^2)
+ 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]
@@ -131,15 +136,37 @@
quartil1 <- statisticsData[2]
quartil3 <- statisticsData[5]
- EvarData <- varData
+ 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, Time = tempo)
+ 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)")
@@ -183,30 +210,58 @@
tkgrid(lableminsize2, row = 11, column = 0, columnspan = 2)
# O Custo -------------------------------------------------
- Data <- Mktable$Cost
- # Remover esta linha se sumarizar saídas de funções de simulação
- Data <- apply(Data,2,sum, na.rm = TRUE)
+ Data <- apply( Mktable$Cost, 2, sum, na.rm = TRUE)
ntreat <- length(Data)
- statisticsData <- summary(Data)
+ statisticsData <- summary(Data, na.rm = TRUE)
- meanData <- mean(Data, na.rm = TRUE)
- varData <- ( 1 / (ntreat*(ntreat-1)) ) * sum( (Data - meanData)^2)
+ 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]
+ quartil3 <- statisticsData[5]
- CvarData <- varData
+ 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, Time = tempo)
+ 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)")
@@ -249,9 +304,6 @@
tkgrid(label17, row = 10, column = 1,sticky="e")
tkgrid(lableminsize2, row = 11, column = 0, columnspan = 2)
-# eval( parse(text = markov.termination) )
-# eval( parse(text = markov.termination) )
-
tkgrid(frameUpperLeft, frameUpperRight, sticky="ns")
tkgrid(frameUpper,sticky="ns")
tkgrid(frameLower,sticky="ns")
@@ -261,12 +313,13 @@
# The CE -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
- Data <- apply(Mktable$Cost,2,sum) / apply(Mktable$Effectiveness,2,sum, na.rm = TRUE)
+ 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)
+ statisticsData <- summary(Data, na.rm = TRUE)
meanData <- statisticsData[4]
- varData <- var(Data, na.rm = TRUE, use = "complete.obs")
+ varData <- var(Data, na.rm = TRUE)
sdData <- sqrt(varData)
medianData <- statisticsData[3]
minData <- statisticsData[1]
@@ -278,13 +331,14 @@
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, Time = tempo)
- Alltreatmentstable <- abind(Alltreatmentstable, line.data.summary, along=1)
-
-
+ Quartil1 = quartil1, Quartil2 = quartil3,
+ CovDcDe = NA, Time = tempo)
+ Alltreatmentstable <- abind(Alltreatmentstable, line.data.summary, along=1)
}
- rm(Data, statisticsData, Mktable)
+ # 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
@@ -299,6 +353,7 @@
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)
@@ -329,785 +384,14 @@
tkfocus(tt)
}
- OnGraph <- function() {
+ 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]]
- Cost <- apply(Mktable$Cost,2,sum)
- Effectiveness <- apply(Mktable$Effectiveness,2,sum)
-
-# OnGraph ---------------------------------------------------------------------------------------------------------------- tkfocus(summarysimulationWindow)
- graphsimulationWindow <- tktoplevel()
- title.window <- "ÁrvoRe - MC Simulação - Gráficos"
- tkwm.title(graphsimulationWindow, title.window)
-
- frameOverall <- tkwidget(graphsimulationWindow, "labelframe", borderwidth = 0, relief = "groove")
- frameResume <- tkwidget(frameOverall, "labelframe", borderwidth = 2, relief = "groove", text = "Tipos de Gráficos")
- frameDistribution <- tkwidget(frameOverall, "labelframe", borderwidth = 2, relief = "groove",
- text = "Distribuição")
- frameOtherGraphs <- tkwidget(frameOverall, "labelframe", borderwidth = 2, relief = "groove",
- text = "Custo-Efetividade")
- frameLower <- tkframe(frameOverall, relief="groove", borderwidth = 0)
-
- OnShowIt <- function(type = "Other", SurvivalData = Mktable$Survival,...) {
-
- aGraphWindow <- tktoplevel()
- title.window <- "ÁrvoRe - MC Simulação - Graphics"
- tkwm.title(aGraphWindow, title.window)
-
- frametext <- "Gráfico"
- frameOverall <- tkwidget(aGraphWindow, "labelframe", borderwidth = 2, relief = "groove",
- labelanchor = "n", text = frametext)
- frameButton <- tkwidget(aGraphWindow, "labelframe", borderwidth = 0, relief = "groove")
-
- tkgrid(frameOverall, sticky = "nwe")
- tkgrid(frameButton, sticky = "swe")
-
- # Image setings.
- g.imgHeight <- 600/2
- g.imgWidth <- 800/2
-
- # Canvas window configurations
- C.Height <- min(c(g.imgHeight, 768))
- C.Width <- min(c(g.imgWidth, 1024))
- Borderwidth <- 2
-
- # scrollbar objects
- fHscroll <- tkscrollbar(frameOverall, orient="horiz", command = function(...)tkxview(fCanvas,...) )
- fVscroll <- tkscrollbar(frameOverall, command = function(...)tkyview(fCanvas,...) )
- fCanvas <- tkcanvas(frameOverall, relief = "sunken", borderwidth = Borderwidth,
- width = C.Width, height = C.Height,
- xscrollcommand = function(...)tkset(fHscroll,...),
- yscrollcommand = function(...)tkset(fVscroll,...)
- )
-
- # Pack the scroll bars.
- tkpack(fHscroll, side = "bottom", fill = "x")
- tkpack(fVscroll, side = "right", fill = "y")
- # Pack the canvas
- tkpack(fCanvas, anchor = "center", side = "right", fill = "both", expand = 1)
-
- # Image file name setings.
- .Filename <- paste(tempdir(),"\\", "grafico.arvore.png", sep="")
-
- # What plot?
- plot.it.to.image <- function(.Filename, img.type = "png", img.quality = 90,
- img.width = 600, img.height = 600, SurvivalData = Mktable$Survival,
- ...) {
-# print(.Filename)
-# print(type)
-# print(img.type)
-
- if( type == "Distrib.cost") {
- if (img.type == "png") {
- png(file=.Filename, width = img.width, height = img.height, bg = "white", restoreConsole = FALSE)
- Graphtitle <- paste("Histograma de ", selected.treatment, sep = "")
- xlabel <- "Cost"
- hist(Cost, main = Graphtitle, xlab = xlabel)
- dev.off()
- } else {
- if (img.type == "jpg") {
- jpeg(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, quality = img.quality, bg = "white",
- res = NA, restoreConsole = FALSE)
- Graphtitle <- paste("Histograma de ", selected.treatment, sep = "")
- xlabel <- "Cost"
- hist(Cost, main = Graphtitle, xlab = xlabel)
- dev.off()
- } else {
- bmp(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, bg = "white", res = NA,
- restoreConsole = FALSE)
- Graphtitle <- paste("Histograma de ", selected.treatment, sep = "")
- xlabel <- "Cost"
- hist(Cost, main = Graphtitle, xlab = xlabel)
- dev.off()
- }
- }
- }
-
- if( type == "Distrib.effectiveness") {
- if (img.type == "png") {
- png(file=.Filename, width = img.width, height = img.height, bg = "white", restoreConsole = FALSE)
- Graphtitle <- paste("Histograma de ", selected.treatment, sep = "")
- xlabel <- "Efetividade"
- hist(Effectiveness, main = Graphtitle, xlab = xlabel)
- dev.off()
- } else {
- if (img.type == "jpg") {
- jpeg(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, quality = img.quality, bg = "white",
- res = NA, restoreConsole = FALSE)
- Graphtitle <- paste("Histograma de ", selected.treatment, sep = "")
- xlabel <- "Efetividade"
- hist(Effectiveness, main = Graphtitle, xlab = xlabel)
- dev.off()
- } else {
- bmp(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, bg = "white", res = NA,
- restoreConsole = FALSE)
- Graphtitle <- paste("Histograma de ", selected.treatment, sep = "")
- xlabel <- "Efetividade"
- hist(Effectiveness, main = Graphtitle, xlab = xlabel)
- dev.off()
- }
- }
- }
-
- if( type == "CE.scatterplot") {
- if (img.type == "png") {
- png(file=.Filename, width = img.width, height = img.height, bg = "white", restoreConsole = FALSE)
- Graphtitle <- "CE Scatterplot"
- xlabel <- "Efetividade"
- ylabel <- "Custo"
- plot(Effectiveness,Cost, col = "red", pch = "*", main = Graphtitle,
- xlab = xlabel, ylab = ylabel)
- dev.off()
- } else {
- if (img.type == "jpg") {
- jpeg(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, quality = img.quality, bg = "white",
- res = NA, restoreConsole = FALSE)
- Graphtitle <- "CE Scatterplot"
- xlabel <- "Efetividade"
- ylabel <- "Custo"
- plot(Effectiveness,Cost, col = "red", pch = "*", main = Graphtitle,
- xlab = xlabel, ylab = ylabel)
- dev.off()
- } else {
- bmp(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, bg = "white", res = NA,
- restoreConsole = FALSE)
- Graphtitle <- "CE Scatterplot"
- xlabel <- "Efetividade"
- ylabel <- "Custo"
- plot(Effectiveness,Cost, col = "red", pch = "*", main = Graphtitle,
- xlab = xlabel, ylab = ylabel)
- dev.off()
- }
- }
- }
-
- if( type == "Distrib.CER") {
- if (img.type == "png") {
- png(file=.Filename, width = img.width, height = img.height, bg = "white", restoreConsole = FALSE)
- Graphtitle <- paste("Histograma de ", selected.treatment, sep = "")
- xlabel <- "Razão Custo-Efetividade ($)"
- hist(Cost/Effectiveness, main = Graphtitle, xlab = xlabel)
- dev.off()
- } else {
- if (img.type == "jpg") {
- jpeg(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, quality = img.quality, bg = "white",
- res = NA, restoreConsole = FALSE)
- Graphtitle <- paste("Histograma de ", selected.treatment, sep = "")
- xlabel <- "Razão Custo-Efetividade ($)"
- hist(Cost/Effectiveness, main = Graphtitle, xlab = xlabel)
- dev.off()
- } else {
- bmp(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, bg = "white", res = NA,
- restoreConsole = FALSE)
- Graphtitle <- paste("Histograma de ", selected.treatment, sep = "")
- xlabel <- "Razão Custo-Efetividade ($)"
- hist(Cost/Effectiveness, main = Graphtitle, xlab = xlabel)
- dev.off()
- }
- }
- }
-
- if( type == "Survival.Curve") {
- if (img.type == "png") {
- png(file=.Filename, width = img.width, height = img.height, bg = "white", restoreConsole = FALSE)
- Graphtitle <- paste("Número de Sobreviventes \n", selected.treatment, sep = "")
- xlabel <- "Ciclos"
-# hist(SurvivalData, main = Graphtitle, xlab = xlabel)
- barplot(SurvivalData, main = Graphtitle, col = "red", space = c(0,0),
- xlab = xlabel)
- dev.off()
-# print(SurvivalData)
- } else {
- if (img.type == "jpg") {
- jpeg(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, quality = img.quality, bg = "white",
- res = NA, restoreConsole = FALSE)
- Graphtitle <- paste("Número de Sobreviventes \n", selected.treatment, sep = "")
- xlabel <- "Ciclos"
- # hist(Cost/Effectiveness, main = Graphtitle, xlab = xlabel)
- barplot(SurvivalData, main = Graphtitle, col = "red", space = c(0,0),
- xlab = xlabel)
- dev.off()
- } else {
- bmp(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, bg = "white", res = NA,
- restoreConsole = FALSE)
- Graphtitle <- paste("Número de Sobreviventes \n", selected.treatment, sep = "")
- xlabel <- "Ciclos"
- # hist(Cost/Effectiveness, main = Graphtitle, xlab = xlabel)
- barplot(SurvivalData, main = Graphtitle, col = "red", space = c(0,0),
- xlab = xlabel)
- dev.off()
- }
- }
- }
-
-
-
-
- }
-
- # Default img type
- img.type <- "png"
- plot.it.to.image(.Filename = .Filename, type = type, img.type = img.type,
- img.width = g.imgWidth, img.height = g.imgHeight)
-
- image1 <- tclVar()
- tcl("image","create","photo",image1,file=.Filename)
- tkcreate(fCanvas, "image", g.imgWidth/2, g.imgHeight/2, image = image1, anchor = "center")
- tkconfigure(fCanvas, scrollregion = c(0,0,g.imgWidth,g.imgHeight))
-
-
- OnOK <- function() {
- file.remove(.Filename)
- tkdestroy(aGraphWindow)
- tkwm.deiconify(graphsimulationWindow)
- tkfocus(graphsimulationWindow)
- }
-
- OnExportGraphic <- function(...) {
- exportImgGraphWindow <- tktoplevel()
- title <- "ÁrvoRe - Exportar Imagem"
- tkwm.title(exportImgGraphWindow,title)
-
- frameOverall <- tkframe(exportImgGraphWindow)
- frameUpper <- tkframe(frameOverall, relief="groove", borderwidth=0)
- frameUpperLeft <- tkframe(frameUpper, relief="groove", borderwidth=2)
- frameUpperRigth <- tkframe(frameUpper, relief="groove", borderwidth=2)
- frameLower <- tkframe(frameOverall, relief="groove", borderwidth=0)
-
- tkgrid( tklabel(frameUpper,text="Formato de imagem"),sticky="n", columnspan = 2)
-
- rbValue <- tclVar("jpg")
- QualityValue <- tclVar("90")
-
- rb1 <- tkradiobutton(frameUpper)
- tkconfigure(rb1,variable=rbValue,value="bmp")
- tkgrid( tklabel(frameUpperLeft,text="Bitmap .bmp "),rb1, sticky = "ne")
-
- rb2 <- tkradiobutton(frameUpper)
- tkconfigure(rb2,variable=rbValue,value="jpg")
- tkgrid( tklabel(frameUpperLeft,text="Jpeg .jpg "),rb2, sticky = "ne")
-
- rb3 <- tkradiobutton(frameUpper)
- tkconfigure(rb3,variable=rbValue,value="png")
- tkgrid( tklabel(frameUpperLeft,text="Portable network graphics .png "),rb3, sticky = "ne")
-
- SliderValueLabel <- tklabel(frameUpperRigth, text = as.character(tclvalue(QualityValue)) )
- sliderlabel <- tklabel(frameUpperRigth, text = "Valor da qualidade de imagem : ")
- sliderlabel2 <- tklabel(frameUpperRigth,text = "\%")
- tkgrid(sliderlabel, SliderValueLabel, sliderlabel2)
- tkconfigure(SliderValueLabel, textvariable = QualityValue)
- sliderImg <- tkscale(frameUpperRigth, from = 100, to = 1,
- showvalue = F, variable = QualityValue,
- resolution = 1, orient = "horizontal")
- tkgrid(sliderImg,sticky="ew")
-
- tkgrid(frameUpperLeft, frameUpperRigth,sticky="ns")
- tkgrid(frameUpper,sticky="ns")
- tkgrid(frameLower,sticky="ns")
-
- Onformat <- function() {
- ansVar <- as.character(tclvalue(rbValue))
- if (ansVar != "jpg") {
- tkconfigure(SliderValueLabel, state = "disabled")
- tkconfigure(sliderlabel, state = "disabled")
- tkconfigure(sliderlabel2, state = "disabled")
- tkconfigure(SliderValueLabel, state = "disabled")
- tkconfigure(sliderImg, state = "disabled")
- } else {
- tkconfigure(SliderValueLabel, state = "normal")
- tkconfigure(sliderlabel, state = "normal")
- tkconfigure(sliderlabel2, state = "normal")
- tkconfigure(SliderValueLabel, state = "normal")
- tkconfigure(sliderImg, state = "normal")
- }
- }
-
- OnOK <- function(...)
- {
- ImgFormatselected <- as.character(tclvalue(rbValue))
- ImgQualityselected <- as.numeric(as.character(tclvalue(QualityValue)))
- if (ImgFormatselected == "png") {
- .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Portable network graphics Image Files} {.png}} {{All files} *}"))
- if (!nchar(.Filename))
- tkfocus(aGraphWindow)
- else {
- ans <- substr(.Filename,nchar(.Filename)-3,nchar(.Filename))
- if ( ans != ".png" ) .Filename <- paste(.Filename, ".png", sep="")
-
- if (!file.exists(.Filename)) file.remove(.Filename)
-
- plot.it.to.image(.Filename = .Filename, type = type, img.type = ImgFormatselected, img.width = 600, img.height = 600)
- }
- } else {
- if (ImgFormatselected == "jpg") {
- .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Jpeg Image Files} {.jpg}} {{All files} *}"))
- if (!nchar(.Filename))
- tkfocus(aGraphWindow)
- else {
- ans <- substr(.Filename,nchar(.Filename)-3,nchar(.Filename))
- if ( ans != ".jpg" ) .Filename <- paste(.Filename, ".jpg", sep="")
-
- if (!file.exists(.Filename)) file.remove(.Filename)
-
- plot.it.to.image(.Filename = .Filename, type = type, img.type = ImgFormatselected, img.width = 600, img.height = 600,
- img.quality = ImgQualityselected)
- }
- } else {
- .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Bitmap Image Files} {.bmp}} {{All files} *}"))
- if (!nchar(.Filename))
- tkfocus(aGraphWindow)
- else {
- ans <- substr(.Filename,nchar(.Filename)-3,nchar(.Filename))
- if ( ans != ".bmp" ) .Filename <- paste(.Filename, ".bmp", sep="")
-
- if (!file.exists(.Filename)) file.remove(.Filename)
-
- plot.it.to.image(.Filename = .Filename, type = type, img.type = ImgFormatselected, img.width = 600, img.height = 600)
- }
- }
- }
- tkdestroy(exportImgGraphWindow)
- tkwm.deiconify(aGraphWindow)
- tkfocus(aGraphWindow)
- }
-
- OnCancel <- function()
- {
- tkdestroy(exportImgGraphWindow)
- tkwm.deiconify(aGraphWindow)
- tkfocus(aGraphWindow)
- }
-
- .Width.but <- 10
- .Height.but <- 1
-
- OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
- tkbind(exportImgGraphWindow, "<Return>",OnOK)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
- tkbind(exportImgGraphWindow, "<Escape>",OnCancel)
- tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5, columnspan = 2, sticky = "s")
-
- tkbind(rb1, "<Enter>",Onformat)
- tkbind(rb2, "<Enter>",Onformat)
- tkbind(rb3, "<Enter>",Onformat)
- tkbind(rb1, "<Leave>",Onformat)
- tkbind(rb2, "<Leave>",Onformat)
- tkbind(rb3, "<Leave>",Onformat)
-
- tkgrid(frameOverall)
- tkfocus(exportImgGraphWindow)
-# posiciona.janela.no.mouse(exportImgGraphWindow)
- }
-
- .Width.but <- 10
- .Height.but <- 1
-
- OK.but <- tkbutton(frameButton,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
- Export.but <- tkbutton(frameButton,text="Exportar...", width=.Width.but, height=.Height.but, command=OnExportGraphic)
-
- tkgrid(OK.but, Export.but, sticky = "s", padx = 5, pady = 5)
-# tkconfigure(Export.but, state = "disabled")
-
- tkbind(aGraphWindow, "<Return>", OnOK)
- tkbind(aGraphWindow, "<Escape>", OnCancel)
-
- tkwm.deiconify(aGraphWindow)
- tkfocus(aGraphWindow)
-
- }
-
- OnOK <- function() {
- tkdestroy(graphsimulationWindow)
- tkfocus(summarysimulationWindow)
- }
-
- OnCancel <- function() {
- tkdestroy(graphsimulationWindow)
- tkfocus(summarysimulationWindow)
- }
-
- OnDistrib.cost <- function() {
- OnShowIt(type = "Distrib.cost")
- }
-
- OnDistrib.effectiveness <- function() {
- OnShowIt(type = "Distrib.effectiveness")
- }
-
- OnDistrib.CER <- function() {
- OnShowIt(type = "Distrib.CER")
- }
-
- OnDistrib.incrementals <- function() {
- OnShowIt(type = "Distrib.incrementals")
- }
-
- OnCE <- function() {
- CEGraphWindow <- tktoplevel()
- title.window <- "ÁrvoRe - MC Simulação - Graphics"
- tkwm.title(CEGraphWindow, title.window)
-
- frametext <- "Gráfico"
- frameOverall <- tkwidget(CEGraphWindow, "labelframe", borderwidth = 2, relief = "groove",
- labelanchor = "n", text = frametext)
- frameButton <- tkwidget(CEGraphWindow, "labelframe", borderwidth = 0, relief = "groove")
-
- tkgrid(frameOverall, sticky = "nwe")
- tkgrid(frameButton, sticky = "swe")
-
- # Image setings.
- g.imgHeight <- 600/2
- g.imgWidth <- 800/2
-
- # Canvas window configurations
- C.Height <- min(c(g.imgHeight, 768))
- C.Width <- min(c(g.imgWidth, 1024))
- Borderwidth <- 2
-
- # scrollbar objects
- fHscroll <- tkscrollbar(frameOverall, orient="horiz", command = function(...)tkxview(fCanvas,...) )
- fVscroll <- tkscrollbar(frameOverall, command = function(...)tkyview(fCanvas,...) )
- fCanvas <- tkcanvas(frameOverall, relief = "sunken", borderwidth = Borderwidth,
- width = C.Width, height = C.Height,
- xscrollcommand = function(...)tkset(fHscroll,...),
- yscrollcommand = function(...)tkset(fVscroll,...)
- )
-
- # Pack the scroll bars.
- tkpack(fHscroll, side = "bottom", fill = "x")
- tkpack(fVscroll, side = "right", fill = "y")
- # Pack the canvas
- tkpack(fCanvas, anchor = "center", side = "right", fill = "both", expand = 1)
-
- # Image file name setings.
- .Filename <- paste(tempdir(),"\\", "grafico.arvore.png", sep="")
-
- # The data to plot
- AllTreatCost <- Alltreatmentstable[Alltreatmentstable$Data == "Cost",]
- AllTreatEffectiveness <- Alltreatmentstable[Alltreatmentstable$Data == "Effectiveness",]
- # Initial colors to treatments points
- treatments.colors.plot <- 1:length(AllTreatCost$Treatment)
- # The treatments names
- treatments.label.plot <- AllTreatCost$Treatment
-
- # What plot?
- plot.it.to.image <- function(AllTreatEffectiveness, AllTreatCost, treatments.colors.plot,
- treatments.label.plot,
- .Filename, img.type = "png", img.quality = 90,
- img.width = 600, img.height = 600, ...) {
-
- if (img.type == "png") {
- png(file=.Filename, width = img.width, height = img.height, bg = "white", restoreConsole = FALSE)
- Graphtitle <- "Plano Custo-Efetividade"
- xlabel <- "Efetividade"
- ylabel <- "Custo"
- plot(AllTreatEffectiveness$Mean, AllTreatCost$Mean,
- col = treatments.colors.plot, pch = "*", main = Graphtitle,
- xlab = xlabel, ylab = ylabel)
- smartlegend( x="left", y= "top", inset=0, #smartlegend parameters
- legend = c(treatments.label.plot), #legend parameters
- fill=c(treatments.colors.plot), #legend parameters
- bg = "gray")
- dev.off()
- } else {
- if (img.type == "jpg") {
- jpeg(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, quality = img.quality, bg = "white",
- res = NA, restoreConsole = FALSE)
- Graphtitle <- "Plano Custo-Efetividade"
- xlabel <- "Efetividade"
- ylabel <- "Custo"
- plot(AllTreatEffectiveness$Mean, AllTreatCost$Mean,
- col = treatments.colors.plot, pch = "*", main = Graphtitle,
- xlab = xlabel, ylab = ylabel)
-
- smartlegend( x="left", y= "top", inset=0, #smartlegend parameters
- legend = c(treatments.label.plot), #legend parameters
- fill=c(treatments.colors.plot), #legend parameters
- bg = "gray")
-
- dev.off()
- } else {
- bmp(filename = .Filename, width = img.width, height = img.height,
- units = "px", pointsize = 12, bg = "white", res = NA,
- restoreConsole = FALSE)
- Graphtitle <- "Plano Custo-Efetividade"
- xlabel <- "Efetividade"
- ylabel <- "Custo"
- plot(AllTreatEffectiveness$Mean, AllTreatCost$Mean,
- col = treatments.colors.plot, pch = "*", main = Graphtitle,
- xlab = xlabel, ylab = ylabel)
-
- smartlegend( x="left", y= "top", inset=0, #smartlegend parameters
- legend = c(treatments.label.plot), #legend parameters
- fill=c(treatments.colors.plot), #legend parameters
- bg = "gray")
-
- dev.off()
- }
- }
- }
-
- # Default img type
- img.type <- "png"
- plot.it.to.image(AllTreatEffectiveness, AllTreatCost, treatments.colors.plot, treatments.label.plot,
- .Filename = .Filename, type = type, img.type = img.type,
- img.width = g.imgWidth, img.height = g.imgHeight)
-
- image1 <- tclVar()
- tcl("image","create","photo",image1,file=.Filename)
- tkcreate(fCanvas, "image", g.imgWidth/2, g.imgHeight/2, image = image1, anchor = "center")
- tkconfigure(fCanvas, scrollregion = c(0,0,g.imgWidth,g.imgHeight))
-
-
- OnOK <- function() {
- file.remove(.Filename)
- tkdestroy(CEGraphWindow)
- tkwm.deiconify(graphsimulationWindow)
- tkfocus(graphsimulationWindow)
- }
-
- OnExportGraphic <- function(...) {
- exportImgGraphWindow <- tktoplevel()
- title <- "ÁrvoRe - Exportar Imagem"
- tkwm.title(exportImgGraphWindow,title)
-
- frameOverall <- tkframe(exportImgGraphWindow)
- frameUpper <- tkframe(frameOverall, relief="groove", borderwidth=0)
- frameUpperLeft <- tkframe(frameUpper, relief="groove", borderwidth=2)
- frameUpperRigth <- tkframe(frameUpper, relief="groove", borderwidth=2)
- frameLower <- tkframe(frameOverall, relief="groove", borderwidth=0)
-
- tkgrid( tklabel(frameUpper,text="Formato de imagem"),sticky="n", columnspan = 2)
-
- rbValue <- tclVar("jpg")
- QualityValue <- tclVar("90")
-
- rb1 <- tkradiobutton(frameUpper)
- tkconfigure(rb1,variable=rbValue,value="bmp")
- tkgrid( tklabel(frameUpperLeft,text="Bitmap .bmp "),rb1, sticky = "ne")
-
- rb2 <- tkradiobutton(frameUpper)
- tkconfigure(rb2,variable=rbValue,value="jpg")
- tkgrid( tklabel(frameUpperLeft,text="Jpeg .jpg "),rb2, sticky = "ne")
-
- rb3 <- tkradiobutton(frameUpper)
- tkconfigure(rb3,variable=rbValue,value="png")
- tkgrid( tklabel(frameUpperLeft,text="Portable network graphics .png "),rb3, sticky = "ne")
-
- SliderValueLabel <- tklabel(frameUpperRigth, text = as.character(tclvalue(QualityValue)) )
- sliderlabel <- tklabel(frameUpperRigth, text = "Valor da qualidade de imagem : ")
- sliderlabel2 <- tklabel(frameUpperRigth,text = "\%")
- tkgrid(sliderlabel, SliderValueLabel, sliderlabel2)
- tkconfigure(SliderValueLabel, textvariable = QualityValue)
- sliderImg <- tkscale(frameUpperRigth, from = 100, to = 1,
- showvalue = F, variable = QualityValue,
- resolution = 1, orient = "horizontal")
- tkgrid(sliderImg,sticky="ew")
-
- tkgrid(frameUpperLeft, frameUpperRigth,sticky="ns")
- tkgrid(frameUpper,sticky="ns")
- tkgrid(frameLower,sticky="ns")
-
- Onformat <- function() {
- ansVar <- as.character(tclvalue(rbValue))
- if (ansVar != "jpg") {
- tkconfigure(SliderValueLabel, state = "disabled")
- tkconfigure(sliderlabel, state = "disabled")
- tkconfigure(sliderlabel2, state = "disabled")
- tkconfigure(SliderValueLabel, state = "disabled")
- tkconfigure(sliderImg, state = "disabled")
- } else {
- tkconfigure(SliderValueLabel, state = "normal")
- tkconfigure(sliderlabel, state = "normal")
- tkconfigure(sliderlabel2, state = "normal")
- tkconfigure(SliderValueLabel, state = "normal")
- tkconfigure(sliderImg, state = "normal")
- }
- }
-
- OnOK <- function(...)
- {
- ImgFormatselected <- as.character(tclvalue(rbValue))
- ImgQualityselected <- as.numeric(as.character(tclvalue(QualityValue)))
- if (ImgFormatselected == "png") {
- .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Portable network graphics Image Files} {.png}} {{All files} *}"))
- if (!nchar(.Filename))
- tkfocus(CEGraphWindow)
- else {
- ans <- substr(.Filename,nchar(.Filename)-3,nchar(.Filename))
- if ( ans != ".png" ) .Filename <- paste(.Filename, ".png", sep="")
-
- if (!file.exists(.Filename)) file.remove(.Filename)
-
- plot.it.to.image(AllTreatEffectiveness, AllTreatCost, treatments.colors.plot, treatments.label.plot,
- .Filename = .Filename, type = type, img.type = ImgFormatselected)
- }
- } else {
- if (ImgFormatselected == "jpg") {
- .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Jpeg Image Files} {.jpg}} {{All files} *}"))
- if (!nchar(.Filename))
- tkfocus(CEGraphWindow)
- else {
- ans <- substr(.Filename,nchar(.Filename)-3,nchar(.Filename))
- if ( ans != ".jpg" ) .Filename <- paste(.Filename, ".jpg", sep="")
-
- if (!file.exists(.Filename)) file.remove(.Filename)
-
- plot.it.to.image(AllTreatEffectiveness, AllTreatCost, treatments.colors.plot, treatments.label.plot,
- .Filename = .Filename, type = type, img.type = ImgFormatselected,
- img.quality = ImgQualityselected)
- }
- } else {
- .Filename <- tclvalue(tkgetSaveFile(filetypes="{{Bitmap Image Files} {.bmp}} {{All files} *}"))
- if (!nchar(.Filename))
- tkfocus(CEGraphWindow)
- else {
- ans <- substr(.Filename,nchar(.Filename)-3,nchar(.Filename))
- if ( ans != ".bmp" ) .Filename <- paste(.Filename, ".bmp", sep="")
-
- if (!file.exists(.Filename)) file.remove(.Filename)
-
- plot.it.to.image(AllTreatEffectiveness, AllTreatCost, treatments.colors.plot, treatments.label.plot,
- .Filename = .Filename, type = type, img.type = ImgFormatselected)
- }
- }
- }
- tkdestroy(exportImgGraphWindow)
- tkwm.deiconify(CEGraphWindow)
- tkfocus(CEGraphWindow)
- }
-
- OnCancel <- function()
- {
- tkdestroy(exportImgGraphWindow)
- tkwm.deiconify(CEGraphWindow)
- tkfocus(CEGraphWindow)
- }
-
- .Width.but <- 10
- .Height.but <- 1
-
- OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
- tkbind(exportImgGraphWindow, "<Return>",OnOK)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
- tkbind(exportImgGraphWindow, "<Escape>",OnCancel)
- tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5, columnspan = 2, sticky = "s")
-
- tkbind(rb1, "<Enter>",Onformat)
- tkbind(rb2, "<Enter>",Onformat)
- tkbind(rb3, "<Enter>",Onformat)
- tkbind(rb1, "<Leave>",Onformat)
- tkbind(rb2, "<Leave>",Onformat)
- tkbind(rb3, "<Leave>",Onformat)
-
- tkgrid(frameOverall)
- tkfocus(exportImgGraphWindow)
-# posiciona.janela.no.mouse(exportImgGraphWindow)
- }
-
- .Width.but <- 10
- .Height.but <- 1
-
- OK.but <- tkbutton(frameButton,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
- Export.but <- tkbutton(frameButton,text="Exportar...", width=.Width.but, height=.Height.but, command=OnExportGraphic)
-
- tkgrid(OK.but, Export.but, sticky = "s", padx = 5, pady = 5)
-# tkconfigure(Export.but, state = "disabled")
-
- tkbind(CEGraphWindow, "<Return>", OnOK)
- tkbind(CEGraphWindow, "<Escape>", OnCancel)
-
- tkwm.deiconify(CEGraphWindow)
- tkfocus(CEGraphWindow)
-
- }
-
- OnCE.scatterplot <- function() {
- OnShowIt(type = "CE.scatterplot")
- }
-
- OnAccept.Curve <- function(Alltreatmentstable) {
- aceptability.sim.window(Alltreatmentstable)
- }
-
- OnSurvival.Curve <- function() {
- SurvivalData <- Mktable$Survival
- OnShowIt(type = "Survival.Curve", SurvivalData = SurvivalData)
- }
-
-
- # Button label
- label.but1 <- "Custo"
- label.but2 <- "Efetividade"
- label.but3 <- "Razão Custo-Efetividade"
- label.but4 <- "Incrementals"
- label.but5 <- "Custo-Efetividade"
- label.but6 <- "Scatterplot C-E"
- label.but7 <- "Curva de aceitabilidade"
- label.but8 <- "Curva de sobrevivência"
-
- .Width.but <- max( c( nchar(label.but1), nchar(label.but2), nchar(label.but3), nchar(label.but4),
- nchar(label.but5), nchar(label.but6), nchar(label.but7)) )
- .Height.but <- 1
-
- # The buttons
- Distrib.cost.but <- tkbutton(frameDistribution, text = label.but1,
- width=.Width.but, height=.Height.but, command = OnDistrib.cost)
- Distrib.effectiveness.but <- tkbutton(frameDistribution,text = label.but2,
- width=.Width.but, height=.Height.but, command = OnDistrib.effectiveness)
- Distrib.CER.but <- tkbutton(frameDistribution,text = label.but3,
- width =.Width.but, height=.Height.but, command = OnDistrib.CER)
- Distrib.incrementals.but <- tkbutton(frameDistribution, text = label.but4,
- width=.Width.but, height=.Height.but, command = OnDistrib.incrementals)
- CE.but <- tkbutton(frameOtherGraphs, text = label.but5,
- width=.Width.but, height=.Height.but, command = OnCE)
- CE.scatterplot.but <- tkbutton(frameOtherGraphs,text=label.but6,
- width=.Width.but, height=.Height.but, command = OnCE.scatterplot)
- Accept.Curve.but <- tkbutton(frameOtherGraphs,text=label.but7,
- width=.Width.but, height=.Height.but, command = function() OnAccept.Curve(Alltreatmentstable))
- Survival.Curve.but <- tkbutton(frameOtherGraphs,text=label.but8,
- width=.Width.but, height=.Height.but, command = OnSurvival.Curve)
-
- tkgrid(Distrib.cost.but, sticky = "s", padx = 5, pady = 5)
- tkgrid(Distrib.effectiveness.but, sticky = "s", padx = 5, pady = 5)
- tkgrid(Distrib.CER.but, sticky = "s", padx = 5, pady = 5)
- tkgrid(Distrib.incrementals.but, sticky = "s", padx = 5, pady = 5)
- tkgrid(CE.but, sticky = "s", padx = 5, pady = 5)
- tkgrid(CE.scatterplot.but, sticky = "s", padx = 5, pady = 5)
- tkgrid(Accept.Curve.but, sticky = "s", padx = 5, pady = 5)
- tkgrid(Survival.Curve.but, sticky = "s", padx = 5, pady = 5)
-
- OK.but <- tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
- Cancel.but <- tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
-
- tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
-
- tkgrid(frameDistribution,sticky="nwe")
- tkgrid(frameOtherGraphs,sticky="nwe")
- tkgrid(frameResume,sticky="nwe")
- tkgrid(frameLower, sticky = "s")
- tkgrid(frameOverall)
-
- tkbind(graphsimulationWindow, "<Return>", OnOK)
- tkbind(graphsimulationWindow, "<Escape>", OnCancel)
-
- tkfocus(graphsimulationWindow)
-# OnGraph ---------------------------------------------------------------------------------------------------------------- tkfocus(summarysimulationWindow)
-
+ onGraph.summary.simwindow(Mktable, Alltreatmentstable, selected.treatment)
}
OnText <- function() {
@@ -1126,14 +410,14 @@
frameButtons <- tkframe(statsSWindow, relief="groove", borderwidth = 0)
OnNM <- function() {
- WTPVal <- as.integer(tclvalue(WTPvar))
+ 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)
- DataEffectiveness <- apply(Mktable$Effectiveness,2,sum)
+ 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,
@@ -1148,8 +432,8 @@
# The NMB -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
- DataCost <- apply(Mktable$Cost,2,sum)
- DataEffectiveness <- apply(Mktable$Effectiveness,2,sum)
+ 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,
@@ -1175,21 +459,21 @@
}
OnNH <- function() {
- WTPVal <- as.integer(tclvalue(WTPvar))
+ WTPVal <- as.numeric(tclvalue(WTPvar))
selected.treatment <- treatments.sim[1]
Mktable <- Simlist[[selected.treatment]]
- # The NMB -----------------------------------------------------------------------
+ # The NHB -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
- DataCost <- apply(Mktable$Cost,2,sum)
- DataEffectiveness <- apply(Mktable$Effectiveness,2,sum)
- Data <- DataEffectiveness * WTPVal - DataCost
+ DataCost <- apply(Mktable$Cost,2,sum, na.rm = TRUE)
+ DataEffectiveness <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE)
+ Data <- DataEffectiveness - DataCost / WTPVal
- NMBtable <- data.frame( Cost = DataCost,
+ NHBtable <- data.frame( Cost = DataCost,
Effectiveness = DataEffectiveness,
- NMB = Data)
- namesvariables <- c(".Cost", ".Effectiveness", ".NMB")
- names(NMBtable) <- paste(selected.treatment,namesvariables,sep="")
+ 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) ) {
@@ -1198,28 +482,28 @@
# The NMB -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
- DataCost <- apply(Mktable$Cost,2,sum)
- DataEffectiveness <- apply(Mktable$Effectiveness,2,sum)
- Data <- DataEffectiveness * WTPVal - DataCost
+ DataCost <- apply(Mktable$Cost,2,sum, na.rm = TRUE)
+ DataEffectiveness <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE)
+ Data <- DataEffectiveness - DataCost / WTPVal
- newNMBtable <- data.frame( Cost = DataCost,
+ newNHBtable <- data.frame( Cost = DataCost,
Effectiveness = DataEffectiveness,
- NMB = Data)
- names(newNMBtable) <- paste(selected.treatment,namesvariables,sep="")
+ NHB = Data)
+ names(newNHBtable) <- paste(selected.treatment,namesvariables,sep="")
# Guarda as informações importantes
- NMBtable <- abind(NMBtable, newNMBtable, along=2)
+ NHBtable <- abind(NHBtable, newNHBtable, along=2)
}
}
Trial <- 1:length(DataCost)
- NMBtable <- abind(Trial, NMBtable, along=2)
- names(NMBtable) <- c("Trial", names(NMBtable))
+ NHBtable <- abind(Trial, NHBtable, along=2)
+ names(NHBtable) <- c("Trial", names(NHBtable))
- tituloNMB <- "Estatísticas - Net Health Benefits"
- NMBtable <- as.matrix(NMBtable)
+ tituloNHB <- "Estatísticas - Rede de Benefício Saúde (NHB)"
+ NHBtable <- as.matrix(NHBtable)
- displayInTable(NMBtable, title = tituloNMB, height=min(10,dim(NMBtable)[1]), width= min(10,dim(NMBtable)[2]),
- nrow=dim(NMBtable)[1],ncol=dim(NMBtable)[2],
+ 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)
}
@@ -1230,8 +514,8 @@
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)
- DataEffectiveness <- apply(Mktable$Effectiveness,2,sum)
+ 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,
@@ -1246,8 +530,8 @@
# The CE -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
- DataCost <- apply(Mktable$Cost,2,sum)
- DataEffectiveness <- apply(Mktable$Effectiveness,2,sum)
+ 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,
@@ -1271,13 +555,18 @@
returntt = FALSE)
}
- .Width.but <- 18
- .Height.but <- 1
- NM.but <-tkbutton(frameOverall,text="Net monetary benefit", width=.Width.but, height=.Height.but, command=OnNM)
- NH.but <-tkbutton(frameOverall,text="Net health benefit", width=.Width.but, height=.Height.but, command=OnNH)
- CE.but <-tkbutton(frameOverall,text="Custo-Efetividade", width=.Width.but, height=.Height.but, command=OnCE)
+ 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)
@@ -1344,8 +633,8 @@
Mktable <- Simlist[[selected.treatment]]
if (tipo.nodo[selectedpage.number] == "C") {
- ResumeSim <- data.frame(Cost = apply(Mktable$Cost,2,sum),
- Effectiveness = apply(Mktable$Effectiveness,2,sum))
+ 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))
@@ -1377,8 +666,8 @@
if (tipo.nodo[selectedpage.number] == "M") {
# Summary Coort
- ResumeSim <- data.frame(Cost = apply(Mktable$Cost,2,sum),
- Effectiveness = apply(Mktable$Effectiveness,2,sum))
+ 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))
@@ -1477,7 +766,7 @@
.Height.but <- 1
OK.but <-tkbutton(frameLower,text="OK", width=.Width.but, height=.Height.but, command=OnOK)
- Cancel.but <-tkbutton(frameLower,text="Cancel", width=.Width.but, height=.Height.but, command=OnCancel)
+ 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)
@@ -1492,8 +781,6 @@
}
OnStatsRep <- function() {
-
-
StatsData <- Alltreatmentstable[ order(Alltreatmentstable$Treatment, Alltreatmentstable$Data),]
assign("StatsData", StatsData, .EnvironmentArvoRe)
@@ -1512,7 +799,7 @@
frameButtons <- tkframe(statsSWindow, relief="groove", borderwidth = 0)
OnNM <- function() {
- WTPVal <- as.integer(tclvalue(WTPvar))
+ WTPVal <- as.numeric(tclvalue(WTPvar))
NMBtable <- data.frame(Treatment = array(,0), Mean = array(,0),
Variance = array(,0), Sd = array(,0), Median = array(,0),
@@ -1525,9 +812,10 @@
# The NMB -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
- Data <- apply(Mktable$Effectiveness,2,sum) * WTPVal - apply(Mktable$Cost,2,sum)
+ Data <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE) *
+ WTPVal - apply(Mktable$Cost,2,sum, na.rm = TRUE)
- statisticsData <- summary(Data)
+ statisticsData <- summary(Data, na.rm = TRUE)
meanData <- statisticsData[4]
varData <- var(Data, na.rm = TRUE, use = "complete.obs")
@@ -1546,7 +834,7 @@
NMBtable <- abind(NMBtable, line.data.summary, along=1)
}
- tituloNMB <- "Estatísticas - Net Monetary Benefits"
+ 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]),
@@ -1556,7 +844,7 @@
}
OnNH <- function() {
- WTPVal <- as.integer(tclvalue(WTPvar))
+ WTPVal <- as.numeric(tclvalue(WTPvar))
NMBtable <- data.frame(Treatment = array(,0), Mean = array(,0),
Variance = array(,0), Sd = array(,0), Median = array(,0),
@@ -1569,9 +857,10 @@
# The NHB -----------------------------------------------------------------------
# Remover esta linha se sumarizar saídas de funções de simulação
- Data <- apply(Mktable$Effectiveness,2,sum) * WTPVal - apply(Mktable$Cost,2,sum)
+ Data <- apply(Mktable$Effectiveness,2,sum, na.rm = TRUE) *
+ apply(Mktable$Cost,2,sum, na.rm = TRUE) / WTPVal
- statisticsData <- summary(Data)
+ statisticsData <- summary(Data, na.rm = TRUE)
meanData <- statisticsData[4]
varData <- var(Data, na.rm = TRUE, use = "complete.obs")
@@ -1590,7 +879,7 @@
NMBtable <- abind(NMBtable, line.data.summary, along=1)
}
- tituloNMB <- "Estatísticas - Net Monetary Benefits"
+ 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]),
@@ -1601,10 +890,6 @@
}
OnCE <- function() {
-# ResumeData <- as.data.frame( t(StatsData[,2:dim(StatsData)[2]]) )
-# names(ResumeData) <- StatsData[,1]
-# ResumeData <- as.matrix(ResumeData)
-
tituloCE <- "Estatísticas - Análise de Custo-Efetividade"
StatsData <- as.matrix(StatsData)
@@ -1625,12 +910,12 @@
.Width.but <- 40
.Height.but <- 1
- NM.but <-tkbutton(frameOverall,text="Net monetary benefit", width=.Width.but, height=.Height.but, command=OnNM)
- NH.but <-tkbutton(frameOverall,text="Net health benefit", width=.Width.but, height=.Height.but, command=OnNH)
- CE.but <-tkbutton(frameOverall,text="Custo-Efetividade", width=.Width.but, height=.Height.but, command=OnCE)
+ 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 benfícios (INB)", width=.Width.but,
+ INB.but <-tkbutton(frameOverall,text="Incremento da rede de benefícios (INB)", width=.Width.but,
height=.Height.but, command= function() OnINB(StatsData))
@@ -1665,17 +950,22 @@
# 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=OnGraph)
- 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)
+ 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)
Modified: pkg/man/typenodewindows.Rd
===================================================================
--- pkg/man/typenodewindows.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/typenodewindows.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -184,9 +184,9 @@
tkfocus(tt)
}
- OK.but <-tkbutton(Frame2,text=" OK ",command=OnOK)
+ OK.but <-tkbutton(Frame2,text=" OK ",command=OnOK)
tkbind(typenodeWindow, "<Return>",OnOK)
- Cancel.but <-tkbutton(Frame2,text=" Cancel ",command=OnCancel)
+ Cancel.but <-tkbutton(Frame2,text=" Cancelar ",command=OnCancel)
tkbind(typenodeWindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
Modified: pkg/man/utilitywindows.Rd
===================================================================
--- pkg/man/utilitywindows.Rd 2008-08-08 04:36:00 UTC (rev 2)
+++ pkg/man/utilitywindows.Rd 2008-08-08 04:37:57 UTC (rev 3)
@@ -83,7 +83,7 @@
tkfocus(utilityWindow)
}
}
- OK.but <-tkbutton(utilityWindow,text=" OK ",command=OnOK)
+ OK.but <-tkbutton(utilityWindow,text=" OK ",command=OnOK)
OnCancel <- function()
{
@@ -91,7 +91,7 @@
tkfocus(tt)
}
- Cancel.but <-tkbutton(utilityWindow,text=" Cancel ",command=OnCancel)
+ Cancel.but <-tkbutton(utilityWindow,text=" Cancelar ",command=OnCancel)
tkbind(entry.Value, "<Return>",OnOK)
tkbind(entry.Value.effectiveness, "<Return>",OnOK)
More information about the Arvore-commits
mailing list