Last active
November 9, 2021 10:26
-
-
Save leeper/404a481c26c68efddfc0 to your computer and use it in GitHub Desktop.
Shiny App for 3D Interaction plots
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library("shiny") | |
library("shinyjs") | |
ui <- shinyUI(pageWithSidebar( | |
titlePanel("", "3D Perspective Plot for Interaction Effects"), | |
sidebarPanel( | |
tabsetPanel( | |
tabPanel("Data", | |
sliderInput("b0", "Intercept:", min = -10, max = 10, value = 0, step = 0.5), | |
sliderInput("b1", "Beta 1 (x1):", min = -10, max = 10, value = 0, step = 0.5), | |
sliderInput("b2", "Beta 2 (x2):", min = -10, max = 10, value = 0, step = 0.5), | |
sliderInput("b3", "Beta 3 (x1*x2):", min = -10, max = 10, value = 0, step = 0.5), | |
sliderInput("nobs", "Number of Observations:", min = 10, max = 1000, value = 100, step = 10) | |
), | |
tabPanel("Model", | |
helpText("Select a model from those listed below"), | |
selectInput("modelformula", "Model Formula", | |
c("y ~ x1", "y ~ x2", "y ~ x1 * x2", "y ~ x1 + x1:x2", "y ~ x2 + x1:x2", "y ~ x1:x2"), | |
selected = "y ~ x1 * x2", multiple = FALSE, selectize = TRUE) | |
), | |
tabPanel("View", | |
sliderInput("theta", "View azimuthal direction (theta):", | |
min = 0, max = 360, value = 45, step = 15), | |
sliderInput("phi", "View colatitude (phi):", | |
min = 0, max = 360, value = 15, step = 15), | |
sliderInput("distance", "View distance (d):", | |
min = 0, max = 1, value = 1, step = 0.05) | |
), | |
tabPanel("Surface", | |
sliderInput("density", "Grid Density:", | |
min = 2, max = 50, value = 10, step = 1), | |
colourInput("color", "Surface color:", value = "gray", allowTransparent = FALSE), | |
colourInput("border", "Border color:", value = "black", allowTransparent = FALSE), | |
sliderInput("shade", "Shade:", min = 0, max = 1, value = 0.75, step = 0.05), | |
sliderInput("ltheta", "Illumination azimuthal direction l(theta):", | |
min = 0, max = 360, value = 20, step = 10), | |
sliderInput("lphi", "Illumination colatitude (lphi):", | |
min = 0, max = 360, value = 20, step = 10) | |
), | |
tabPanel("Axes", | |
checkboxInput("box", "Bounding box?", value = TRUE), | |
checkboxInput("axes", "Axis Ticks?", value = TRUE), | |
selectInput("ticktype", "Tick type", c("simple", "detailed"), | |
selected = "simple", multiple = FALSE, selectize = TRUE), | |
sliderInput("nticks", "Number of ticks:", min = 2, max = 50, value = 6, step = 2), | |
textInput("xlab", "x1 axis label:", value = "x1"), | |
textInput("ylab", "x2 axis label:", value = "x2"), | |
textInput("zlab", "Vertical axis label:", value = "y") | |
), | |
tabPanel("Marginal Effects", | |
selectInput("me_x2", "Marginal Effect of X1 at X2 = ", c(NA, as.character(seq(0, 1, by = 0.1))), | |
multiple = FALSE, selectize = TRUE), | |
colourInput("me_x2_color", "Line Color:", value = "red", allowTransparent = FALSE), | |
selectInput("me_x1", "Marginal Effect of X2 at X1 = ", c(NA, as.character(seq(0, 1, by = 0.1))), | |
multiple = FALSE, selectize = TRUE), | |
colourInput("me_x1_color", "Line Color:", value = "red", allowTransparent = FALSE) | |
) | |
)#, | |
#downloadButton("downloadImage", label = "Download Plot (.png)") | |
), | |
mainPanel( | |
headerPanel("Plot of Interaction Effects"), | |
tabsetPanel( | |
tabPanel("Perspective Plot", plotOutput("plot1")) | |
) | |
) | |
)) | |
server <- function(input, output) { | |
output$plot1 <- renderPlot({ | |
set.seed(1) | |
x1 <- runif(input$nobs, 0, 1) | |
x2 <- runif(input$nobs, 0, 1) | |
y <- input$b0 + | |
(input$b1 * x1) + | |
(input$b2 * x2) + | |
(input$b3 * x1 * x2) + rnorm(input$nobs) | |
m <- lm(as.formula(input$modelformula)) | |
nx <- seq(0, 1, length.out = input$density) | |
z <- outer(nx, nx, FUN = function(a, b) predict(m, data.frame(x1 = a, x2 = b))) | |
par(mar = rep(1, 4)) | |
p <- persp(nx, nx, z, | |
xlab = input$xlab, ylab = input$ylab, zlab = input$zlab, | |
r = input$distance, | |
theta = input$theta, phi = input$phi, shade = input$shade, | |
col = input$color, border = input$border, | |
ltheta = input$ltheta, lphi = input$lphi, | |
box = input$box, axes = input$axes, | |
ticktype = input$ticktype, nticks = input$nticks) | |
if (!is.na(input$me_x1)) { | |
lines(trans3d(x = rep(as.numeric(input$me_x1), 2), y = c(0,1), | |
z = predict(m, data.frame(x1 = rep(as.numeric(input$me_x1), 2), x2 = c(0,1))), | |
pmat = p), | |
col = input$me_x1_color, lwd = 2) | |
} | |
if (!is.na(input$me_x2)) { | |
lines(trans3d(x = c(0,1), y = rep(as.numeric(input$me_x2), 2), | |
z = predict(m, data.frame(x1 = c(0,1), x2 = rep(as.numeric(input$me_x2), 2))), | |
pmat = p), | |
col = input$me_x2_color, lwd = 2) | |
} | |
}) | |
output$downloadImage <- downloadHandler( | |
filename = "perspective.png", | |
content = function(file) { | |
png(file) | |
plotInput() | |
dev.off() | |
}, | |
contentType = "image/png" | |
) | |
} | |
shinyApp(ui, server) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Awesome...Can we make it interactive using some libraries like plotly or plot3D etc?