dialog.simulation.window {arvoRe} | R Documentation |
Usage
dialog.simulation.window(...)
Arguments
Examples
##---- Should be DIRECTLY executable !! ----
##-- ==> Define data, use random,
##-- or do help(data=index) for the standard data sets.
## The function is currently defined as
function(...) {
.begin.sim <- TRUE # Servirá como flag para se saber se se pode iniciar a simulação.
nodeSec <- nodoselecionado()
if ( nodeSec[1] == " ") {
msg <- paste("Nenhum nodo selecionado. Selecione um nodo da árvore e tente novamente.")
tkmessageBox(message = msg, icon="warning", title = "ÁrvoRe - AVISO")
.begin.sim <- FALSE
tkfocus(tt)
} else {
node.number <- as.numeric(nodeSec[3])
column <- as.numeric(nodeSec[2])
position <- intersect(which((TheTree$Level == column)),which(TheTree$Node.N == node.number))
node.type <- TheTree$Type[position]
}
TestPartialTree <- select.subtree(TheTree, node.col = column, node.number = node.number, change.row.names = FALSE)$Type
position.test <- which( TestPartialTree == "M" )
if (length(position.test) > 0) {
if (dim(markov.propertiesMAT)[1] == 0) {
msg <- paste("Propriedades dos nodos representantes dos estados Markov não \n",
"foram definidos. Use o botão 'M' para ajustar as propriedades \n",
"destes nodos.", sep = "")
tkmessageBox(message = msg, icon="error", title = "ÁrvoRe - AVISO")
.begin.sim <- FALSE
tkfocus(tt)
}
}
if (.begin.sim) {
if (node.type == "M") {
############ MARKOV ############
dialogsimulationwindow <- tktoplevel()
title <- "ÁrvoRe - Simulação Markov"
tkwm.title(dialogsimulationwindow,title)
Seedvar <- tclVar(0)
Individuosvar <- tclVar(10000)
Terminalvar <- tclVar("(.stage >= 10)")
Seed.Value <- tkentry(dialogsimulationwindow,width="20",textvariable=Seedvar)
tkgrid(tklabel(dialogsimulationwindow,text="Semente (zero indica semente não determinada)"),
row = 0, column = 0, columnspan = 2, sticky = "n")
tkgrid(Seed.Value, row = 1, column = 0, columnspan = 2, sticky = "n")
Individuos.Value <- tkentry(dialogsimulationwindow,width="20",textvariable=Individuosvar)
tkgrid(tklabel(dialogsimulationwindow,text="Número de indivíduos na coorte"),
row = 2, column = 0, columnspan = 2, sticky = "n")
tkgrid(Individuos.Value, row = 3, column = 0, columnspan = 2, sticky = "n")
Terminal.Value <- tkentry(dialogsimulationwindow,width="20",textvariable=Terminalvar)
tkgrid(tklabel(dialogsimulationwindow,text="Condição de término da simulação"),
row = 4, column = 0, columnspan = 2, sticky = "n")
tkgrid(Terminal.Value, row = 5, column = 0, columnspan = 2, sticky = "n")
tkgrid(tklabel(dialogsimulationwindow,text=" "), columnspan = 2, sticky = "n")
OnOK <- function()
{
tkconfigure(dialogsimulationwindow,cursor="watch") # faz com que o cursor mude para busy
SeedVal <- as.integer(tclvalue(Seedvar))
IndividuosVal <- as.integer(tclvalue(Individuosvar))
TerminalVal <- as.character(tclvalue(Terminalvar))
if ( (is.numeric(SeedVal)) && (!is.na(SeedVal)) && (nchar(SeedVal) > 0) ) {
if ( (is.numeric(IndividuosVal)) && (!is.na(IndividuosVal)) && (nchar(IndividuosVal) > 0) ) {
PartialTree <- select.subtree(TheTree, node.col = column, node.number = node.number, change.row.names = FALSE)
Partialmarkov.propertiesMAT <- select.markov.propertiesMAT(TheTree, PartialTree, markov.propertiesMAT)
if (SeedVal == 0) SeedVal <- FALSE
tempo1 <- Sys.time()
Mktable <- markov.coort.table(PartialTree, Partialmarkov.propertiesMAT, markov.termination = TerminalVal,
initial.coort = IndividuosVal, seed = SeedVal, absorventstatedeath = .absorventstateconf)
tempo2 <- Sys.time()
# assign("Mktable", Mktable, .EnvironmentArvoRe)
Mktable <- list(Mktable)
names(Mktable) <- TheTree$Node.name[position]
summary.simulation.window(Mktable,
tempo1 = tempo1,
tempo2 = tempo2,
CicloVal = dim(Mktable)[1],
tipo.nodo = "M",
digits = .digits)
tkdestroy(dialogsimulationwindow)
tkfocus(tt)
} else {
msg <- paste("Este não é um valor válido para o número de de indivíduos na coorte '",IndividuosVal, "'")
tkmessageBox(message=msg)
tkconfigure(dialogsimulationwindow,cursor="arrow")
tkfocus(dialogsimulationwindow)
}
} else {
msg <- paste("Este não é um valor válido para o número de ciclos '",CicloVal, "'")
tkmessageBox(message=msg)
tkconfigure(dialogsimulationwindow,cursor="arrow")
tkfocus(dialogsimulationwindow)
}
}
OK.but <-tkbutton(dialogsimulationwindow,text=" OK ",command=OnOK)
tkbind(Seed.Value, "<Return>",OnOK)
tkbind(Individuos.Value, "<Return>",OnOK)
tkbind(Terminal.Value, "<Return>",OnOK)
OnCancel <- function()
{
tkdestroy(dialogsimulationwindow)
tkfocus(tt)
}
Cancel.but <-tkbutton(dialogsimulationwindow, text=" Cancelar ", command=OnCancel)
tkbind(dialogsimulationwindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
posiciona.janela.no.mouse(dialogsimulationwindow, 250, 200)
# tcl("tkwait","window",dialogsimulationwindow)
tkfocus(dialogsimulationwindow)
} else {
if (node.type == "D") {
############ DECISION ############
dialogsimulationwindow <- tktoplevel()
title <- "ÁrvoRe - Simulação Markov"
tkwm.title(dialogsimulationwindow,title)
Seedvar <- tclVar(0)
Individuosvar <- tclVar(10000)
Terminalvar <- tclVar("(.stage >= 10)")
Trialssvar <- tclVar(10000)
Seed.Value <- tkentry(dialogsimulationwindow,width="20",textvariable=Seedvar)
tkgrid(tklabel(dialogsimulationwindow,text="Semente (zero indica semente não determinada)"),
row = 0, column = 0, columnspan = 2, sticky = "n")
tkgrid(Seed.Value, row = 1, column = 0, columnspan = 2, sticky = "n")
Individuos.Value <- tkentry(dialogsimulationwindow,width="20",textvariable=Individuosvar)
tkgrid(tklabel(dialogsimulationwindow,text="Número de indivíduos na coorte (Markov) \n Número de repetições (random walk) (Chance/Terminal)"),
row = 2, column = 0, columnspan = 2, sticky = "n")
tkgrid(Individuos.Value, row = 3, column = 0, columnspan = 2, sticky = "n")
Terminal.Value <- tkentry(dialogsimulationwindow,width="20",textvariable=Terminalvar)
tkgrid(tklabel(dialogsimulationwindow,text="Condição de término da simulação"),
row = 4, column = 0, columnspan = 2, sticky = "n")
tkgrid(Terminal.Value, row = 5, column = 0, columnspan = 2, sticky = "n")
# Trialss.Value <- tkentry(dialogsimulationwindow,width="20",textvariable=Trialssvar)
# tkgrid(tklabel(dialogsimulationwindow,text="Número de repetições (random walk)"),
# row = 6, column = 0, columnspan = 2, sticky = "n")
# tkgrid(Trialss.Value, row = 7, column = 0, columnspan = 2, sticky = "n")
tkgrid(tklabel(dialogsimulationwindow,text=" "), columnspan = 2, sticky = "n")
OnOK <- function()
{
tkconfigure(dialogsimulationwindow,cursor="watch") # faz com que o cursor mude para busy
SeedVal <- as.integer(tclvalue(Seedvar))
IndividuosVal <- as.integer(tclvalue(Individuosvar))
TerminalVal <- as.character(tclvalue(Terminalvar))
TrialssVal <-IndividuosVal
# TrialssVal <- as.integer(tclvalue(Trialssvar))
if ( (is.numeric(SeedVal)) && (!is.na(SeedVal)) && (nchar(SeedVal) > 0) ) {
if ( (is.numeric(IndividuosVal)) && (!is.na(IndividuosVal)) && (nchar(IndividuosVal) > 0) ) {
nodestoSim <- subset(TheTree, Level == column + 1)
nodestoSim <- subset(nodestoSim, Father == node.number)
Times.to.sim.init <- array(,0)
Times.to.sim.final <- array(,0)
Names.to.sim <- array(,0)
Types.to.sim <- array(,0)
Sim.list.to.resume <- list()
for ( nodeinquestion in 1:length(nodestoSim$Node.N) ) {
nodegotosim.Type <- nodestoSim$Type[nodeinquestion]
nodegotosim.Name <- nodestoSim$Node.name[nodeinquestion]
nodegotosim.Node.N <- nodestoSim$Node.N[nodeinquestion]
nodegotosim.Level <- nodestoSim$Level[nodeinquestion]
if ( nodegotosim.Type == "M") {
PartialTree <- select.subtree(TheTree,
node.col = nodegotosim.Level,
node.number = nodegotosim.Node.N,
change.row.names = FALSE)
Partialmarkov.propertiesMAT <- select.markov.propertiesMAT(TheTree,
PartialTree,
markov.propertiesMAT)
if (SeedVal == 0) SeedVal <- FALSE
tempo1 <- Sys.time()
Times.to.sim.init <- c(Times.to.sim.init, Sys.time())
Sim.list.to.resume[[nodeinquestion]] <- markov.coort.table(PartialTree,
markov.propertiesMAT = Partialmarkov.propertiesMAT,
markov.termination = TerminalVal,
initial.coort = IndividuosVal,
seed = SeedVal,
absorventstatedeath = .absorventstateconf)
tempo2 <- Sys.time()
Times.to.sim.final <- c(Times.to.sim.final, Sys.time())
Names.to.sim <- c(Names.to.sim, nodegotosim.Name)
Types.to.sim <- c(Types.to.sim, "M")
}
if ( nodegotosim.Type == "C") {
PartialTree <- select.subtree(TheTree,
node.col = nodegotosim.Level,
node.number = nodegotosim.Node.N,
change.row.names = FALSE)
if (SeedVal == 0) SeedVal <- FALSE
tempo1 <- Sys.time()
Times.to.sim.init <- c(Times.to.sim.init, Sys.time())
Sim.list.to.resume[[nodeinquestion]] <- simple.markov.coort.table(PartialTree,
trials = TrialssVal,
seed = SeedVal)
tempo2 <- Sys.time()
Times.to.sim.final <- c(Times.to.sim.final, Sys.time())
Names.to.sim <- c(Names.to.sim, nodegotosim.Name)
Types.to.sim <- c(Types.to.sim, "C")
}
if ( nodegotosim.Type == "T") {
PartialTree <- select.subtree(TheTree,
node.col = nodegotosim.Level,
node.number = nodegotosim.Node.N,
change.row.names = FALSE)
Times.to.sim.init <- c(Times.to.sim.init, Sys.time())
Sim.list.to.resume[[nodeinquestion]] <- terminal.markov.coort.table(PartialTree, trials = TrialssVal)
Times.to.sim.final <- c(Times.to.sim.final, Sys.time())
Names.to.sim <- c(Names.to.sim, nodegotosim.Name)
Types.to.sim <- c(Types.to.sim, "T")
# cat("NODO Terminal : fazendo nada | dialog.simulation() \n")
}
}
names(Sim.list.to.resume) <- Names.to.sim
summary.simulation.window(Sim.list.to.resume,
tempo1 = Times.to.sim.init,
tempo2 = Times.to.sim.final,
CicloVal = 999,
tipo.nodo = Types.to.sim,
digits = .digits)
tkdestroy(dialogsimulationwindow)
tkfocus(tt)
} else {
msg <- paste("Este não é um valor válido para o número de de indivíduos na coorte '",IndividuosVal, "'")
tkmessageBox(message=msg)
tkconfigure(dialogsimulationwindow,cursor="arrow")
tkfocus(dialogsimulationwindow)
}
} else {
msg <- paste("Este não é um valor válido para o número de ciclos '",CicloVal, "'")
tkmessageBox(message=msg)
tkconfigure(dialogsimulationwindow,cursor="arrow")
tkfocus(dialogsimulationwindow)
}
}
OK.but <-tkbutton(dialogsimulationwindow,text=" OK ",command=OnOK)
tkbind(Seed.Value, "<Return>",OnOK)
tkbind(Individuos.Value, "<Return>",OnOK)
tkbind(Terminal.Value, "<Return>",OnOK)
OnCancel <- function()
{
tkdestroy(dialogsimulationwindow)
tkfocus(tt)
}
Cancel.but <-tkbutton(dialogsimulationwindow, text=" Cancelar ", command=OnCancel)
tkbind(dialogsimulationwindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
posiciona.janela.no.mouse(dialogsimulationwindow, 300, 200)
# tcl("tkwait","window",dialogsimulationwindow)
tkfocus(dialogsimulationwindow)
} else {
if (node.type == "C") {
############ CHANCE ############
dialogsimulationwindow <- tktoplevel()
title <- "ÁrvoRe - Simulação Markov"
tkwm.title(dialogsimulationwindow,title)
Seedvar <- tclVar(0)
Trialssvar <- tclVar(10000)
# Terminalvar <- tclVar("(.stage >= 10)")
Seed.Value <- tkentry(dialogsimulationwindow,width="20",textvariable=Seedvar)
tkgrid(tklabel(dialogsimulationwindow,text="Semente (zero indica semente não determinada)"),
row = 0, column = 0, columnspan = 2, sticky = "n")
tkgrid(Seed.Value, row = 1, column = 0, columnspan = 2, sticky = "n")
Trialss.Value <- tkentry(dialogsimulationwindow,width="20",textvariable=Trialssvar)
tkgrid(tklabel(dialogsimulationwindow,text="Número de repetições (random walk)"),
row = 2, column = 0, columnspan = 2, sticky = "n")
tkgrid(Trialss.Value, row = 3, column = 0, columnspan = 2, sticky = "n")
# Terminal.Value <- tkentry(dialogsimulationwindow,width="20",textvariable=Terminalvar)
# tkgrid(tklabel(dialogsimulationwindow,text="Número de indivíduos na coorte"), sticky = "n")
# tkgrid(Terminal.Value, sticky = "n")
tkgrid(tklabel(dialogsimulationwindow,text=" "), columnspan = 2, sticky = "n")
OnOK <- function()
{
tkconfigure(dialogsimulationwindow,cursor="watch") # faz com que o cursor mude para busy
SeedVal <- as.integer(tclvalue(Seedvar))
TrialssVal <- as.integer(tclvalue(Trialssvar))
# TerminalVal <- as.character(tclvalue(Terminalvar))
if ( (is.numeric(SeedVal)) && (!is.na(SeedVal)) && (nchar(SeedVal) > 0) ) {
if ( (is.numeric(TrialssVal)) && (!is.na(TrialssVal)) && (nchar(TrialssVal) > 0) ) {
PartialTree <- select.subtree(TheTree, node.col = column, node.number = node.number, change.row.names = FALSE)
if (SeedVal == 0) SeedVal <- FALSE
tempo1 <- Sys.time()
Mktable <- simple.markov.coort.table(PartialTree, trials = TrialssVal, seed = SeedVal)
tempo2 <- Sys.time()
# assign("Mktable", Mktable, .EnvironmentArvoRe)
Mktable <- list(Mktable)
names(Mktable) <- TheTree$Node.name[position]
summary.simulation.window(Mktable,
tempo1 = tempo1,
tempo2 = tempo2,
CicloVal = dim(Mktable)[1],
tipo.nodo = "C",
digits = .digits)
tkdestroy(dialogsimulationwindow)
tkfocus(tt)
} else {
msg <- paste("Este não é um valor válido para o número de de indivíduos na coorte '",TrialssVal, "'")
tkmessageBox(message=msg)
tkconfigure(dialogsimulationwindow,cursor="arrow")
tkfocus(dialogsimulationwindow)
}
} else {
msg <- paste("Este não é um valor válido para o número de ciclos '",CicloVal, "'")
tkmessageBox(message=msg)
tkconfigure(dialogsimulationwindow,cursor="arrow")
tkfocus(dialogsimulationwindow)
}
}
OK.but <-tkbutton(dialogsimulationwindow,text=" OK ",command=OnOK)
tkbind(Seed.Value, "<Return>",OnOK)
tkbind(Trialss.Value, "<Return>",OnOK)
# tkbind(Terminal.Value, "<Return>",OnOK)
OnCancel <- function()
{
tkdestroy(dialogsimulationwindow)
tkfocus(tt)
}
Cancel.but <-tkbutton(dialogsimulationwindow, text=" Cancelar ", command=OnCancel)
tkbind(dialogsimulationwindow, "<Escape>",OnCancel)
tkgrid(OK.but, Cancel.but, sticky = "s", padx = 5, pady = 5)
posiciona.janela.no.mouse(dialogsimulationwindow, 250, 150)
# tcl("tkwait","window",dialogsimulationwindow)
tkfocus(dialogsimulationwindow)
} else {
if (node.type == "T") {
############ TERMINAL ############
msg <- paste("O nodo selecionado é do tipo 'Terminal'. Selecione um outro \n nodo da árvore para executar simulação.")
tkmessageBox(message = msg, icon="warning", title = "ÁrvoRe - AVISO")
tkfocus(tt)
#
# PartialTree <- select.subtree(TheTree,
# node.col = column, node.number = node.number,
# change.row.names = FALSE)
# tempo1 <- Sys.time()
# Mktable <- terminal.markov.coort.table(PartialTree)
# print(Mktable)
# tempo2 <- Sys.time()
# summary.simulation.window(Mktable,
# tempo1 = tempo1,
# tempo2 = tempo2,
# CicloVal = dim(Mktable)[1],
# tipo.nodo = "M",
# digits = .digits)
} else {
cat("ERROR: Tipo não reconhecido \n")
msg <- paste("O nodo selecionado é de tipo não reconhecido. Selecione um outro \n nodo da árvore para executar simulação.")
tkmessageBox(message = msg, icon="warning", title = "ÁrvoRe - AVISO")
tkfocus(tt)
}
}
}
}
}
}
[Package
arvoRe version 0.1.7
Index]