#' Fit univariate NL-SMSN regression
#'
#' This function is used to fit univariate NL-SMSN regression using a GUI
#'
#' @importFrom nlsmsn smsn.nl
#' @export
gsmsn.nl <- function() {
.env <- environment()
model <- NULL
# Top frame
tt <- tktoplevel()
tkwm.title(tt,"smsn.nl")
# Read data file
frame0 <- ttklabelframe(tt, text = "Data")
tkgrid(frame0)
nomearquivo1 <- tclVar("")
aux<- tclVar(0)
entry.nomearquivo<-tkentry(frame0,width="20",textvariable=nomearquivo1)
ler <-function() {
tclvalue(aux) <- 1
tclvalue(nomearquivo1) <- tkgetOpenFile()
}
ok1<-function() {
tkdestroy(frame0)
}
ler.but <- tkbutton(frame0,text="...",command= ler)
ok.but1 <- tkbutton(frame0,text="Load",command= ok1)
tkgrid(entry.nomearquivo, ler.but)
tkgrid(ok.but1)
tkbind(tt,"<Destroy>", function() tclvalue(aux) <- 2)
tkwait.variable(aux)
dados<-NULL
if(tclvalue(aux)== 1){
dados=read.table(tclvalue(nomearquivo1), header = T)
}
tkwait.window(frame0)
frameTop <- tkframe(tt)
frameA <- tkframe(frameTop, borderwidth=2, relief="groove")
frameB<-tkframe(frameTop, relief = "groove", borderwidth = 2)
frameC <- tkframe(frameTop, relief = "groove", borderwidth = 2)
tkgrid(frameA, frameB, frameC)
#-------------- Mistura
frame1 <- ttklabelframe(frameA, text = "Mixture")
rbValue <- tclVar("t")
rb1 <- tkradiobutton(frame1,variable=rbValue)
rb2 <- tkradiobutton(frame1,variable=rbValue)
rb3 <- tkradiobutton(frame1,variable=rbValue)
rb4 <- tkradiobutton(frame1,variable=rbValue)
rb5 <- tkradiobutton(frame1,variable=rbValue)
rb6 <- tkradiobutton(frame1,variable=rbValue)
tkgrid(tklabel(frame1,text="t"),rb1)
tkgrid(tklabel(frame1,text="Skew.t"),rb2)
tkgrid(tklabel(frame1,text="Skew.cn"),rb3)
tkgrid(tklabel(frame1,text="Skew.slash"),rb4)
tkgrid(tklabel(frame1,text="Skew.normal"),rb5)
tkgrid(tklabel(frame1,text="Normal"),rb6)
tkgrid(frame1)
#---------------- Variavel Resposta
frame2<- ttklabelframe(frameA, text="Response variable")
combo.names1 = c("",names(dados))
comboBoxVar1 <- tclVar()
tclvalue(comboBoxVar1) <- combo.names1[1]
comboBox01 <- ttkcombobox(frame2, values=combo.names1,
textvariable=comboBoxVar1,width="10", state="readonly")
tkgrid(comboBox01)
tkgrid(frame2)
#-----
frame3<- ttklabelframe(frameA, text="Covariates")
cb<-list()
cbvalue<-list()
for(i in 1:length(names(dados))){
cb[[i]]<- tkcheckbutton(frame3)
cbvalue[[i]]<- tclVar(0)
tkconfigure(cb[[i]],variable=cbvalue[[i]],state="normal")
tkgrid(tklabel(frame3,text=names(dados)[i]),cb[[i]])
}
tkgrid(frame3)
#tt <- tktoplevel()
#tkwm.title(tt,"Prova")
#--------------Chutes Iniciais
frame4 <- ttklabelframe(frameC, text = "Initial values")
#------Sigma2
sigma2 <- tclVar("0")
entry.sigma2 <-tkentry(frame4,width="12",textvariable=sigma2)
tkgrid(tklabel(frame4,text="sigma2"),entry.sigma2)
#------shape
shape <- tclVar("0")
entry.shape <-tkentry(frame4,width="12",textvariable=shape)
tkgrid(tklabel(frame4,text="shape"),entry.shape)
#------rho
rho <- tclVar("0")
entry.rho <-tkentry(frame4,width="12",textvariable=rho,state="disabled")
tkgrid(tklabel(frame4,text="rho"),entry.rho)
tkgrid(frame4)
#------nu
nu <- tclVar("0")
entry.nu <- tkentry(frame4, width="12", textvariable=nu)
tkgrid(tklabel(frame4,text="nu"), entry.nu)
tkgrid(frame4)
disable_nu <- function() {
tkconfigure(entry.nu, state="disabled")
}
enable_nu <- function() {
tkconfigure(entry.nu, state="normal")
}
tkconfigure(rb1,value="t",width=4, command=enable_nu)
tkconfigure(rb2,value="Skew.t", command=enable_nu)
tkconfigure(rb3,value="Skew.cn", command=enable_nu)
tkconfigure(rb4,value="Skew.slash", command=enable_nu)
tkconfigure(rb5,value="Skew.normal",command=disable_nu)
tkconfigure(rb6,value="Normal",command=disable_nu)
#------betas
betas <- tclVar("c(1,1,1)")
entry.betas <-tkentry(frame4,width="12",textvariable=betas)
tkgrid(tklabel(frame4,text="betas"),entry.betas)
tkgrid(frame4)
# Regression type
regtype.frame<-tkframe(frameB,relief="groove",borderwidth=2)
z.reg <- c("Homoscedastic","Heteroscedastic")
reg.type <- tclVar(z.reg[1])
combobox.reg<-ttkcombobox(regtype.frame,values=z.reg,textvariable=reg.type,state="readonly")
tkgrid(tklabel(regtype.frame,text="Regression type:"))
tkgrid(combobox.reg)
tkgrid(regtype.frame)
# Rho function
rho.frame<-tkframe(frameB,relief="groove",borderwidth=2)
z.rho <- c("exp(z*rho)","z^rho")
rho.func <- tclVar(z.rho[1])
combobox.rho<-ttkcombobox(rho.frame,values=z.rho,textvariable=rho.func,state="disabled")
tkgrid(tklabel(rho.frame,text="Rho function:"))
tkgrid(combobox.rho)
tkgrid(rho.frame)
heteroscedastic <- function() {
tclvalue(reg.type)==z.reg[2]
}
normal <- function() {
tclvalue(rbValue) == "Normal" || tclvalue(rbValue) == "Skew.normal"
}
# z variables
z.frame<-tkframe(frameB, relief = "groove", borderwidth = 2)
tkgrid(tklabel(z.frame, text = "Z variables:"), columnspan = 2)
cbuttons <- list()
cbValues <- list()
variables <- names(dados)
for(i in 1:length(variables)) {
cbuttons[[i]] <- tkcheckbutton(z.frame)
cbValues[[i]] <- tclVar(0)
tkconfigure(cbuttons[[i]],variable = cbValues[[i]], state="disabled")
tkgrid(tklabel(z.frame,text = variables[i]), cbuttons[[i]])
}
tkgrid.configure(z.frame, sticky = "we")
tkgrid(z.frame)
func1<-function() {
j = which(names(dados)==tclvalue(comboBoxVar1))
tkconfigure(cb[[j]],state="disabled")
tkconfigure(cbuttons[[j]],state="disabled")
o = (1:length(names(dados)))[-j]
for (i in o){
tkconfigure(cb[[i]],state="normal")
if(heteroscedastic()) tkconfigure(cbuttons[[i]],state="normal")
}
}
tkbind(comboBox01, "<<ComboboxSelected>>", func1)
checkType <- function() {
if(heteroscedastic()) {
tkconfigure(combobox.rho,state="readonly")
for(i in 1:length(variables)) {
if(names(dados)[i]!=tclvalue(comboBoxVar1)) tkconfigure(cbuttons[[i]], state="normal")
}
tkconfigure(entry.rho, state="normal")
}
if(!heteroscedastic()) {
tkconfigure(combobox.rho,state="disabled")
for(i in 1:length(variables)) {
tkconfigure(cbuttons[[i]], state="disabled")
}
tkconfigure(entry.rho, state="disabled")
}
}
tkbind(combobox.reg, "<<ComboboxSelected>>", checkType)
# Linear function
tkgrid(tklabel(frameC,text="Linear function:"))
txt <- tktext(frameC, width = 30, height = 8)
tkgrid(txt)
tkmark.set(txt,"insert","0.0")
frameD <- tkframe(tt, borderwidth=2, relief="groove")
criteriabutton <- tkcheckbutton(frameD)
criteriaValue <- tclVar(0)
tkconfigure(criteriabutton, variable = criteriaValue)
Ok <-function() {
code <- tclvalue(tkget(txt,"0.0","end"))
assign("linear.func", eval(parse(text=code)))
covar <- cbind(variables,unlist(lapply(cbvalue, tclvalue)))
covar.names <- covar[covar[,2]=="1",1]
covar.var <- cbind(variables,unlist(lapply(cbValues, tclvalue)))
covar.var.names <- covar.var[covar.var[,2]=="1",1]
var <- tclvalue(comboBoxVar1)
nu_value <- as.numeric(tclvalue(nu))
if(normal()) nu_value <- NULL
model <- smsn.nl(
y = dados[,var],
x = dados[,covar.names],
z = ifelse(heteroscedastic(), dados[,covar.var.names], NULL),
betas = eval(parse(text=tclvalue(betas))),
sigma2 = as.numeric(tclvalue(sigma2)),
shape = as.numeric(tclvalue(shape)),
rho = ifelse(heteroscedastic(), as.numeric(tclvalue(rho)), NULL),
nu = nu_value,
nlf = linear.func,
reg.type = tclvalue(reg.type),
criteria = as.logical(as.numeric(tclvalue(criteriaValue))),
family = tclvalue(rbValue),
iter.max = 200
)
assign("model", model, envir = .env)
tkdestroy(tt)
}
ok.but <- tkbutton(frameD,text=" Ok ",command= Ok)
tkgrid(tklabel(frameD,text = "Comparison criteria"), criteriabutton)
tkgrid(ok.but)
tkgrid(frameTop)
tkgrid(frameD)
tkwait.window(tt)
model
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.