I'm dealing with a quite complicated shiny app in which I would like to create an UI output inside server function. UI is not that easy and depends on many items created on a server side so I'm creating it concatenating HTML parts of UI. Everything works until I meet plotly chart.
I've created a simpler version of my app to make it easier to understand my problem.
Normally I'd do sth like that:
library("shiny")
library("plotly")
library("dplyr")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
),
mainPanel(
plotlyOutput("distPlot1"),
plotOutput("distPlot2")
)
)
)
server <- function(input, output) {
output$distPlot1 <- renderPlotly({
x <- faithful[, 2]
plot_ly(x = x, type = "histogram")
})
output$distPlot2 <- renderPlot({
x <- faithful[, 2]
hist(x)
})
}
shinyApp(ui = ui, server = server)
to obtain this:
But when I start to create ui on server side like here (edited part with more divs inside ui):
library("shiny")
library("plotly")
library("dplyr")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
),
mainPanel(
htmlOutput("ui1"),
uiOutput("ui2")
)
)
)
server <- function(input, output) {
output$distPlot1 <- renderPlotly({
x <- faithful[, 2]
plot_ly(x = x, type = "histogram")
})
output$distPlot2 <- renderPlot({
x <- faithful[, 2]
hist(x)
})
output$ui1 <- renderUI({
show <- h1("lfkhg")
show <- paste0(show, plotlyOutput("distPlot1") %>% as.character())
HTML(show)
})
output$ui2 <- renderUI({
show <- h1("lfkhg")
show <- paste0(show, plotOutput("distPlot2") %>% as.character())
HTML(show)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Plotly plot does not appear...
Do you know why and how to deal with this problem?
I dont know why you need %>% HTML() in there as it works for me without it. Also if you want to add more things into the renderUI then simply use tagList and combine them together, here I will add h1 as per your comment
library("shiny")
library("plotly")
library("dplyr")
ui <- fluidPage(
sidebarLayout(sidebarPanel(),
mainPanel(
uiOutput("ui1"),
uiOutput("ui2")
)
)
)
server <- function(input, output) {
output$distPlot1 <- renderPlotly({
x <- faithful[, 2]
plot_ly(x = x, type = "histogram")
})
output$distPlot2 <- renderPlot({
x <- faithful[, 2]
hist(x)
})
output$ui1 <- renderUI({
tagList(h1("lfkhg"),plotlyOutput("distPlot1"))
})
output$ui2 <- renderUI({
plotOutput("distPlot2")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
I want to add one tabulation to a line in Shiny but I don't find the way to do it.
I know that there are HTML tags in Shiny such as strong to put words in bold, small to make them smaller... Even blockquote to add blocks of quotes.
But I didn't find one to add one tabulation.
Does anyone know how to do it?
Reproducible code:
library(shiny)
ui = pageWithSidebar(
headerPanel("My app"),
sidebarPanel(
),
mainPanel(
htmlOutput("text")
)
)
server = function(input, output) {
output$text <- renderUI({
str1 <- strong("This is the first line in bold:")
str2 <- em("This is the second line in italics and with one tabulation")
HTML(paste(str1, str2, sep = '<br/>'))
})
}
shinyApp(ui,server)
You can add a style attribute to each shiny-tag:
library(shiny)
ui = pageWithSidebar(
headerPanel("My app"),
sidebarPanel(),
mainPanel(
htmlOutput("text")
)
)
server = function(input, output) {
output$text <- renderUI({
tag1 <- p(strong("This is the first line in bold:"))
tag2 <- p(em("This is the second line in italics and with one tabulation"), style = "text-indent: 1em;")
HTML(paste(tag1, tag2, sep = '<br/>'))
})
}
shinyApp(ui,server)
You could do it just using html code instead of the r tags from shiny:
library(shiny)
ui = pageWithSidebar(
headerPanel("My app"),
sidebarPanel(
),
mainPanel(
htmlOutput("text")
)
)
server = function(input, output) {
output$text <- renderUI({
str1 <- "<p><strong>This is the first line in bold:</strong></p>"
str2 <- "<p style='text-indent: 45px'><em>This is the second line in italics and with one tabulation</em></p>"
HTML(paste(str1, str2, sep = ''))
})
}
shinyApp(ui,server)
unless I have misunderstood what you're trying to do.
For a shiny app, I'd like to go through a data frame row-wise and highlight (bold, color, or similiar) the selected row in renderTable. I was thinking of selecting the row by index. Can I do this with renderTable, or should I consider DT?
library(shiny)
ui <-
fluidRow(
actionButton(
"my_button",
"Go to next row"
),
tableOutput("my_table")
)
server <- function(input, output){
values <- reactiveValues()
values$index <- 1
values$dat <- iris
observeEvent(
input$my_button, {
values$index <- values$index + 1
})
output$my_table <-
renderTable(values$dat) # somehow highlight the row at the index
}
shinyApp(ui = ui, server = server)
This might get you started.
library(shiny)
library(DT)
library(dplyr)
ui <-
fluidRow(
actionButton(
"my_button",
"Go to next row"
),
dataTableOutput("my_table")
)
server <- function(input, output){
values <- reactiveValues()
values$index <- 1
values$dat <- iris
observeEvent(
input$my_button, {
values$index <- values$index + 1
})
output$my_table <-
renderDataTable({
values$dat %>%
mutate(row = row_number()) %>%
datatable() %>%
formatStyle(
"row",
target = 'row',
backgroundColor = styleEqual(values$index, c('yellow'))
)
}) # somehow highlight the row at the index
}
shinyApp(ui = ui, server = server)
I'm trying to create a checkbox for which the choices are plots created through ggplot. In the result, the UI looks like the HTML code itself instead of evaluating the HTML code to show the chart. Any ideas how I can get the checkboxGroupInput to show ggplots?
Sample code below -
runApp(shinyApp(
ui = fluidPage(
headerPanel("Plot check box"),
mainPanel(
uiOutput("plotscheckboxes")
)
),
server = function(input, output, session) {
output$plot1 = renderPlot({
ggplot(mtcars)+geom_point(aes(x=mpg,y=mpg))
})
output$plot2 = renderPlot({
ggplot(mtcars)+geom_point(aes(x=mpg,y=mpg))
})
output$plotscheckboxes = renderUI({
plotlist = list(
plotOutput('plot1'),
plotOutput('plot2')
)
plotlist2 = do.call(tagList, plotlist)
# this just produces a list with 1,2, some sort of underlying value for the checkboxGroup
finaloptionlist = lapply(
seq(length(plotlist2)),
function(x) x
)
# the names of the list are what get used in the options so setting the names accordingly as the HTML code of the ggplot rendering
names(finaloptionlist) = sapply(plotlist2, function(x) paste(x, collapse = "\n"))
checkboxGroupInput("checkGroup", label = h3("Checkbox group"),
choices = finaloptionlist,
selected = 1)
})
}
))
I wish to use the values of a clicked point for further processing but am unclear how to reference the data
library(shiny)
library(ggvis)
library(dplyr)
df <- data.frame(a=c(1,2),b=c(5,3))
runApp(list(
ui = bootstrapPage(
ggvisOutput("plot")
),
server = function(..., session) {
# function to handle click
getData = function(data,location,session){
if(is.null(data)) return(NULL)
# This returns values to console
print(glimpse(data))
# Observations: 1
# Variables:
# $ a (int) 2
# $ b (int) 3
}
# create plot
df %>%
ggvis(~a, ~b) %>%
layer_points() %>%
handle_click(getData) %>%
bind_shiny("plot")
# further processing
clickedData <- reactive({
# how do I reference the value 'a' e.g. 2 of the clicked point'
})
}
))
TIA
Here's a working solution that just prints out the data.frame. You're close.
df <- data.frame(a = 1:5, b = 101:105)
runApp(shinyApp(
ui = fluidPage(
ggvisOutput("ggvis")
),
server = function(input, output, session) {
clickFunc <- function(data, location, session) {
cat(str(data))
}
df %>%
ggvis(~ a, ~b) %>%
layer_points %>%
handle_click(clickFunc) %>%
bind_shiny("ggvis")
}
))
EDIT:
(disclaimer: I never used ggvis in shiny until 5 minutes ago so maybe this isn't the correct way, but this works)
Here's how to use the data in your UI
df <- data.frame(a = 1:5, b = 101:105)
runApp(shinyApp(
ui = fluidPage(
div("a:", textOutput("aVal", inline = TRUE)),
div("b:", textOutput("bVal", inline = TRUE)),
ggvisOutput("ggvis")
),
server = function(input, output, session) {
clickFunc <- function(data, location, session) {
session$output$aVal <- renderText({ data$a })
session$output$bVal <- renderText({ data$b })
}
df %>%
ggvis(~ a, ~b) %>%
layer_points %>%
handle_click(clickFunc) %>%
bind_shiny("ggvis")
}
))
I want to create rChart for my data extracted from a mysql database. As shown in ui.R and server.R created ggplot is visible but not the rChart? Can anyone explain what has gone wrong here?
ui.R
library(shiny)
library("shinyBS", lib.loc="/home/thisa/R/x86_64-pc-linux-gnu-library/3.0")
require("rCharts")
options(RCHART_LIB = 'polycharts')
# Define UI for application that plots random distributions
shinyUI(fluidPage(
# Show a plot of the generated distribution
mainPanel(
fluidRow(
column(width=4,
plotOutput("sales")
),
column(width=8,
showOutput("salesR","polycharts")
)
)
)
))
server.R
library(shiny)
library("DBI", lib.loc="/home/thisa/R/x86_64-pc-linux-gnu-library/3.0")
library("RMySQL", lib.loc="/home/thisa/R/x86_64-pc-linux-gnu-library/3.0")
library("ggplot2", lib.loc="/home/thisa/R/x86_64-pc-linux-gnu-library/3.0")
library("shinyBS", lib.loc="/home/thisa/R/x86_64-pc-linux-gnu-library/3.0")
require("rCharts")
con <- dbConnect(MySQL(),
user="root",password="891208",host="localhost",dbname="openPos")
# Define server logic required to generate and plot a random distribution
shinyServer(function(session,input, output) {
sales_total <- reactive({ "SELECT ospos_sales.sale_time,
CAST(sale_time AS date) AS sale_date, ospos_sales.employee_id,
ospos_sales.sale_id, ospos_sales_items.line,
ospos_sales_items.quantity_purchased,
ospos_sales_items.item_cost_price,
ospos_sales_items.item_unit_price,
ospos_sales_items.discount_percent,
ospos_suppliers.person_id,
ospos_suppliers.company_name,
ospos_items.name, ospos_items.category,
ospos_items.supplier_id,
ospos_items.item_number,
ospos_items.quantity,
ospos_items.reorder_level,
ospos_items.location,
sum(quantity_purchased * item_unit_price-item_unit_price*(discount_percent/100))
AS revenue, sum(quantity_purchased * item_cost_price) AS cost
FROM ospos_sales, ospos_sales_items,
ospos_suppliers, ospos_items
WHERE ospos_sales.sale_id = ospos_sales_items.sale_id
AND ospos_sales_items.item_id = ospos_items.item_id
AND ospos_items.supplier_id = ospos_suppliers.person_id
GROUP BY sale_time"})
salesTotal <- reactive({dbGetQuery(con,sales_total())})
output$sales <- renderPlot
({
p<-ggplot(salesTotal(),
aes_string(x="sale_time",y="revenue"))+geom_point()
print(p)})
output$salesR <- renderChart({
m1 <- rPlot(revenue ~ sale_time, data = salesTotal(),type='point')
return(m1)
})
})