Latex equation not rendering correctly in shiny - r

I want to display a latex equation in a shiny application. I saw an example where mathjax is used to display latex equations. But for some reason the equation generated from equatiomatic package does not display correctly. Following is a reproducible example:
library(shiny)
library(tidyverse)
library(broom)
library(equatiomatic)
## Loading Dataset
data(mpg)
mpg2 <- mpg %>%
select(where(is.numeric))
## User Interface
ui <- fluidPage(
withMathJax(),
sidebarPanel(
selectInput(inputId = "xcol",
label = "Select an explanatory variable",
choices = colnames(mpg2),
selected = "cty"),
selectInput(inputId = "ycol",
label = "Select a response variable",
choices = colnames(mpg2),
selected = "hwy")
),
mainPanel(
plotOutput('plot'),
br(),
uiOutput('eq'),
br(),
tableOutput('table1'),
br(),
tableOutput('table2')
)
)
## Server
server <- function(input, output, session) {
data <- reactive({
mpg2 %>%
select(col1 = input$xcol, col2 = input$ycol)
})
output$plot <- renderPlot({
ggplot(data()) +
geom_point(aes(col1, col2)) +
labs(x = input$xcol, y = input$ycol)
})
output$table1 <- renderTable({
m1 <- lm(reformulate(input$xcol, input$ycol), data = mpg2)
broom::tidy(m1)
})
output$table2 <- renderTable({
m1 <- lm(reformulate(input$xcol, input$ycol), data = mpg2)
broom::glance(m1)[, 1:2]
})
output$eq <- renderUI({
m1 <- lm(reformulate(input$xcol, input$ycol), data = mpg2)
withMathJax(helpText(extract_eq(m1)))
})
}
shinyApp(ui, server)

Interesting, it seems like shiny is expecting the equation as raw character string. Hence it is missing a \ for all Latex operators.
One (not very pretty) way to fix it would be:
output$eq <- renderUI({
m1 <- lm(reformulate(input$xcol, input$ycol), data = mpg2)
withMathJax(helpText(
paste0("$$", as.character(extract_eq(m1)), "$$")
)
)
})
However I am not too familiar with the package so not sure if this is intended or a bug... Have you considered opening an issue at the equatiomatic GitHub?

Related

Unsupported index type: NULL --> plotly chart in shiny

I am getting an error with the plotting index using plotly in conjunction with reactive values in shiny. The sidebar panel loads with no issues but there is a problem displaying the chart that I cannot determine. Any help solving the index problem would be much appreciated. Thanks!
library(shiny)
library(plotly)
data(economics, package = "ggplot2")
nms <- names(economics)
ui <- fluidPage(
headerPanel("TEST"),
sidebarPanel(
selectInput('x', 'X', choices = nms, selected = nms[[1]]),
selectInput('y', 'Y', choices = nms, selected = nms[[2]]),
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot', height = "900px")
)
)
server <- function(input, output) {
#add reactive data information. Dataset = built in diamonds data
dataset <- reactive({economics[, c(input$xcol, input$ycol)]
})
output$trendPlot <- renderPlotly({
# build graph with ggplot syntax
p <- ggplot(dataset(), aes_string(x = input$x, y = input$y)) +
geom_line()
ggplotly(p) %>%
layout(height = input$plotHeight, autosize=TRUE)
})
}
shinyApp(ui, server)
Warning: Error in : Unsupported index type: NULL
You have mistakenly used xcol and ycol not sure why. Without those names the code works fine.
library(shiny)
library(plotly)
library(tidyverse)
data(economics, package = "ggplot2")
nms <- names(economics)
ui <- fluidPage(
headerPanel("TEST"),
sidebarPanel(
selectInput('x', 'X', choices = nms, selected = nms[[1]]),
selectInput('y', 'Y', choices = nms, selected = nms[[2]]),
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot', height = "900px")
)
)
server <- function(input, output) {
#add reactive data information. Dataset = built in diamonds data
dataset <- reactive({
economics[, c(input$x, input$y)]
})
output$trendPlot <- renderPlotly({
# build graph with ggplot syntax
p <- ggplot(dataset(), aes_string(input$x, input$y)) +
geom_line()
ggplotly(p, height = input$plotHeight)
})
}
shinyApp(ui, server)

attempt to apply non-function

