Section 30 Code
The following block of code used built in functions from the Shiny library to create a User Interface.
##USER INTERFACE
# Create input boxes for user
ui<-pageWithSidebar(
headerPanel('Property Price Modelling'),
sidebarPanel(
numericInput('Number', 'Covariate Count', 10,
min = 1, max = 10),
selectInput('input1', 'Covariate 1', names(data6),
selected='ConstructionYear'),
selectInput('input2', 'Covariate 2', names(data6),
selected='LivingSpace'),
selectInput('input3', 'Covariate 3', names(data6),
selected='NumberOfFloors'),
selectInput('input4', 'Covariate 4', names(data6),
selected='SeattleFlag'),
selectInput('input5', 'Covariate 5', names(data6),
selected='RenovationYear'),
selectInput('input6', 'Covariate 6', names(data6),
selected='TotalArea'),
selectInput('input7', 'Covariate 7', names(data6),
selected='NumberOfBedrooms'),
selectInput('input8', 'Covariate 8', names(data6),
selected='NumberOfBathrooms'),
selectInput('input9', 'Covariate 9', names(data6),
selected='condition'),
selectInput('input10', 'Covariate 10', names(data6),
selected='grade')
),
#Create output panels for results
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plots",
h3("Predicted Log Sale Prices"),
plotOutput('plot2'),
h3("Actual Log Sale Prices"),
plotOutput('plot1')
#,plotOutput('plot3')
),
tabPanel("Model Fit",
verbatimTextOutput("model"),
textInput("text_model", label = "Interpretation", value = "Enter text..."))
))
)
The following block of code used built in functions from the Shiny library to perform Server calcualtions.
#Server Calculations
server<-function(input, output, session) {
#Initial set-up
library(lattice) # required for trellis.par.set():
trellis.par.set(sp.theme()) # sets color ramp to bpy.colors()
cuts<-10:18/8
rw.colors<-colorRampPalette(c("white","red"))
#Switch model fitted depending on input from user interface
test1 <- function(type) {
switch(type,
"1" = as.formula(paste('LogSalePrice', '~', input$input1)),
"2" = as.formula(paste('LogSalePrice', '~', input$input1,'+',input$input2)),
"3" = as.formula(paste('LogSalePrice', '~', input$input1,'+',input$input2,
'+',input$input3)),
"4"=as.formula(paste('LogSalePrice', '~', input$input1,'+',input$input2,
'+',input$input3,'+',input$input4)),
"5"=as.formula(paste('LogSalePrice', '~', input$input1,'+',input$input2,
'+',input$input3,'+',input$input4,
'+',input$input5)),
"6"=as.formula(paste('LogSalePrice', '~', input$input1,'+',input$input2,
'+',input$input3,'+',input$input4,'+',input$input5,
'+',input$input6)),
"7"=as.formula(paste('LogSalePrice', '~', input$input1,'+',input$input2,
'+',input$input3,'+',input$input4,'+',input$input5,
'+',input$input6,'+',input$input7)),
"8"=as.formula(paste('LogSalePrice', '~', input$input1,'+',input$input2,
'+',input$input3,'+',input$input4,'+',input$input5,
'+',input$input6,'+',input$input7,'+',input$input8)),
"9"=as.formula(paste('LogSalePrice', '~', input$input1,'+',input$input2,
'+',input$input3,'+',input$input4,'+',input$input5,
'+',input$input6,'+',input$input7,'+',input$input8,
'+',input$input9)),
"10"=as.formula(paste('LogSalePrice', '~', input$input1,'+',input$input2,'+',
input$input3,'+',input$input4,'+',input$input5,
'+',input$input6,'+',input$input7,'+',input$input8,
'+',input$input9,'+',input$input10)))
}
par(mar=c(0,0,0,0)+0.1)
regFormula <- reactive({
test1(input$Number)
})
# Combine the selected variables into a new data frame
model <- reactive({
lm(regFormula(), data = data6)
})
# Plot the results of model fitting
output$plot1 <- renderPlot({
par(mar=c(0,0,0,0)+0.1)
#image(MyMap2,red="r",green="g",blue="b")
spplot(data6,"LogSalePrice",do.log = TRUE,
key.space=list(x=0.2,y=0.9,corner=c(-1,2.7)),
at=cuts,cex=0.1,colorkey=list(labels=list(at=cuts)),pch=1,pretty=TRUE)
#box()
})
# Plot the property price distribution
output$plot2 <- renderPlot({
data6$prediction2<-predict(model())
par(mar=c(0,0,0,0)+0.1)
#image(MyMap2,red="r",green="g",blue="b")
spplot(data6,"prediction2",do.log = TRUE,
key.space=list(x=0.2,y=0.9,corner=c(-1,2.7)),
at=cuts,cex=0.1,colorkey=list(labels=list(at=cuts)),pch=1,pretty=TRUE)
#box()
})
# Output Summary Statistica on the Model
output$model <- renderPrint({
summary(model())
})