Some weeks ago I asked:this question, which unfortunately did not received any answer.
After recommendation, I tried to make a MRE and I hope that in this way everything will be much clear.
The problem is again, the conclusion of the model: AIC, VIF, Determination and AdjustedDetermination, are not printed correctly after multiple runs.
The first run of the application is ok, the report is 1:1 as in R Shiny App, but after, to second run (with another regression, variables etc), in report is printed again, the first run.
I hope this is more clear. For images you can check the hyperlink above,
Thanks in advance!
I can not provide the dataset, but you can try with any dataset on which the linear regression works.
R Shiny App:
library(shiny)
library(shinythemes)
library(DT)
library(ggplot2)
library(car)
library(nortest)
library(tseries)
library(RcmdrMisc)
library(lmtest)
library(readxl)
library(tseries)
library(dplyr)
library(nlme)
library(openxlsx)
library(skedastic)
library(knitr)
library(nnet)
library(reshape)
library(crunch)
runApp(
list(
ui = fluidPage(theme = shinytheme("cerulean"),
titlePanel("Model Validation"),
navbarPage("Let's get started",
tabPanel(icon("home"),
hr(),
tags$style(".fa-database {color:#E87722}"),
h3(p(em("Dataset "),icon("database",lib = "font-awesome"),style="color:black;text-align:center")),
fileInput("uploaded_file", "Choose Excel File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".xlsx")),
uiOutput("dropdownUI"),
#tableOutput("RawData"),
uiOutput("checkbox"),
uiOutput("ceckbox2"),
uiOutput("ceckbox3"),
fluidRow(column(DT::dataTableOutput("RawData"),
width = 12)),
hr(),
#radioButtons('report_format', 'Generate report:', c('PDF', 'HTML', 'Word'), inline = TRUE),
downloadButton(outputId = "report", label = "Download report"),
),
tabPanel("Model Replication",
#uiOutput("Regvariable"),
textOutput('textReg'),
uiOutput("varReg"),
p(strong('Model output',style="color:blue")),
fluidRow(
column(verbatimTextOutput("SummaryReg"),
br(),width = 6),
column(br(),
textOutput("Determination"),
br(),
textOutput("AdjustedDetermination"),
br(),width = 6,style="background-color:lavender;border-left:8px solid blue")
),p(strong('AIC',style="color:blue")),
fluidRow(column(verbatimTextOutput("AIC"),width=7)),
p(strong('Variance inflation factor',style="color:blue")),
fluidRow(column(verbatimTextOutput("VIF"),width=7),
column(width=1),
column(br(),
br(),textOutput("Alarm"),
br(),
br(),width = 4,style="background-color: #A8D9F3;border-left:8px solid blue;border-top: 1px solid black;border-right:1px solid black;border-bottom: 1px solid black")),
mainPanel()
),
tabPanel("Model Validation",
fluidRow(column(width=2),
column(
h4(p("Assumptions for model residuals",style="color:black;text-align:center")),
width=8,style="background-color:lavender;border-radius: 10px")),
br(),
br(),
hr(),
tabsetPanel(
tabPanel("Normality",
br(),
navlistPanel(widths=c(2,9),fluid = T,well = T,
tabPanel("Analytical test",
uiOutput("Norm"),
fluidRow(
column( verbatimTextOutput("Prueba2"),
br(),width = 6),
column(br(),
textOutput("Conclusion12"),
br(),width = 6,style="background-color:lavender;border-left:8px solid blue")
)
))))
))
)
,
server = function(input, output){
#Dataset
Workbook <- eventReactive(input$uploaded_file, {
loadWorkbook(input$uploaded_file$datapath)
})
Sheets <- eventReactive(Workbook(), {
names(Workbook())
})
output$dropdownUI <- renderUI({
req(Sheets())
selectInput("sheet", "Choose a sheet", Sheets())
})
datos <- eventReactive(input$sheet, {
read.xlsx(Workbook(), sheet = input$sheet)
})
df_sel <- reactive({
req(input$y)
req(input$x1)
req(input$x2)
df_sel <- datos() %>% select(input$y,input$x1,input$x2)
})
#Regression
output$Regvariable = renderUI({
if (is.null(datos())){
return(NULL)}
variables = colnames(datos())
checkboxGroupInput("Regvariable", "Choose Variables for regression", variables,selected = variables[[1]])
})
textReg=reactive({
paste("Model(e1):", Reg.model(),sep = " ")
})
output$textReg = renderText({
textReg()
})
output$varReg = renderUI({
if (is.null(datos())){
return(NULL)}
variables = colnames(datos())
div(class = "row-fluid",
div(class="span2",selectInput("DepVar", strong("Dependent Variable",style = "color:red"),variables)),
div(class="span2",checkboxGroupInput("Select", strong("Options",style = "color:blue"),c("No Intercept Model" = "NoIntercept"))),
#div(class="span1",checkboxInput("Nointercept", "No Intercept Model", FALSE)),
div(class="span1",checkboxGroupInput("IndepVar", strong("Indep Vars",style = "color:green"), variables,selected = variables[[2]])),
div(class="span1",radioButtons("Txdef", strong("Transform Dep Var",style = "color:green"),c(None = "dNone",Log= "dlog", Sqrt = "dsqrt",Square = "dsq",
Cube = "dcube", Exponential = "dexp")))
)
})
Reg.model <- reactive({
print(input$Select)
if (is.null(input$Txdef)){
return(NULL)
}
switch(input$Txdef,
dNone = { depvar = input$DepVar})
indepvar = NULL
if (!is.null(input$IndepVar)){
indepvar = c(indepvar, input$IndepVar)
}
if (!is.null(indepvar)){
if (!is.null(input$Select) && any(input$Select == "NoIntercept")){
model = paste(depvar,paste("-1+",paste(indepvar,collapse = "+"),sep = ""),sep="~")
}
else {
model = paste(depvar,paste(indepvar,collapse = "+"),sep = "~")
}
return(model)
}
else {
return(NULL)
}
})
Reg.fit = reactive({
if (is.null(input$IndepVar)){
return(NULL)
}
data1 = datos()
if (input$Txdef == "dlog"){
if (nrow(data1[data1[input$DepVar] <= 0,]) > 0){
data1[data1[input$DepVar] <=0,input$DepVar] = 1e-5}
}
#data1[input$IndepVar] = lapply(data1[input$IndepVar],as.factor)
data1[input$DepVar] = lapply(data1[input$DepVar],as.numeric)
#e1 = paste(input$DepVar,paste(input$IndepVar,collapse = "+"),sep = "~")
e1 = Reg.model()
fit = lm(formula(e1),data = data1)
return(fit)
saveRDS(fit, "Model.rds")
}
)
SummaryReg=reactive({
if (is.null(datos()))
return(NULL)
if (is.null(input$IndepVar))
return(NULL)
summary(Reg.fit())
})
output$SummaryReg <- renderPrint({
SummaryReg()
})
VIF=reactive({
if(length(Reg.fit()$coefficients)<2){
mensaje="The model must have at least two explanatory variables to execute this function"
mensaje
}
else
{
vif(Reg.fit())
}
})
output$VIF <- renderPrint({
VIF()
})
aic=reactive({
AIC(Reg.fit())
})
output$AIC=renderPrint({
aic()
})
Alarm=reactive({
if(length(Reg.fit()$coefficients)<=2){
paste("The model does not has enough independent variables")
}
else
{
listadevifs <- vif(Reg.fit())
mensaje="There are no multicollinearity problems"
nombres <- vector(mode = "numeric",length = 7)
for(i in 1:length(listadevifs)){
if(listadevifs[[i]]>5){
mensaje="There are multicollinearity problems in the following variables:"
nombres[i] = i
}
}
variablesconproblemas <- paste(names(listadevifs[nombres]),collapse = ", ")
if(nombres[1]==0 & nombres[2]==0 & nombres[3]==0 & nombres[4]==0 & nombres[5]==0 & nombres[6]==0 & nombres[7]==0){
mensaje
}
else
{
paste(mensaje,variablesconproblemas,". You should keep only one of these.")
}
}
})
output$Alarm <- renderText({
Alarm()
})
Determination=reactive({
valoresp <- summary(Reg.fit())$coefficients[,4]
mensaje1 = "All the model parameters are significant for a confidence level of 95%"
nombresbetas <- vector(mode = "numeric",length = 6)
for(i in 1:length(valoresp)){
if(valoresp[[i]]>0.05){
mensaje1="There are parameters which are not significant, these parameters correspond to:"
nombresbetas[i]=i
}
}
betasnosignificativos <- paste(names(valoresp[nombresbetas]),collapse = ", ")
paste(mensaje1, betasnosignificativos)
})
output$Determination <- renderText({
Determination()
})
AdjustedDetermination=reactive({
Rajustado <- summary(Reg.fit())$adj.r.squared
paste("With the current model you got an adjusted R squared of",format(round(Rajustado,2),nsmall=2), ".")
})
output$AdjustedDetermination <- renderText({
AdjustedDetermination()
})
#Normality
output$Norm = renderUI({
checkboxGroupInput("Norm", "Choose test the verify the normality of the residuals", choices=c("Shapiro-Wilk"=1,"Anderson-Darling"=2,"Cramer-von Mises"=3,"Kolmogorov-Smirnov"=4,"Jarque-Bera"=5))
})
testanalitico2 <- reactive({
if (is.null(input$Norm)){
return(NULL)
}
if(input$Norm == 1){
shapiro.test(Reg.fit()$residuals)
}
})
output$Prueba2 <- renderPrint({
testanalitico2()
})
concprueba2=reactive({
if(testanalitico2()$p.value < 0.05){paste("The normality condition is not met according to Shapiro-Wilk test, pvalue = ",format(round(testanalitico2()$p.value,2),nsmall=2))}else{paste("The errors are normally distributed according to Shapiro-Wilk test, pvalue =",format(round(testanalitico2()$p.value,2),nsmall=2))}
})
output$Conclusion12 <- renderText({
concprueba2()
})
output$report = downloadHandler(
filename = 'myreport.pdf',
content = function(file) {
out = knit2pdf('stackoverflow.Rnw', clean = TRUE)
file.rename(out, file) # move pdf to file for downloading
},
contentType = 'application/pdf'
)
}
)
)
R Sweave:
\documentclass{article}
\title{ Model Replication and Validation Report}
\begin{document}
\maketitle
<<setup, cache = FALSE, echo=FALSE>>=
opts_chunk$set(width=200)
@
<<Concstat,echo=FALSE>>=
library(knitr)
options(digits=2)
@
\section{Regression Model}
Replication of the regression model:
<<Model,echo=FALSE>>=
opts_chunk$set(comment="", message=FALSE,tidy.opts=list(keep.blank.line=TRUE, width.cutoff=120),options(width=100), cache=TRUE,fig.align='center',fig.height=6, fig.width=10,fig.path='figure/beamer-',fig.show='hold',size='footnotesize', cache=TRUE)
print(textReg())
print(Reg.model())
print(SummaryReg())
@
Conclusion of the model:
AIC:
<<echo=FALSE>>=
print(aic())
@
VIF:
<<echo=FALSE>>=
print(VIF())
@
Parameters:
<<echo=FALSE>>=
print( Determination())
@
Adjusted R Squared:
<<Vif,echo=FALSE>>=
print(AdjustedDetermination())
@
After replication, we begin the model validation, testing the assumptions of linear model.
\subsection{Normality of the residuals}
<<nor,echo=FALSE>>=
print(testanalitico2())
print( concprueba2())
@
\end{document}