I'm trying to build a simple application that draws a histogram of a selected variable based on a subset filtered by the other input. I get the error in the line hist(dataX()$datasetInput()) which should return dataX$mpg. How can I fix it?
Full code:
library(shiny)
u <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(
selectInput("variable", "Variable:",
list("Milles/gallon",
"Horse power")
),
textInput("nc","Number of cylinders",value = 6)
),
mainPanel(
plotOutput("Plot")
)
))
s <- shinyServer(function(input, output)
{
dataX <- reactive({mtcars[mtcars$cyl==input$nc,,drop = FALSE]})
datasetInput <- reactive({
switch(input$variable,
"Milles/gallon" = mpg,
"Horse power" = hp)
})
output$Plot <- renderPlot({
hist(dataX()$datasetInput())
})
})
shinyApp(u,s)
You complicated the simple app.
You do not need to list all the columns in selectInput. You can just render it from the server side.
Same applies to the cylinders
Shortcuts like u and sare acceptable, but just stick to the naming conventions. It makes your life easy.
Below is a complete working app
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(uiOutput("SelectColname"),
uiOutput("Cylinders")),
mainPanel(plotOutput("Plot"))
))
server <- shinyServer(function(input, output){
# Create a reactive dataset
dataX <- reactive({
mtcars
})
# Output number cylinders as select box
output$Cylinders <- renderUI({
selectInput("cylinders", "cylinders:", unique(dataX()$cyl))
})
# Output column names as selectbox
output$SelectColname <- renderUI({
selectInput("variable", "Variable:", colnames(dataX()[,c(1,4)]))
})
# Based on the selection by user, create an eventreactive plotdata object
plotdata <- eventReactive(input$cylinders, {
plotdata = dataX()[dataX()$cyl == input$cylinders, , drop = FALSE]
})
# Render the plot, the plot changes when new cylinder is selected
output$Plot <- renderPlot({
if (is.null(plotdata()))
return(NULL)
hist(
plotdata()[, input$variable],
xlab = input$variable,
main = paste(
"Histogram of" ,
input$variable
)
)
})
})
shinyApp(ui, server)

Dynamically choose inputs based on reactive subset data in shiny

Setup: I already have build a shiny-app with two plots. I used the flexdashboard-package to create two plots in two tabs. In addition I programmed the whole shiny-app in R-markdown.
Now I want to create an interface where the user can subset the data. That part itself works. However I also need to perform some calculations with the subsetted data, before I do my two plots.
Is there any way I can transform some subsetted object like mydata to a dataframe? My problem is that I need to use this subsetted object also in the UI part of the other plots.
EDIT: I specifically need some way to transport my selection from checkboxGroupInput to selectInput("cat_1"," category 1:",choices = levels(mydata()$mycat).
### 1. Create some sample data
myrows<-sample(letters,12)
exdata<- data.frame(mycat=rep(myrows,2),yr=rep(1:2,each=12),KPI_1=rnorm(24),
KPI_2=round(runif(24,1,20)),KPI_3=rbinom(24,6,0.5))
### 2. UI part
fluidPage(fluidRow(
checkboxGroupInput("comp", "Categories",myrows,myrows,inline=TRUE),
actionButton("go", "Update"),
textOutput("txt"),
tableOutput("head"))
)
### 3. Server part
mydata<-eventReactive(input$go,{
res<-subset(exdata,mycat%in%input$comp)
return(res)
})
output$txt <- renderText({
paste("You chose", paste(input$comp, collapse = ", "))
})
output$head <- renderTable({
mydata()
})
In the next chunk I do this:
library(plotly)
library(shiny)
### 4. UI part of my plot
fluidRow(sidebarLayout(sidebarPanel(
selectInput("cat_1",
" category 1:",
choices = levels(mydata()$mycat),
selected = levels(mydata()$mycat)[1]),
selectInput("cat_2",
" category 2:",
choices = levels(mydata()$mycat),
selected = levels(mydata()$mycat)[2])),
mainPanel(plotlyOutput("plot3", height = 300, width = 700))))
### 5. Server part of my plot
output$plot3 <- renderPlotly({
## 5.1 Create plot data
cat1<-input$cat_1
cat2<-input$cat_2
y1<-as.numeric(mydata()[mydata()$mycat==cat1])
y2<-as.numeric(mydata()[mydata()$mycat==cat2])
x0<-c(1,2)
## 5.2 Do plot
plot_ly(x = x0,y = y1, type="scatter",mode='lines+markers',name=Firm1) %>%
add_trace(y = y2, name = Firm2, mode = 'lines+markers') %>%
layout(dragmode = "select")
It took me a while to figure out your code. So:
1) Make use of renderUI which will allow you to dynamically create controls
2) Stick with one ui
3) Make sure you understand the renderPlotly and what you're trying to plot
library(shiny)
library(plotly)
### 1. Create some sample data
myrows<-sample(letters,12)
exdata<- data.frame(mycat=rep(myrows,2),yr=rep(1:2,each=12),KPI_1=rnorm(24),
KPI_2=round(runif(24,1,20)),KPI_3=rbinom(24,6,0.5))
ui <- fluidPage(
sidebarPanel(
uiOutput("c1"),uiOutput("c2")),
mainPanel(
column(6,
checkboxGroupInput("comp", "Categories",myrows,myrows,inline=TRUE),
actionButton("go", "Update"),
textOutput("txt"),
tableOutput("head")),
column(6,
plotlyOutput("plot3", height = 300, width = 700)))
)
server <- function(input, output) {
### 3. Server part
mydata <- eventReactive(input$go,{
res<-subset(exdata,mycat%in%input$comp)
return(res)
})
output$txt <- renderText({
paste("You chose", paste(input$comp, collapse = ", "))
})
output$head <- renderTable({
mydata()
})
conrolsdata <- reactive({
unique(as.character(mydata()$mycat))
})
output$c1 <- renderUI({
selectInput("cat_1", "Variable:",conrolsdata())
})
output$c2 <- renderUI({
selectInput("cat_2", "Variable:",conrolsdata())
})
output$plot3 <- renderPlotly({
if(is.null(input$cat_1)){
return()
}
y1<- mydata()$KPI_1[as.character(mydata()$mycat) %in% input$cat_1]
y2<- mydata()$KPI_2[as.character(mydata()$mycat) %in% input$cat_2]
x0<-c(1,2)
#use the key aesthetic/argument to help uniquely identify selected observations
plot_ly(x = x0,y = y1, type="scatter",mode='lines+markers',name="Firm1") %>%
add_trace(y = y2, name = "Firm2", mode = 'lines+markers') %>%
layout(dragmode = "select")
})
}
shinyApp(ui, server)

