Skip to content

Instantly share code, notes, and snippets.

@davan690

davan690/#3d_regression.txt

Forked from GegznaV/#3d_regression.txt
Created October 6, 2020 05:51
Show Gist options
  • Save davan690/9647745d7db44699d6b0b5f996134429 to your computer and use it in GitHub Desktop.
Save davan690/9647745d7db44699d6b0b5f996134429 to your computer and use it in GitHub Desktop.
Download ZIP
3D Regression: Shiny app at http://www.statistics.calpoly.edu/shiny
Raw
#3d_regression.txt
3D Regression Shiny App
Base R code created by Irvin Alcaraz
Shiny app files created by Irvin Alcaraz
Cal Poly Statistics Dept Shiny Series
http://statistics.calpoly.edu/shiny
Raw
DESCRIPTION
Title: 3D Regression
Author: Irvin Alcaraz
AuthorUrl: https://www.linkedin.com/in/irvinalcaraz
License: MIT
DisplayMode: Normal
Tags: 3D Regression
Type: Shiny
Raw
LICENSE
The MIT License (MIT)
Copyright (c) 2015 Irvin Alcaraz
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
Raw
server.R
options(rgl.useNULL=TRUE)
# if (!require("devtools")){install.packages("devtools")}
# if (!require("shiny")){install.packages("shiny")}
# if (!require("rgl")){install.packages("rgl")}
# if (!require("shinyRGL")){install.packages("shinyRGL")}
# if (!require("reshape2")){install.packages("reshape2")}
# if (!require("RColorBrewer")){install.packages("RColorBrewer")}
if (!require("devtools")){
install.packages("devtools")
library("devtools")
}
if (!require("shiny")){
install.packages("shiny")
library("shiny")
}
if (!require("rgl")){
install.packages("rgl")
library("rgl")
}
if (!require("shinyRGL")){
install.packages("shinyRGL")
library("shinyRGL")
}
if (!require("reshape2")){
install.packages("reshape2")
library("reshape2")
}
if (!require("RColorBrewer")){
install.packages("RColorBrewer")
library("RColorBrewer")
}
############# CODE FOR THE IRIS DATA ################################
data(iris)
dfiris <- iris
dfiris $ Petal.Area = dfiris$Petal.Width * dfiris$Petal.Length
colorsirisCat = array(dim =length(dfiris$Species))
colorsirisCat[which(dfiris$Species == "setosa")] = "red"
colorsirisCat[which(dfiris$Species == "versicolor")] = "blue"
colorsirisCat[which(dfiris$Species == "virginica")] = "darkgreen"
Sepal.Length <- seq(min(dfiris$Sepal.Length),max(dfiris$Sepal.Length),len=30)
Sepal.Width <- seq(min(dfiris$Sepal.Width),max(dfiris$Sepal.Width),len=30)
##### IRIS SIMPLE MULTIPLE REGRESSION #####
irisfit <- lm(Petal.Area~Sepal.Length+Sepal.Width,dfiris)
plot.dfiris <- expand.grid(Sepal.Length = Sepal.Length,Sepal.Width = Sepal.Width)
plot.dfiris$Petal.Area.Pred <- predict(irisfit,newdata=plot.dfiris)
irisheight <- dcast(plot.dfiris,Sepal.Length~Sepal.Width,value.var="Petal.Area.Pred")[-1]
############# IRIS INTERACTION DATA ################################
fitIrisInt <- lm(Petal.Area~Sepal.Length*Sepal.Width,dfiris)
plot.dfIrisInt <- expand.grid(Sepal.Length = Sepal.Length,Sepal.Width = Sepal.Width)
plot.dfIrisInt$Petal.Area.Pred <- predict(fitIrisInt,newdata=plot.dfIrisInt)
heightIrisInt <- dcast(plot.dfIrisInt,Sepal.Length~Sepal.Width,value.var="Petal.Area.Pred")[-1]
############# IRIS CATEGORICAL DATA ################################
fitIrisCat <- lm(Petal.Area ~ Sepal.Width + Sepal.Length + Species, data=dfiris)
plot.dfIrisCat1 <- expand.grid(Sepal.Length = Sepal.Length,Sepal.Width = Sepal.Width,Species = "setosa")
plot.dfIrisCat1$Petal.Area.Pred <- predict(fitIrisCat,newdata=plot.dfIrisCat1)
heightIrisCat1 <- dcast(plot.dfIrisCat1,Sepal.Length~Sepal.Width,value.var="Petal.Area.Pred")[-1]
plot.dfIrisCat2 <- expand.grid(Sepal.Length = Sepal.Length,Sepal.Width = Sepal.Width,Species = "versicolor")
plot.dfIrisCat2$Petal.Area.Pred <- predict(fitIrisCat,newdata=plot.dfIrisCat2)
heightIrisCat2 <- dcast(plot.dfIrisCat2,Sepal.Length~Sepal.Width,value.var="Petal.Area.Pred")[-1]
plot.dfIrisCat3 <- expand.grid(Sepal.Length = Sepal.Length,Sepal.Width = Sepal.Width,Species = "virginica")
plot.dfIrisCat3$Petal.Area.Pred <- predict(fitIrisCat,newdata=plot.dfIrisCat3)
heightIrisCat3 <- dcast(plot.dfIrisCat3,Sepal.Length~Sepal.Width,value.var="Petal.Area.Pred")[-1]
############# IRIS CATEGORICAL INTERACTION DATA ################################
fitIrisCatInt <- lm(Petal.Area ~ Sepal.Width * Species + Sepal.Length * Species, data=dfiris)
# fitIrisCatInt <- lm(Petal.Area ~ Sepal.Width * Sepal.Length * Species, data=dfiris)
plot.dfIrisCatInt1 <- expand.grid(Sepal.Length = Sepal.Length,Sepal.Width = Sepal.Width,Species = "setosa")
plot.dfIrisCatInt1$Petal.Area.Pred <- predict(fitIrisCatInt,newdata=plot.dfIrisCatInt1)
heightIrisCatInt1 <- dcast(plot.dfIrisCatInt1,Sepal.Length~Sepal.Width,value.var="Petal.Area.Pred")[-1]
plot.dfIrisCatInt2 <- expand.grid(Sepal.Length = Sepal.Length,Sepal.Width = Sepal.Width,Species = "versicolor")
plot.dfIrisCatInt2$Petal.Area.Pred <- predict(fitIrisCatInt,newdata=plot.dfIrisCatInt2)
heightIrisCatInt2 <- dcast(plot.dfIrisCatInt2,Sepal.Length~Sepal.Width,value.var="Petal.Area.Pred")[-1]
plot.dfIrisCatInt3 <- expand.grid(Sepal.Length = Sepal.Length,Sepal.Width = Sepal.Width,Species = "virginica")
plot.dfIrisCatInt3$Petal.Area.Pred <- predict(fitIrisCatInt,newdata=plot.dfIrisCatInt3)
heightIrisCatInt3 <- dcast(plot.dfIrisCatInt3,Sepal.Length~Sepal.Width,value.var="Petal.Area.Pred")[-1]
########## CODE FOR CARS DATA ############
data(mtcars)
dfcars<- data.frame(mpg = mtcars$mpg,hp = mtcars$hp, wt = mtcars$wt, am = factor(mtcars$am))
levels(dfcars$am) = c("automatic","manual")
colorcarsCat <- array(dim = length(dfcars$am))
colorcarsCat[which(dfcars$am == "manual")] = "red"
colorcarsCat[which(dfcars$am == "automatic")] = "green"
hp <- seq(min(dfcars$hp),max(dfcars$hp),len=30)
wt <- seq(min(dfcars$wt),max(dfcars$wt),len=30)
### CARS SIMPLE MULTIPLE REGRESSION###
carsfit <- lm(mpg~hp+wt,dfcars)
plot.dfcars <- expand.grid(hp = hp,wt = wt)
plot.dfcars$mpgcars.pred <- predict(carsfit,newdata=plot.dfcars)
carsheight <- dcast(plot.dfcars,hp~wt,value.var="mpgcars.pred")[-1]
#### CARS INTERACTION DATA ####
fitcarsInt <- lm(mpg~hp*wt,dfcars)
plot.dfcarsInt <- expand.grid(hp = hp, wt = wt)
plot.dfcarsInt$mpgcars.pred <- predict(fitcarsInt,newdata=plot.dfcarsInt)
heightcarsInt <- dcast(plot.dfcarsInt,hp~wt,value.var="mpgcars.pred")[-1]
##### CARS CATEGORICAL DATA #####
fitcarsCat <- lm(mpg~hp+wt+am,dfcars)
plot.dfcarsCat1 <- expand.grid(hp = hp, wt = wt, am = "manual")
plot.dfcarsCat1$mpgcars.pred <- predict(fitcarsCat,newdata=plot.dfcarsCat1)
heightcarsCat1 <- dcast(plot.dfcarsCat1,hp~wt,value.var="mpgcars.pred")[-1]
plot.dfcarsCat2 <- expand.grid(hp = hp, wt = wt, am = "automatic")
plot.dfcarsCat2$mpgcars.pred <- predict(fitcarsCat,newdata=plot.dfcarsCat2)
heightcarsCat2 <- dcast(plot.dfcarsCat2,hp~wt,value.var="mpgcars.pred")[-1]
##### CARS CATEGORICAL DATA #####
fitcarsCatInt <- lm(mpg~hp*am + wt*am,dfcars)
# fitcarsCatInt <- lm(mpg~hp*wt*am,dfcars)
plot.dfcarsCatInt1 <- expand.grid(hp = hp, wt = wt, am = "manual")
plot.dfcarsCatInt1$mpgcars.pred <- predict(fitcarsCatInt,newdata=plot.dfcarsCatInt1)
heightcarsCatInt1 <- dcast(plot.dfcarsCatInt1,hp~wt,value.var="mpgcars.pred")[-1]
plot.dfcarsCatInt2 <- expand.grid(hp = hp, wt = wt, am = "automatic")
plot.dfcarsCatInt2$mpgcars.pred <- predict(fitcarsCatInt,newdata=plot.dfcarsCatInt2)
heightcarsCatInt2 <- dcast(plot.dfcarsCatInt2,hp~wt,value.var="mpgcars.pred")[-1]
########## CODE FOR STATE DATA #################
states <- as.data.frame(state.x77)
names(states)[4] = "LifeExp"
names(states)[6] = "HSGrad"
states$Region = c("South","West","West","South","West","West","Northeast",
"South","South","South","West","West","Midwest","Midwest",
"Midwest","Midwest","South","South","Northeast","South",
"Northeast","Midwest","Midwest","South","Midwest","West",
"Midwest","West","Northeast","Northeast","West","Northeast",
"South","Midwest","Midwest","South","West","Northeast",
"Northeast","South","Midwest","South","South","West",
"Northeast","South","West","South","Midwest","West")
states$Region = factor(states$Region)
states = states[c(4,5,6,9)]
colorstateCat = array(dim = length(states$Region))
colorstateCat[which(states$Region == "Midwest")] = "blue"
colorstateCat[which(states$Region == "Northeast")] = "red"
colorstateCat[which(states$Region == "South")] = "green"
colorstateCat[which(states$Region == "West")] = "black"
Murder <- seq(min(states$Murder),max(states$Murder),len=30)
HSGrad <- seq(min(states$HSGrad),max(states$HSGrad),len=30)
##### STATES SIMPLE MULTIPLE REGRESSION #######
fitstate <- lm(LifeExp ~ Murder + HSGrad, data = states)
plot.dfstate <- expand.grid(Murder = Murder,HSGrad = HSGrad)
plot.dfstate$LifeExpState.pred <- predict(fitstate,newdata=plot.dfstate)
stateheight <- dcast(plot.dfstate,Murder~HSGrad,value.var="LifeExpState.pred")[-1]
##### STATES INTERACTION DATA #########
fitstateInt <- lm(LifeExp ~ Murder*HSGrad, data = states)
plot.dfstateInt <- expand.grid(Murder = Murder, HSGrad = HSGrad)
plot.dfstateInt$LifeExpState.pred <- predict(fitstateInt,newdata=plot.dfstateInt)
stateheightInt <- dcast(plot.dfstateInt,Murder~HSGrad,value.var="LifeExpState.pred")[-1]
##### STATES CATEGORICAL DATA #####
fitstateCat <- lm(LifeExp ~ Murder + HSGrad + Region, data = states)
plot.dfstateCat1 <- expand.grid(Murder = Murder, HSGrad = HSGrad, Region = "Northeast")
plot.dfstateCat1$LifeExpState.pred <- predict(fitstateCat,newdata=plot.dfstateCat1)
stateheightCat1 <- dcast(plot.dfstateCat1,Murder~HSGrad,value.var="LifeExpState.pred")[-1]
plot.dfstateCat2 <- expand.grid(Murder = Murder, HSGrad = HSGrad, Region = "South")
plot.dfstateCat2$LifeExpState.pred <- predict(fitstateCat,newdata=plot.dfstateCat2)
stateheightCat2 <- dcast(plot.dfstateCat2,Murder~HSGrad,value.var="LifeExpState.pred")[-1]
plot.dfstateCat3 <- expand.grid(Murder = Murder, HSGrad = HSGrad, Region = "West")
plot.dfstateCat3$LifeExpState.pred <- predict(fitstateCat,newdata=plot.dfstateCat3)
stateheightCat3 <- dcast(plot.dfstateCat3,Murder~HSGrad,value.var="LifeExpState.pred")[-1]
##### STATES CATEGORICAL DATA #####
# fitstateCatInt <- lm(LifeExp ~ Murder * HSGrad * Region, data = states)
fitstateCatInt <- lm(LifeExp ~ Murder * Region + HSGrad * Region, data = states)
plot.dfstateCatInt1 <- expand.grid(Murder = Murder, HSGrad = HSGrad, Region = "Northeast")
plot.dfstateCatInt1$LifeExpState.pred <- predict(fitstateCatInt,newdata=plot.dfstateCatInt1)
stateheightCatInt1 <- dcast(plot.dfstateCatInt1,Murder~HSGrad,value.var="LifeExpState.pred")[-1]
plot.dfstateCatInt2 <- expand.grid(Murder = Murder, HSGrad = HSGrad, Region = "South")
plot.dfstateCatInt2$LifeExpState.pred <- predict(fitstateCatInt,newdata=plot.dfstateCatInt2)
stateheightCatInt2 <- dcast(plot.dfstateCatInt2,Murder~HSGrad,value.var="LifeExpState.pred")[-1]
plot.dfstateCatInt3 <- expand.grid(Murder = Murder, HSGrad = HSGrad, Region = "West")
plot.dfstateCatInt3$LifeExpState.pred <- predict(fitstateCatInt,newdata=plot.dfstateCatInt3)
stateheightCatInt3 <- dcast(plot.dfstateCatInt3,Murder~HSGrad,value.var="LifeExpState.pred")[-1]
####BEGINNING OF SHINY CODE ###########
shinyServer(function(input, output){
output$troisPlot <- renderWebGL({
if (input$dataset == "iris")
{
if (input$expTypes1 == 5){
par3d(scale=c(1,1,0.2),cex=.6)
points3d(dfiris$Sepal.Length,dfiris$Sepal.Width,dfiris$Petal.Area)
axes3d()
title3d(xlab="Sepal Length",ylab="Sepal Width",zlab="Petal Area")
}else if (input$expTypes1 == 1){
par3d(scale=c(1,1,0.2),cex=.6)
points3d(dfiris$Sepal.Length,dfiris$Sepal.Width,dfiris$Petal.Area)
surface3d(Sepal.Length,Sepal.Width,as.matrix(irisheight),col="blue",alpha=.5)
axes3d()
title3d(xlab="Sepal Length",ylab="Sepal Width",zlab="Petal Area")
}else if (input$expTypes1 == 2){
par3d(scale=c(1,1,0.2),cex=.6)
points3d(dfiris$Sepal.Length,dfiris$Sepal.Width,dfiris$Petal.Area)
surface3d(Sepal.Length,Sepal.Width,as.matrix(heightIrisInt),col="blue",alpha=.5)
axes3d()
title3d(xlab="Sepal Length",ylab="Sepal Width",zlab="Sepal Area")
}else if (input$expTypes1 == 4){
par3d(scale=c(1,1,0.2),cex=.6)
points3d(dfiris$Sepal.Length,dfiris$Sepal.Width,dfiris$Petal.Area,col = colorsirisCat)
surface3d(Sepal.Length,Sepal.Width,as.matrix(heightIrisCat1),col="blue",alpha=.5)
surface3d(Sepal.Length,Sepal.Width,as.matrix(heightIrisCat2),col="blue",alpha=.5)
surface3d(Sepal.Length,Sepal.Width,as.matrix(heightIrisCat3),col="blue",alpha=.5)
axes3d()
title3d(xlab="Sepal Length",ylab="Sepal Width",zlab="Petal Area")
}else if (input$expTypes1 == 6){
par3d(scale=c(1,1,0.2),cex=.6)
points3d(dfiris$Sepal.Length,dfiris$Sepal.Width,dfiris$Petal.Area,col = colorsirisCat)
surface3d(Sepal.Length,Sepal.Width,as.matrix(heightIrisCatInt1),col="blue",alpha=.5)
surface3d(Sepal.Length,Sepal.Width,as.matrix(heightIrisCatInt2),col="blue",alpha=.5)
surface3d(Sepal.Length,Sepal.Width,as.matrix(heightIrisCatInt3),col="blue",alpha=.5)
axes3d()
title3d(xlab="Sepal Length",ylab="Sepal Width",zlab="Petal Area")
}
}else if (input$dataset == "mtcars"){
if (input$expTypes2 == 5){
par3d(scale=c(0.02,1,0.2),cex=.5)
points3d(dfcars$hp,dfcars$wt,dfcars$mpg)
axes3d()
title3d(xlab="Gross Horsepower",ylab="Weight (lb/1000)",zlab="Miles / (US) Gallon")
}else if (input$expTypes2 == 1){
par3d(scale=c(0.02,1,0.2),cex=.5)
points3d(dfcars$hp,dfcars$wt,dfcars$mpg)
surface3d(hp,wt,as.matrix(carsheight),col="blue",alpha=.5)
axes3d()
title3d(xlab="Gross Horsepower",ylab="Weight (lb/1000)",zlab="Miles / (US) Gallon")
}else if (input$expTypes2 == 2){
par3d(scale=c(0.02,1,0.2),cex=.6)
points3d(dfcars$hp,dfcars$wt,dfcars$mpg)
surface3d(hp,wt,as.matrix(heightcarsInt),col="blue",alpha=.5)
axes3d()
title3d(xlab="Gross Horsepower",ylab="Weight (lb/1000)",zlab="Miles / (US) Gallon")
}else if (input$expTypes2 == 4){
par3d(scale=c(0.02,1,0.2),cex=.6)
points3d(dfcars$hp,dfcars$wt,dfcars$mpg,col=colorcarsCat)
surface3d(hp,wt,as.matrix(heightcarsCat1),col="blue",alpha=.5)
surface3d(hp,wt,as.matrix(heightcarsCat2),col="blue",alpha=.5)
axes3d()
title3d(xlab="Gross Horsepower",ylab="Weight (lb/1000)",zlab="Miles / (US) Gallon")
}else if (input$expTypes2 == 6){
par3d(scale=c(0.02,1,0.2),cex=.6)
points3d(dfcars$hp,dfcars$wt,dfcars$mpg,col=colorcarsCat)
surface3d(hp,wt,as.matrix(heightcarsCatInt1),col="blue",alpha=.5)
surface3d(hp,wt,as.matrix(heightcarsCatInt2),col="blue",alpha=.5)
axes3d()
title3d(xlab="Gross Horsepower",ylab="Weight (lb/1000)",zlab="Miles / (US) Gallon")
}
} else if (input$dataset == "state.x77"){
if (input$expTypes3 == 5){
par3d(scale=c(1,.5,2),cex=.5)
points3d(states$Murder,states$HSGrad,states$LifeExp)
axes3d()
title3d(xlab="Murders per 100,000",ylab="Precent High-School Graduates",zlab="Life Expectancy")
}else if (input$expTypes3 == 1){
par3d(scale=c(1,.5,2),cex=.5)
points3d(states$Murder,states$HSGrad,states$LifeExp)
surface3d(Murder,HSGrad,as.matrix(stateheight),col="blue",alpha=.5)
axes3d()
title3d(xlab="Murders per 100,000",ylab="Precent High-School Graduates",zlab="Life Expectancy")
}else if (input$expTypes3 == 2){
par3d(scale=c(1,.5,2),cex=.5)
points3d(states$Murder,states$HSGrad,states$LifeExp)
surface3d(Murder,HSGrad,as.matrix(stateheightInt),col="blue",alpha=.5)
axes3d()
title3d(xlab="Murders per 100,000",ylab="Precent High-School Graduates",zlab="Life Expectancy")
}else if (input$expTypes3 == 4){
par3d(scale=c(1,.5,2),cex=.5)
points3d(states$Murder,states$HSGrad,states$LifeExp,col = colorstateCat)
surface3d(Murder,HSGrad,as.matrix(stateheightCat1),col="blue",alpha=.5)
surface3d(Murder,HSGrad,as.matrix(stateheightCat2),col="blue",alpha=.5)
surface3d(Murder,HSGrad,as.matrix(stateheightCat3),col="blue",alpha=.5)
axes3d()
title3d(xlab="Murders per 100,000",ylab="Precent High-School Graduates",zlab="Life Expectancy")
}else if (input$expTypes3 == 6){
par3d(scale=c(1,.5,2),cex=.5)
points3d(states$Murder,states$HSGrad,states$LifeExp,col = colorstateCat)
surface3d(Murder,HSGrad,as.matrix(stateheightCatInt1),col="blue",alpha=.5)
surface3d(Murder,HSGrad,as.matrix(stateheightCatInt2),col="blue",alpha=.5)
surface3d(Murder,HSGrad,as.matrix(stateheightCatInt3),col="blue",alpha=.5)
axes3d()
title3d(xlab="Murders per 100,000",ylab="Precent High-School Graduates",zlab="Life Expectancy")
}
}
})
output$responseVar <- renderPrint({
if (input$dataset == "iris"){
paste("Petal Area")
}else if (input$dataset == "mtcars"){
paste("Miles Per Gallon")
}else if (input$dataset == "state.x77"){
paste("Life Expectancy")
}
})
output$modelEQ <- renderPrint({
if (input$dataset == "iris"){
if (input$expTypes1 == 1){
summary(irisfit)$coefficients
}else if (input$expTypes1 == 2){
summary(fitIrisInt)$coefficients
}else if (input$expTypes1 == 3){
summary(fitIrisCat)$coefficients
}else if (input$expTypes1 == 5){
paste("No Model")
}else if (input$expTypes1 == 6){
summary(fitIrisCatInt)$coefficients
}else{
summary(fitIrisCat)$coefficients
}
}else if (input$dataset == "mtcars"){
if (input$expTypes2 == 1){
summary(carsfit)$coefficients
}else if (input$expTypes2 == 2){
summary(fitcarsInt)$coefficients
}else if (input$expTypes2 == 3){
summary(fitcarsCat)$coefficients
}else if (input$expTypes2 == 5){
paste("No Model")
}else if (input$expTypes2 == 6){
summary(fitcarsCatInt)$coefficients
}else{
summary(fitcarsCat)$coefficients
}
}else if (input$dataset == "state.x77"){
if (input$expTypes3 == 1){
summary(fitstate)$coefficients
}else if (input$expTypes3 == 2){
summary(fitstateInt)$coefficients
}else if (input$expTypes3 == 3){
summary(fitstateCat)$coefficients
}else if (input$expTypes3 == 5){
paste("No Model")
}else if (input$expTypes3 == 6){
summary(fitstateCatInt)$coefficients
}else{
summary(fitstateCat)$coefficients
}
}
})
output$modelRsq <- renderText({
if (input$dataset == "iris"){
if (input$expTypes1 == 1){
summary(irisfit)$adj.r.squared
}else if (input$expTypes1 == 2){
summary(fitIrisInt)$adj.r.squared
}else if (input$expTypes1 == 3){
summary(fitIrisCat)$adj.r.squared
}else if (input$expTypes1 == 5){
paste("No Model")
}else if (input$expTypes1 == 6){
summary(fitIrisCatInt)$adj.r.squared
}else{
summary(fitIrisCat)$adj.r.squared
}
}else if (input$dataset == "mtcars"){
if (input$expTypes2 == 1){
summary(carsfit)$adj.r.squared
}else if (input$expTypes2 == 2){
summary(fitcarsInt)$adj.r.squared
}else if (input$expTypes2 == 3){
summary(fitcarsCat)$adj.r.squared
}else if (input$expTypes2 == 5){
paste("No Model")
}else if (input$expTypes2 == 6){
summary(fitcarsCatInt)$adj.r.squared
}else{
summary(fitcarsCat)$adj.r.squared
}
}else if (input$dataset == "state.x77"){
if (input$expTypes3 == 1){
summary(fitstate)$adj.r.squared
}else if (input$expTypes3 == 2){
summary(fitstateInt)$adj.r.squared
}else if (input$expTypes3 == 3){
summary(fitstateCat)$adj.r.squared
}else if (input$expTypes3 == 5){
paste("No Model")
}else if (input$expTypes3 == 6){
summary(fitstateCatInt)$adj.r.squared
}else{
summary(fitstateCat)$adj.r.squared
}
}
})
#############2D Tab#########
output$cat2d <- renderPlot({
if (input$dataset1 == "iris"){
if (input$interact2D == "yes"){
pAonsL <- lm(Petal.Area~Sepal.Length * Species,dfiris)
setosa = coef(pAonsL)[c(1,2)]
versicolor = c(coef(pAonsL)[1] + coef(pAonsL)[3], coef(pAonsL)[2] + coef(pAonsL)[5])
virginica = c(coef(pAonsL)[1] + coef(pAonsL)[4], coef(pAonsL)[2] + coef(pAonsL)[6])
plot(dfiris$Sepal.Length,dfiris$Petal.Area,xlab="Sepal Length",ylab="Petal Area",
main="Petal Area on Length by Species",col=colorsirisCat,pch = 19)
abline(setosa,col="red")
abline(versicolor,col="blue")
abline(virginica,col="darkgreen")
}else if (input$interact2D == "no"){
pAonsL <- lm(Petal.Area~Sepal.Length + Species,dfiris)
setosa = coef(pAonsL)[c(1,2)]
versicolor = c(coef(pAonsL)[1] + coef(pAonsL)[3], coef(pAonsL)[2])
virginica = c(coef(pAonsL)[1] + coef(pAonsL)[4], coef(pAonsL)[2])
plot(dfiris$Sepal.Length,dfiris$Petal.Area,xlab="Sepal Length",ylab="Petal Area",
main="Petal Area on Length by Species",col=colorsirisCat,pch = 19)
abline(setosa,col="red")
abline(versicolor,col="blue")
abline(virginica,col="darkgreen")
}else{
pAonsL <- lm(Petal.Area~Sepal.Length,dfiris)
plot(dfiris$Sepal.Length,dfiris$Petal.Area,xlab="Sepal Length",ylab="Petal Area",
main="Petal Area on Length",col=colorsirisCat,pch = 19)
abline(pAonsL)
}
# plot(dfiris$Sepal.Length,dfiris$Petal.Area,xlab="Sepal Length",ylab="Petal Area",
# main="Petal Area on Length by Species",col=colorsirisCat,pch = 19)
#
# abline(setosa,col="red")
# abline(versicolor,col="blue")
# abline(virginica,col="darkgreen")
legend("topleft",legend = levels(dfiris$Species),col=c("red","blue","darkgreen"),pch = 19)
}else if (input$dataset1 == "mtcars"){
if (input$interact2D == "yes"){
mpgonwt <- lm(mpg~wt*am,dfcars)
automatic = coef(mpgonwt)[c(1,2)]
manual = c(coef(mpgonwt)[1] + coef(mpgonwt)[3], coef(mpgonwt)[2]+coef(mpgonwt)[4])
plot(dfcars$wt,dfcars$mpg,xlab="Weight (lb/1000)",ylab="Miles/(US) gallon",
main="Automobile MPG on Weight by Transmission",col=colorcarsCat,pch = 19)
abline(automatic,col="green")
abline(manual,col="red")
}else if (input$interact2D == "no"){
mpgonwt <- lm(mpg~wt+am,dfcars)
automatic = coef(mpgonwt)[c(1,2)]
manual = c(coef(mpgonwt)[1] + coef(mpgonwt)[3], coef(mpgonwt)[2])
plot(dfcars$wt,dfcars$mpg,xlab="Weight (lb/1000)",ylab="Miles/(US) gallon",
main="Automobile MPG on Weight by Transmission",col=colorcarsCat,pch = 19)
abline(automatic,col="green")
abline(manual,col="red")
} else {
mpgonwt <- lm(mpg~wt,dfcars)
plot(dfcars$wt,dfcars$mpg,xlab="Weight (lb/1000)",ylab="Miles/(US) gallon",
main="Automobile MPG on Weight",col=colorcarsCat,pch = 19)
abline(mpgonwt)
}
# plot(dfcars$wt,dfcars$mpg,xlab="Weight (lb/1000)",ylab="Miles/(US) gallon",
# main="Automobile MPG on Weight by Transmission",col=colorcarsCat,pch = 19)
#
# abline(automatic,col="green")
# abline(manual,col="red")
legend("topright",legend = levels(dfcars$am),col=c("green","red"),pch = 19,cex=.8)
}else if (input$dataset1 == "state.x77"){
if (input$interact2D == "yes")
{
lEonHg <- lm(LifeExp~HSGrad*Region,states)
midwest = coef(lEonHg)[c(1,2)]
northeast = c(coef(lEonHg)[1] + coef(lEonHg)[3],coef(lEonHg)[2] + coef(lEonHg)[6])
south = c(coef(lEonHg)[1] + coef(lEonHg)[4],coef(lEonHg)[2] + coef(lEonHg)[7])
west = c(coef(lEonHg)[1] + coef(lEonHg)[5],coef(lEonHg)[2] + coef(lEonHg)[8])
plot(states$HSGrad,states$LifeExp,xlab="High School Graduation Rate",ylab="Life Expectancy",
main="High School Graduation Rate on Life Expectancy by Region",col=colorstateCat,pch = 19)
abline(midwest,col="blue")
abline(northeast,col="red")
abline(south,col="green")
abline(west,col="black")
}else if (input$interact2D == "no"){
lEonHg <- lm(LifeExp~HSGrad+Region,states)
midwest = coef(lEonHg)[c(1,2)]
northeast = c(coef(lEonHg)[1] + coef(lEonHg)[3],coef(lEonHg)[2])
south = c(coef(lEonHg)[1] + coef(lEonHg)[4],coef(lEonHg)[2])
west = c(coef(lEonHg)[1] + coef(lEonHg)[5],coef(lEonHg)[2])
plot(states$HSGrad,states$LifeExp,xlab="High School Graduation Rate",ylab="Life Expectancy",
main="High School Graduation Rate on Life Expectancy by Region",col=colorstateCat,pch = 19)
abline(midwest,col="blue")
abline(northeast,col="red")
abline(south,col="green")
abline(west,col="black")
}else{
lEonHg <- lm(LifeExp~HSGrad,states)
plot(states$HSGrad,states$LifeExp,xlab="High School Graduation Rate",ylab="Life Expectancy",
main="High School Graduation Rate on Life Expectancy",col=colorstateCat,pch = 19)
abline(lEonHg)
}
# plot(states$HSGrad,states$LifeExp,xlab="High School Graduation Rate",ylab="Life Expectancy",
# main="High School Graduation Rate on Life Expectancy by Region",col=colorstateCat,pch = 19)
#
# abline(midwest,col="blue")
# abline(northeast,col="red")
# abline(south,col="green")
# abline(west,col="black")
legend("topleft",legend = levels(states$Region),col=c("blue","red","green","black"),pch = 19,cex=.8)
}
})
output$catResp <- renderPrint({
if (input$dataset1 == "iris"){
paste("Petal Area")
}else if (input$dataset1 == "mtcars"){
paste("Miles Per Gallon")
}else if (input$dataset1 == "state.x77"){
paste("Life Expectancy")
}
})
output$catModel <- renderPrint({
if (input$interact2D == "no"){
if (input$dataset1 == "iris"){
pAonsL <- lm(Petal.Area~Sepal.Length+Species,dfiris)
summary(pAonsL)$coefficients
}else if (input$dataset1 == "mtcars"){
mpgonwt <- lm(mpg~wt+am,dfcars)
summary(mpgonwt)$coefficients
}else if (input$dataset1 == "state.x77"){
lEonHg <- lm(LifeExp~HSGrad+Region,states)
summary(lEonHg)$coefficients
}
}else if (input$interact2D == "yes"){
if (input$dataset1 == "iris"){
pAonsL <- lm(Petal.Area~Sepal.Length*Species,dfiris)
summary(pAonsL)$coefficients
}else if (input$dataset1 == "mtcars"){
mpgonwt <- lm(mpg~wt*am,dfcars)
summary(mpgonwt)$coefficients
}else if (input$dataset1 == "state.x77"){
lEonHg <- lm(LifeExp~HSGrad*Region,states)
summary(lEonHg)$coefficients
}
}else{
if (input$dataset1 == "iris"){
pAonsL <- lm(Petal.Area~Sepal.Length,dfiris)
summary(pAonsL)$coefficients
}else if (input$dataset1 == "mtcars"){
mpgonwt <- lm(mpg~wt,dfcars)
summary(mpgonwt)$coefficients
}else if (input$dataset1 == "state.x77"){
lEonHg <- lm(LifeExp~HSGrad,states)
summary(lEonHg)$coefficients
}
}
})
output$catRsq <- renderText({
if (input$interact2D == "no"){
if (input$dataset1 == "iris"){
pAonsL <- lm(Petal.Area~Sepal.Length+Species,dfiris)
summary(pAonsL)$adj.r.sq
}else if (input$dataset1 == "mtcars"){
mpgonwt <- lm(mpg~wt+am,dfcars)
summary(mpgonwt)$adj.r.sq
}else if (input$dataset1 == "state.x77"){
lEonHg <- lm(LifeExp~HSGrad+Region,states)
summary(lEonHg)$adj.r.sq
}
}else if (input$interact2D == "yes"){
if (input$dataset1 == "iris"){
pAonsL <- lm(Petal.Area~Sepal.Length*Species,dfiris)
summary(pAonsL)$adj.r.sq
}else if (input$dataset1 == "mtcars"){
mpgonwt <- lm(mpg~wt*am,dfcars)
summary(mpgonwt)$adj.r.sq
}else if (input$dataset1 == "state.x77"){
lEonHg <- lm(LifeExp~HSGrad*Region,states)
summary(lEonHg)$adj.r.sq
}
}else{
if (input$dataset1 == "iris"){
pAonsL <- lm(Petal.Area~Sepal.Length,dfiris)
summary(pAonsL)$adj.r.sq
}else if (input$dataset1 == "mtcars"){
mpgonwt <- lm(mpg~wt,dfcars)
summary(mpgonwt)$adj.r.sq
}else if (input$dataset1 == "state.x77"){
lEonHg <- lm(LifeExp~HSGrad,states)
summary(lEonHg)$adj.r.sq
}
}
})
})
Raw
ui.R
# ------------------------------------------------
# App Title: 3D Model Viewer
# Author: Irvin Alcaraz
# ------------------------------------------------
options(rgl.useNULL=TRUE)
if (!require("devtools")){
install.packages("devtools")
library("devtools")
}
if (!require("shiny")){
install.packages("shiny")
library("shiny")
}
if (!require("rgl")){
install.packages("rgl")
library("rgl")
}
if (!require("shinyRGL")){
install.packages("shinyRGL")
library("shinyRGL")
}
if (!require("reshape2")){
install.packages("reshape2")
library("reshape2")
}
if (!require("RColorBrewer")){
install.packages("RColorBrewer")
library("RColorBrewer")
}
shinyUI(navbarPage("Multiple Regression Visualization",
tabPanel("3D Visualizer",
tags$head(tags$link(rel = "icon", type = "image/x-icon",
href = "https://webresource.its.calpoly.edu/cpwebtemplate/5.0.1/common/images_html/favicon.ico")),
p("When creating a model, it can be very helpful to visualize both the data and the model.
Often we wish to create a prediction model for a response variable on more than one predictors.
In the case of a single response and two predictors, we must use a third dimension to visualize the
the data and model."),
p("In this app, you will be able to visualize the data and explore the effectiveness of different models
for a numerical response variable. "),
sidebarLayout(
sidebarPanel(
tags$title("3D Visualizer"),
selectInput("dataset",label = "Select a dataset", choices = c("Iris"= "iris",
"Cars" = "mtcars",
"U.S." = "state.x77"
##,"Custom" = "upload"
)),
##To do the 2D this you need to uncomment the end and add the third option
conditionalPanel(condition = "input.dataset == 'iris'",
radioButtons("expTypes1", label = "Available Models: Sepal Area = ",
choices = list("Sepal Length + Sepal Width" = 1,
"Sepal Length * sepal Width" = 2,
"Sepal Length + Sepal Width + Species" = 4,
"Sepal Length * Species + Sepal Width * Species" = 6,
"None" = 5),
selected = 5)),
conditionalPanel(condition = "input.dataset == 'mtcars'",
radioButtons("expTypes2", label = "Available Models: MPG =",
choices = list("Horsepower + Weight" = 1,
"Horsepower * Weight" = 2,
"Horsepower + Weight + Transmission" = 4,
"Horsepower * Transmission + Weight * Transmission" = 6,
"None" = 5),
selected = 5)),
conditionalPanel(condition = "input.dataset == 'state.x77'",
radioButtons("expTypes3", label = "Available Models: Life Expectancy =",
choices = list("Murder Rate + HS Graduation Rate" = 1,
"Murder * HSGrad" = 2,
"Murder + HSGrad + Region" = 4,
"Murder * Region + HSGrad * Region" = 6,
"None" = 5),
selected = 5)),
####For file upload
# conditionalPanel(condition = "input.dataset === 'upload'",
# fileInput("file", "Browse for a file",
# accept=c("text/csv", "text/comma-separated-values,text/plain", ".csv")),
# strong("Please use numerical data formated as N,N,N"),
# # radioButtons("colTypes","C = Categorical, N = Numerical",
# # c("N,N,N"=1,"N,N,N,C"=2,"N,N,C,N"=3,"N,C,N,N"=4),1),
# strong("Customize file format:"),
# checkboxInput("header", "Header", TRUE),
# radioButtons("sep", "Separator:",
# c(Comma=",",Semicolon=";",Tab="\t"), ","),
# radioButtons("quote", "Quote",
# c(None="","Double Quote"='"',"Single Quote"="'"), ""),
# strong("Check box to include interaction"),
# checkboxInput("interaction","", FALSE)
# ),
div("Shiny app by",
a(href="https://www.linkedin.com/in/irvinalcaraz",target="_blank",
"Irvin Alcaraz"),align="right", style = "font-size: 8pt"),
div("Base R code by",
a(href="https://www.linkedin.com/in/irvinalcaraz",target="_blank",
"Irvin Alcaraz"),align="right", style = "font-size: 8pt"),
div("Shiny source files:",
a(href="https://gist.github.com/calpolystat/bd0400c7ce3aacfa4973",
target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
"Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt")
),
mainPanel(
tabsetPanel(
# conditionalPanel(condition = "(!is.na(input.expTypes1) && input.expTypes1 != 3) || input.expTypes2 != 3 || input.expTypes3 != 3",
tabPanel("Plot",webGLOutput("troisPlot",width="600px",height="600px")),
# ),
# conditionalPanel(condition = "(!is.na(input.expTypes1) && input.expTypes1 == 3) || input.expTypes2 == 3 || input.expTypes3 == 3",
# tabPanel("Plot (2)",plotOutput("cat2d"))),
tabPanel("Model Info",
withMathJax(),
helpText("The Response variable is:"),
verbatimTextOutput("responseVar"),
br(),
helpText("The current model is:"),
verbatimTextOutput("modelEQ"),
br(),
helpText("The corresponding \\(R^2-adjusted\\) is:"),
verbatimTextOutput("modelRsq")
)
# ,
# tabPanel("Model Info (2)",
# withMathJax(),
# helpText("The Response variable is:"),
# verbatimTextOutput("catResp"),
# br(),
# helpText("The current model is:"),
# verbatimTextOutput("catModel"),
# br(),
# helpText("The corresponding \\(R^2-adjusted\\) is:"),
# verbatimTextOutput("catRsq")
# )
)
# conditionalPanel(condition = "input.expTypes1 != 3 && !is.na(input.expTypes1) || input.expTypes2 != 3 || input.expTypes3 != 3",
# tabsetPanel(
# tabPanel("Plot",webGLOutput("troisPlot",width="600px",height="600px")),
# tabPanel("Model Info",
# withMathJax(),
# helpText("The Response variable is:"),
# verbatimTextOutput("responseVar"),
# br(),
# helpText("The current model is:"),
# verbatimTextOutput("modelEQ"),
# br(),
# helpText("The corresponding \\(R^2-adjusted\\) is:"),
# verbatimTextOutput("modelRsq")
# )
#
# )
# ),
# conditionalPanel(condition = "input.expTypes1 == 3 || input.expTypes2 == 3 || input.expTypes3 == 3",
# tabsetPanel(
# tabPanel("Plot",plotOutput("cat2d")),
# tabPanel("Model Info",
# withMathJax(),
# helpText("The Response variable is:"),
# verbatimTextOutput("catResp"),
# br(),
# helpText("The current model is:"),
# verbatimTextOutput("catModel"),
# br(),
# helpText("The corresponding \\(R^2-adjusted\\) is:"),
# verbatimTextOutput("catRsq")
# )
# )
#
# )
)
)
),
tabPanel("2D Help",
p("When visualizing a categorical explanatory variable, we can utilize 2D plots instead. This is useful
because it enables us to understand why the regression surfaces are seperate and gives us an expectation
for what the regression surfaces will look like. Furthermore, 2D plot are by far, much easier to interpret."),
sidebarLayout(
sidebarPanel(selectInput("dataset1",label = "Select a dataset", choices = c("Iris"= "iris",
"Cars" = "mtcars",
"U.S." = "state.x77")),
# radioButtons("interact2D",label = "",
# choices = c("No Interaction" = "no", "Interaction" = "yes")),
radioButtons("interact2D",label = "",
choices = c("Simple Regression" = "simple",
"Categorical Predictor" = "no",
"Interaction" = "yes")),
div("Shiny app by",
a(href="https://www.linkedin.com/in/irvinalcaraz",target="_blank",
"Irvin Alcaraz"),align="right", style = "font-size: 8pt"),
div("Base R code by",
a(href="https://www.linkedin.com/in/irvinalcaraz",target="_blank",
"Irvin Alcaraz"),align="right", style = "font-size: 8pt"),
div("Shiny source files:",
a(href="https://gist.github.com/calpolystat/bd0400c7ce3aacfa4973",
target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
"Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt")
),
mainPanel(
tabsetPanel(
tabPanel("Plot",plotOutput("cat2d")),
tabPanel("Model Info",
withMathJax(),
helpText("The Response variable is:"),
verbatimTextOutput("catResp"),
br(),
helpText("The current model is:"),
verbatimTextOutput("catModel"),
br(),
helpText("The corresponding \\(R^2-adjusted\\) is:"),
verbatimTextOutput("catRsq"))
)
)
)
)
))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment