Rmarkdown - interactive model - shiny

Question

Whoever come across with JMP agrees that its model profiler is the best thing you can find on that software.
Simply is a series of interactive plots of the model (I don't think there is a better way to communicate an additive model - looks like the one below)
Now, I would like to have something similar in my html rmarkdown reports.
It seems that might be possible to add rshiny on rmarkdows so I've managed to get something like the below on RShiny.
library(tidyverse)
library(shiny)
inputData <- mtcars
lm1 <- lm(mpg ~ hp + I(hp^2) + wt * cyl, data = mtcars)
ui <- fluidPage(
titlePanel("Profiler"),
sidebarLayout(
sidebarPanel(
helpText("Choose the level of each factor"),
sliderInput("var_1", label= paste(names(inputData)[2]),
min = min(inputData[,2]),
max = max(inputData[,2]),
value = mean(inputData[,2]),
step = diff(range(inputData[,2]))/50),
sliderInput("var_2", paste(names(inputData)[6]),
min = min(inputData[,6]),
max = max(inputData[,6]),
value = mean(inputData[,6]),
step = diff(range(inputData[,6]))/50),
sliderInput("var_3", paste(names(inputData)[4]),
min = min(inputData[,4]),
max = max(inputData[,4]),
value = mean(inputData[,4]),
step = diff(range(inputData[,4]))/50)
),
mainPanel(
tableOutput('table_pred'),
plotOutput("plot2"),
plotOutput("plot3"),
plotOutput("plot1")
)
)
)
server <- function(input, output) {
# Data declaration
data <- reactive({
req(input$var_1, input$var_2,input$var_3)
data.frame(cyl = input$var_1, wt = input$var_2, hp = input$var_3)
})
# The new predicted value for the specific input
pred <- reactive({
predict(lm1, data(), se = T, interval="confidence", level=0.95)$fit %>% as_tibble() %>%
rename(Prediction = fit, `Lower limit` = lwr, `Upper limit` = upr)
})
# Present as table the outcome of specific inputs
output$table_pred <- renderTable({
pred()
})
# Prepare the plots
# Create the continuum space for the predictors
hp_space <- reactive({
seq(min(mtcars$hp), max(mtcars$hp), length.out = 1e3)
})
cyl_space <- reactive({
seq(min(mtcars$cyl), max(mtcars$cyl), length.out = 1e3)
})
wt_space <- reactive({
seq(min(mtcars$wt), max(mtcars$wt), length.out = 1e3)
})
# Perform predictions for each point
new_pred_hp <- reactive({
temp <- tibble(hp = hp_space(), cyl = input$var_1, wt = input$var_2 )
temp %>%
bind_cols(predict(lm1, newdata = temp,
se = T, interval="confidence", level=0.95)$fit %>% as_tibble)%>%
mutate(Predictor = 'hp')
})
new_pred_cyl <- reactive({
temp <- tibble(hp = input$var_3, cyl = cyl_space(), wt = input$var_2 )
temp %>%
bind_cols(predict(lm1, newdata = temp,
se = T, interval="confidence", level=0.95)$fit %>% as_tibble)%>%
mutate(Predictor = 'cyl')
})
new_pred_wt <- reactive({
temp <- tibble(hp = input$var_3, cyl = input$var_1, wt = wt_space())
temp %>%
bind_cols(predict(lm1, newdata = temp,
se = T, interval="confidence", level=0.95)$fit %>% as_tibble) %>%
mutate(Predictor = 'wt')
})
# Make one plot per predictor
output$plot1 <- renderPlot({
ggplot(new_pred_hp(), aes( x = hp, y = fit)) +
geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.1, fill = 'red') +
geom_line(size = 1, color = 'black')+
geom_vline(xintercept = input$var_3, colour = 'red', linetype = 'dashed')
})
output$plot2 <- renderPlot({
ggplot(new_pred_cyl(), aes( x = cyl, y = fit)) +
geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.1, fill = 'red') +
geom_line(size = 1, color = 'black')+
geom_vline(xintercept = input$var_1, colour = 'red', linetype = 'dashed')
})
output$plot3 <- renderPlot({
ggplot(new_pred_wt(), aes( x = wt, y = fit)) +
geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.1, fill = 'red') +
geom_line(size = 1, color = 'black')+
geom_vline(xintercept = input$var_2, colour = 'red', linetype = 'dashed')
})
}
shinyApp(ui, server)
Which looks like that,
Questions:
Is there a more elegant way to get these results on html rmarkdown? (maybe with HTML widgets so as to avoid rshiny?)
How to add all this complicated rshiny code (for my intro level) into rmarkdown report?
Thanks.