Display markdown table as html table in Shiny

I saw this app https://rich.shinyapps.io/regression/ and I wanted to do something similar displaying the regression output as html.
I divided my app in three parts as below.
server.R has no "engine" problems and the regression result is correct and pander is converting summary() to markdown correctly.
ui.R is also working ok but the markdown displayed after htmlOutput("model") is suppossed to be obtained from
output$model <- renderPrint({
pander(summary(model()))
})
in server.R, and the table is not well displayed even when its a valid markdown table.
How can I display my markdown summary as a common table like in R Markdown? my current output is:
Full MWE of the app
global.R
#library(shinyapps)
library(googleVis)
library(knitr)
library(pander)
library(shiny)
#library(shinysky)
ui.R
# Define UI for application
shinyUI(fluidPage(
# Application title
titlePanel("Bivariate Regression"),
# Sidebar
sidebarLayout(
sidebarPanel(
textInput("name", label = h5("Name"), value = "Name"),
HTML('</br>'),
#selectInput("dataset", h5("Choose a dataset:"), choices = c("cars", "longley", "MLB","rock", "pressure")),
selectInput("dataset", h5("Choose a dataset:"), choices = c("cars", "longley","rock", "pressure")),
HTML('</br>'),
uiOutput('dv'),
HTML('</br>'),
uiOutput('iv'),
HTML('</br>')),
#radioButtons('format', h5('Document format'), c('PDF', 'HTML', 'Word'), inline = TRUE),
#downloadButton('downloadReport')),
#includeHTML('help.html')),
# main panel
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Data",
HTML("</br>Select a data set from the 'Choose a dataset menu' or enter your own data below </br> </br>"),
numericInput("obs", label = h5("Number of observations to view"), 10),
tableOutput("view")),
tabPanel("Summary Statistics",
verbatimTextOutput("summary"),
textInput("text_summary", label = "Interpretation", value = "Enter text...")),
tabPanel("Model",
htmlOutput("model"),
textInput("text_model", label = "Interpretation", value = "Enter text..."))
)
))
))
server.R
shinyServer(function(input, output) {
# list of data sets
datasetInput <- reactive({
switch(input$dataset,
"cars" = mtcars,
"longley" = longley,
"MLB" = mlb11,
"rock" = rock,
"pressure" = pressure,
"Your Data" = df())
})
# dependent variable
output$dv = renderUI({
selectInput('dv', h5('Dependent Variable'), choices = names(datasetInput()))
})
# independent variable
output$iv = renderUI({
selectInput('iv', h5('Independent Variable'), choices = names(datasetInput()))
})
# regression formula
regFormula <- reactive({
as.formula(paste(input$dv, '~', input$iv))
})
# bivariate model
model <- reactive({
lm(regFormula(), data = datasetInput())
})
# create graphics
# data view
output$view <- renderTable({
head(datasetInput(), n = input$obs)
})
# summary statistics
output$summary <- renderPrint({
summary(cbind(datasetInput()[input$dv], datasetInput()[input$iv]))
})
# bivariate model
output$model <- renderPrint({
pander(summary(model()))
})
# residuals
output$residuals_hist <- renderPlot({
hist(model()$residuals, main = paste(input$dv, '~', input$iv), xlab = 'Residuals')
})
output$residuals_scatter <- renderPlot({
plot(model()$residuals ~ datasetInput()[,input$iv], xlab = input$iv, ylab = 'Residuals')
abline(h = 0, lty = 3)
})
output$residuals_qqline <- renderPlot({
qqnorm(model()$residuals)
qqline(model()$residuals)
})
})

