#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny) # required package to build the application
library(shinydashboard) # for UI layout
##
## Attaching package: 'shinydashboard'
## The following object is masked from 'package:graphics':
##
## box
library(shinyWidgets) # enhance the apprearance of UI
library(bslib)
##
## Attaching package: 'bslib'
## The following object is masked from 'package:utils':
##
## page
library(DT) # package to display interactive tables
##
## Attaching package: 'DT'
## The following objects are masked from 'package:shiny':
##
## dataTableOutput, renderDataTable
library(tidyverse) # data manipulation package
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.5 v dplyr 1.0.7
## v tidyr 1.1.4 v stringr 1.4.0
## v readr 2.0.2 v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(tidymodels) # machine learning package
## Registered S3 method overwritten by 'tune':
## method from
## required_pkgs.model_spec parsnip
## -- Attaching packages -------------------------------------- tidymodels 0.1.4 --
## v broom 0.7.9 v rsample 0.1.0
## v dials 0.0.10 v tune 0.1.6
## v infer 1.0.0 v workflows 0.2.4
## v modeldata 0.1.1 v workflowsets 0.1.0
## v parsnip 0.1.7 v yardstick 0.0.8
## v recipes 0.1.17
## -- Conflicts ----------------------------------------- tidymodels_conflicts() --
## x broom::bootstrap() masks bslib::bootstrap()
## x scales::discard() masks purrr::discard()
## x dplyr::filter() masks stats::filter()
## x recipes::fixed() masks stringr::fixed()
## x dplyr::lag() masks stats::lag()
## x infer::observe() masks shiny::observe()
## x yardstick::spec() masks readr::spec()
## x recipes::step() masks stats::step()
## * Learn how to get started at https://www.tidymodels.org/start/
library(autoplotly)
library(readxl) # for reading excel files
# Define UI for application that allows interaction between user and server and displays outputs
ui <- dashboardPage(
dashboardHeader(title = "Insurance Pricing App"),
dashboardSidebar(
sidebarMenu(
id='menu',
menuItem('View data table',tabName = 'vdata',icon = icon('th')),
menuItem('Plots', tabName = 'plot', icon = icon('pencil')),
menuItem('GLM pricing models',tabName = 'glmmodels', icon = icon('line'))
),
br(),
br(),
tags$small(hr(),
radioButtons(
"fileType_Input",
label = tags$u(tags$samp("UPLOAD & CHOOSE FILE TYPE")),
choices = list(".csv/txt"=1, ".xlsx"=2),
selected = 1,inline = TRUE
),
fileInput(
'file1',
tags$h6('browse to upload a file:'),
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv',
'.xlsx')),
hr())
),
dashboardBody(
tabItems(
tabItem(tabName = 'vdata', fluidPage(tabsetPanel(tabPanel('Data table', dataTableOutput('table'))))),
tabItem(tabName = 'plot', tabsetPanel(tabPanel('Plots',sidebarLayout(sidebarPanel(
selectInput('xcol','',''),
selectInput('ycol','',''),
prettyRadioButtons(
inputId = 'change_line',label = 'change line on scatter plot',choices = c('lm','gamma','poisson'))
),mainPanel(plotOutput('plots')))))),
tabItem(tabName = 'glmmodels',
fluidPage(tabsetPanel(
tabPanel('General Linear pricing models',
sidebarLayout(
sidebarPanel(
uiOutput('xvariable'),
uiOutput('yvariable'),
prettyRadioButtons(
inputId = 'change_model',label = 'change model',choices = c('lm','gamma','poisson'))
),
mainPanel(
prettyRadioButtons(inputId = 'display_outputs',label = 'choose output to display',choices = c('model summary', 'regression plots', 'predicted values & residuals'),inline = TRUE),
dataTableOutput('pred_res'),
verbatimTextOutput('glmSummary'),
plotOutput('diagnosticplot')
)))
)
)
)
)
)
)
## The `name` provided ('pencil') is deprecated in Font Awesome 5:
## * please consider using 'pencil-alt' or 'fas fa-pencil-alt' instead
## * use the `verify_fa = FALSE` to deactivate these messages
# Define server logic required to produce the outputs in the UI
server <- function(input, output, session) {
data <- reactive({
validate(need(input$file1 != "", "Please upload a data set" ))
req(input$file1) ## ?req # require that the input is available
inFile <- input$file1
# tested with a following dataset: write.csv(mtcars, "mtcars.csv")
# and write.csv(iris, "iris.csv")
df<-{if(is.null(inFile)){return(NULL)}
if(input$fileType_Input=="1"){
read.csv(inFile$datapath,
header = TRUE,
stringsAsFactors = FALSE)
}else{
execute_safely( read_xlsx(inFile$datapath, 1))
}}
# Update inputs (you could create an observer with both updateSel...)
# You can also constraint your choices. If you wanted select only numeric
# variables you could set "choices = sapply(df, is.numeric)"
# It depends on what do you want to do later on.
updateSelectInput(session, inputId = 'xcol', label = 'X Variable',
choices = names(df), selected = names(df)[1])
updateSelectInput(session, inputId = 'ycol', label = 'Y Variable',
choices = names(df), selected = names(df)[1])
return(df)})
output$table<-renderDataTable({
data()
})
output$tb1 <- renderDataTable( data())
output$xvariable <- renderUI({
req(data())
xa<-colnames(data())
pickerInput(inputId = 'xvar',
label = 'Select x-axis variable',
choices = c(xa[1:length(xa)]), selected=xa[2],
options = list(`style` = "btn-info"),
multiple = TRUE)
})
output$yvariable <- renderUI({
req(data())
ya<-colnames(data())
pickerInput(inputId = 'yvar',
label = 'Select y-axis variable',
choices = c(ya[1:length(ya)]), selected=ya[1],
options = list(`style` = "btn-info"),
multiple = FALSE)
})
lmModel <- reactive({
if(input$change_model=='lm'){req(data(),input$xvar,input$yvar)
x <- as.numeric(data()[[as.name(input$xvar)]])
y <- as.numeric(data()[[as.name(input$yvar)]])
current_formula <- paste0(input$yvar, " ~ ",paste0(input$xvar, collapse = " + "))
current_formula <- as.formula(current_formula)
model <- lm(current_formula, data = data(), na.action=na.exclude)
return(model)}
else if(input$change_model=='gamma'){
req(data(),input$xvar,input$yvar)
x <- as.numeric(data()[[as.name(input$xvar)]])
y <- as.numeric(data()[[as.name(input$yvar)]])
current_formula <- paste0(input$yvar, " ~ ",paste0(input$xvar, collapse = " + "))
current_formula <- as.formula(current_formula)
model <- glm(current_formula, data = data(),family=Gamma(link = log), na.action=na.exclude)
return(model)}
else if(input$change_model=='poisson'){req(data(),input$xvar,input$yvar)
x <- as.numeric(data()[[as.name(input$xvar)]])
y <- as.numeric(data()[[as.name(input$yvar)]])
current_formula <- paste0(input$yvar, " ~ ",paste0(input$xvar, collapse = " + "))
current_formula <- as.formula(current_formula)
model <- glm(current_formula, data = data(),family=poisson(link = log), na.action=na.exclude)
return(model)}
})
output$glmSummary <- renderPrint({
req(lmModel())
if(input$display_outputs=='model summary'){
summary(lmModel())}
else {}
})
output$pred_res<-renderDataTable({
if(input$display_outputs=='predicted values & residuals'){
datatable(
{mydat2=augment(lmModel())},
extensions = c('Buttons'),
options = list(dom = 'Blfrtip', pageLength = 4, editable = 'cell',
buttons = list("csv",list(extend="excel", filename =input$group))),
class = "hover cell-border stripe")}
else{}
})
output$diagnosticplot<-renderPlot({
if(input$display_outputs=='regression plots'){
autoplot(lmModel())
}else{}
})
output$plots<-renderPlot({
# This plot helps helps us understand how general regression models work. lm is an abbreviation of linear model and it is a straight line that shows the relationship between independent variables and response variables. lm models are suitable if the distribution is normal.
# Otherwise gamma and poison models are general linear models that model and predict the distribution of non negative variables. gamma models only applies to variables above zero. poisson models applies to variables including and above zero. Therefore poisson and gamma models are suitable when regressing variables that do not take negative values such as insurance claims and premium prices
if(input$change_line=='lm'){
ggplot(data = data(),aes_string(x=input$xcol, y=input$ycol)) +
geom_point() +
geom_line() +
geom_smooth(method = 'lm')+ theme(axis.title = element_text(size = 15))+ labs(x=input$xcol,y=input$ycol,title = '')}
else if(input$change_line=='gamma'){
ggplot(data = data(),aes_string(x=input$xcol, y=input$ycol)) +
geom_point() +
geom_line() +
geom_smooth(method = 'gam')+ theme(axis.title = element_text(size = 15))+ labs(x=input$xcol,y=input$ycol,title = '')}
else if(input$change_line=='poisson'){
ggplot(data = data(),aes_string(x=input$xcol, y=input$ycol)) +
geom_point() +
geom_line() +
geom_smooth(method = 'glm',method.args=list(family=poisson))+ theme(axis.title = element_text(size = 15))+ labs(x=input$xcol,y=input$ycol,title = '')}
})
}
# Run the application
shinyApp(ui = ui, server = server)
## PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.
Shiny applications not supported in static R Markdown documents