how to delete warnings in reactive inputs in shiny

Could anyone can tell me why I get an error when I change a dataset in first selectInput widget? When I change a dataset from diamonds to mtcars I get an error Could not find 'carat' in input$bins and in the plot just for one second and after that everything works fine. Why it happened?
library(shiny)
library(ggplot2)
data(diamonds)
data(mtcars)
ui <- fluidPage(
column(3,
selectInput("data", "", choices = c('mtcars', 'diamonds')),
uiOutput('server_cols'),
uiOutput('server_bins')
),
column(9,
plotOutput("plot")
)
)
server <- function(input, output) {
data <- reactive({
switch(input$data,
diamonds = diamonds,
mtcars = mtcars)
})
output$server_cols <- renderUI({
data <- data()
nam <- colnames(data)
selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
})
output$server_bins <- renderUI({
if (!is.null(input$cols)) {
df <- data()
x <- eval(input$cols)
max_value <- max(df[,x])
sliderInput('bins','Choose number of bins:', min = 0.1,
max = max_value,
value = max_value/2)
}
})
output$plot <- renderPlot({
if (!is.null(input$cols) & !is.null(input$bins)) {
basicData <- data()
var <- eval(input$cols)
ggplot(basicData, aes_string(var)) +
geom_histogram(binwidth = input$bins, color = 'white', fill = 'red')
}
})
}
shinyApp(ui, server)
Your respective output objects respond to any changes of your input variables. Thus, when you change your dataset via input$data, the plot rebuilds itself, although input$cols did not yet adjust. Actually, try inserting some print("a") inside the output$plot to see that it is called up to three times if you change input$data.
The fix is to rethink your reaction logic and let your elements respond only to specific changes, to get some kind of response "thread".
For example, input$data should only trigger output$server_cols. And output$server_bins should only be triggered by input$cols (because this already implies that input$data changed earlier). Ultimately, output$plot just has to listen to changes of input$bins (because changes in input$cols and input$data always result in changes of input$bins since it is at the end of the thread).
Here is my suggestion using isolate.
library(shiny)
library(ggplot2)
data(diamonds)
data(mtcars)
ui <- fluidPage(
column(3,
selectInput("data", "", choices = c('mtcars', 'diamonds')),
uiOutput('server_cols'),
uiOutput('server_bins')
),
column(9,
plotOutput("plot")
)
)
server <- function(input, output) {
data <- reactive({
switch(input$data, diamonds = diamonds, mtcars = mtcars)
})
output$server_cols <- renderUI({
data <- data()
nam <- colnames(data)
selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
})
output$server_bins <- renderUI({
if (!is.null(input$cols)) {
df <- isolate(data())
x <- eval(input$cols)
max_value <- max(df[,x])
sliderInput('bins','Choose number of bins:', min = 0.1, max = max_value, value = max_value/2)
}
})
output$plot <- renderPlot({
if (!is.null(isolate(input$cols)) & !is.null(input$bins)) {
basicData <- isolate(data())
var <- eval(isolate(input$cols))
ggplot(basicData, aes_string(var)) +
geom_histogram(binwidth = input$bins, color = 'white', fill = 'red')
}
})
}
shinyApp(ui, server)
You might also want to look into updateSelectInput and updateSliderInput if you want to alter Input Elements depending on other input.

Resources