I am trying to add some elements to my shiny app to make it look better.
Therefore, I am using the new shiny.semantic package which allows to add semantic UI elements in an easy way.
One finds examples for shiny semantic elements here:
http://demo.appsilondatascience.com/shiny.semantic/components/
I wanted to add a rating stars UI with the following code:
library(shiny)
#devtools::install_github("Appsilon/shiny.semantic")
library(shiny.semantic)
ui <- function() {
shinyUI(
semanticPage(
title = "My page",
suppressDependencies("bootstrap"),
div(class = "ui star rating")
)
)
}
server <- shinyServer(function(input, output) {
})
shinyApp(ui = ui(), server = server)
Unfortunately, the rating stars are not appearing in the app. Is there another way to add such rating stars to shiny apps?
You need to initialize with Javascript code
ui.R:
library(shiny)
library(shiny.semantic)
shinyUI(semanticPage(
shinyjs::useShinyjs(),
div(class = "ui star rating")
))
server.R:
library(shiny)
library(shinyjs)
jsCode <- "
$('.ui.rating')
.rating({
initialRating: 3,
maxRating: 5
})
;
"
shinyServer(function(input, output) {
runjs(jsCode)
})
An alternative approach would be to use my shinyRatings package. https://github.com/shahronak47/shinyRatings
#Installation of the package from Github
#devtools::install_github('shahronak47/shinyRatings')
library(shiny)
library(shinyRatings)
library(shiny.semantic)
ui <- semanticPage(
shinyRatings('star'),
textOutput('text')
)
server <- function(input, output, session) {
output$text <- renderText({paste("No. of stars : ", input$star)})
}
shinyApp(ui, server)
Related
I am using below code and try to do below action.
Click on action button to go to next table. How can I do this?
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- fluidPage(
fluidRow(box(
actionButton("btn1", "Go to Next Table"),
tableOutput("tbl1")
)),
fluidRow(box(
tableOutput("tbl2")
))
)
server <- function(input, output, session) {
output$tbl1 <- renderTable(mtcars)
output$tbl2 <- renderTable(mpg)
}
shinyApp(ui, server)
Here's one solution:
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- fluidPage(
fluidRow(box(
actionButton("btn1", "Go to Next Table",
onclick = "location.href='#table2';"),
tableOutput("tbl1")
)),
fluidRow(id = "table2", box(
tableOutput("tbl2")
))
)
server <- function(input, output, session) {
output$tbl1 <- renderTable(mtcars)
output$tbl2 <- renderTable(mpg)
}
shinyApp(ui, server)
I've added a unique ID to the location in the UI - here the 2nd fluidRow, then added an onclick javascript function to the actionButton also in the UI. No server function means all the work is done by the user's browser which is handy sometimes.
You can add infinite complexity to the Javascript here to customise it to fit your needs.
My goal is to plot the output, a process map, onto the browser. The output plot continues to appear in the Viewer pane in RStudio.
All of the functionality works as expected and I'm able to call the appropriate data and generate a dynamic output based on the dropdown menu.
Any help would be much appreciated. Full code is below.
library(shiny)
library(bupaR)
library(pm4py)
library(reticulate)
library(processmapR)
ui <- fluidPage(
tags$h1("Process Mining"),
tags$p("The purpose of this application is to show the Process Map output"),
fluidRow(
selectInput("pm_type","Process Mining Type", c("absolute","relative"))),
fluidRow(
plotOutput("plot1"))
)
server <- function(input, output) {
selectedData <- reactive({input$pm_type})
output$plot1 <- renderPlot({
patients %>%
process_map(type = frequency(selectedData()))
})
}
shinyApp(ui = ui, server = server)
To get output of process_map in shiny you have to use GrViz functions from DiagrammeR.
library(shiny)
library(bupaR)
library(pm4py)
library(reticulate)
library(processmapR)
library(DiagrammeR)
ui <- fluidPage(
tags$h1("Process Mining"),
tags$p("The purpose of this application is to show the Process Map output"),
fluidRow(
selectInput("pm_type","Process Mining Type", c("absolute","relative"))),
fluidRow(
grVizOutput("plot1"))
)
server <- function(input, output) {
selectedData <- reactive({input$pm_type})
output$plot1 <- renderGrViz({
patients %>%
process_map(type = frequency(selectedData()))
})
}
shinyApp(ui = ui, server = server)
I am trying to render a few outputs in a shiny application that are contained within a shinyjs::hidden section upon the application running rather than once the section is visible.
EDIT: I had the app set up incorrectly in the original example so have changed it.
I want to be able to run the reactive statement before running the final observe to change the UI from the Alpha text to the Beta text and plot. Ideally this would mean in the console would see "Done plotting" before "Observe run".
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
div(id = "before-content", h3("Aux Text Alpha")),
shinyjs::hidden(
div(
id = "after-content",
h1("Aux Text Beta"),
plotOutput("text")
)
)
)
server <- function( session,input, output) {
in_plot <- reactive({
Sys.sleep(3)
print("Done plotting")
plot(iris)
})
output$text <- renderPlot({
in_plot()
})
observe({
print("Observe run")
hide("before-content")
show("after-content")
})
}
shinyApp(ui, server)
An alternative would be to have a layer over what is classed as the hidden section but am not too sure on how that is accomplished.
You can hide it in the reactive, like so:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
actionButton("button", "Click me"),
plotOutput("text")
)
server <- function( session,input, output) {
in_plot <- reactive({
hide("text")
Sys.sleep(3)
print("Done plotting")
plot(iris)
})
output$text <- renderPlot({
in_plot()
})
observeEvent(input$button, {
show("text")
})
}
shinyApp(ui, server)
The given R shiny script creates a simple data table as in the snapshot with an actionButton in the center. I want to place the button a little below it's current position such that it is in perfect horizontal inline position to the search bar. Thanks and please help.
library(DT)
library(shiny)
library(shinyBS)
library(rpivotTable)
library(bupaR)
ui <- basicPage(
h2("The mtcars data"),
column(5,offset = 5,actionButton("CR1_S1", "Button")),
dataTableOutput("mytable1")
)
server <- function(input, output) {
output$mytable1 <- DT::renderDataTable({
DT::datatable(iris)
})
}
shinyApp(ui, server)
You can put the button inside the datatable in this way:
ui <- basicPage(
h2("The mtcars data"),
actionButton("CR1_S1", "Button"),
DTOutput("mytable1")
)
server <- function(input, output) {
output$mytable1 <- renderDT({
datatable(iris, callback = JS("$('div.button').append($('#CR1_S1'));"),
options = list(
dom = '<"row"<"col-sm-4"l><"col-sm-4 text-center"<"button">><"col-sm-4"f>>tip'
))
})
}
shinyApp(ui, server)
I'm experimenting a Shiny App to show dynamic contexts, but I cannot get renderDataTable working into a renderUi component.
Below two simple replicable tests: the first one is not working, the second one without renderUi works fine, of course.
What is the conceptually difference between this two, and why the first one cannot work in Shiny?
This one not works: note that the uiOutput myTable, contains two reactive component, a selectInput and a renderDataTable, but only the selectInput is rendered.
library(shiny)
runApp(list(
ui = fluidPage(
fluidRow(h2("where is the table?")),
uiOutput('myTable')
),
server = function(input, output) {
output$myTable <- renderUI({
fluidPage(
fluidRow(selectInput("test", "test", c(1,2,3))),
fluidRow(renderDataTable(iris))
)
})
}
))
This is fine, both selectInput and renderDataTable are rendered:
library(shiny)
runApp(list(
ui = fluidPage(
fluidRow(h2("where is the table?")),
fluidRow(selectInput("test", "test", c(1,2,3))),
fluidRow(dataTableOutput('myTable'))
),
server = function(input, output) {
output$myTable = renderDataTable(iris)
}
))
How to get the first scenario working?
Thanks.
EDITING after Yihui comment (thanks Yihui):
In renderUi has to be used some ui function, and not some render function:
changed the sample code in the correct way, the result does not change: still no data is shown.
library(shiny)
runApp(list(
ui = basicPage(
uiOutput('myTable')
),
server = function(input, output) {
output$myTable <- renderUI({dataTableOutput(iris)
})
}
))
EDIT n.2
Just solved, got it working so:
library(shiny)
runApp(list(
ui = fluidPage(
mainPanel(
uiOutput('myTable')
)
),
server = function(input, output) {
output$myTable <- renderUI({
output$aa <- renderDataTable(iris)
dataTableOutput("aa")
})
}
))
I have to save the renderTableOutput in a output variable first, and then feeding it to dataTableOutput.
Thanks for pointing me to: here
It would be clearer if you split the part of datatable generation and ui generation :
library(shiny)
runApp(list(
ui = fluidPage(
mainPanel(
uiOutput('myTable')
)
),
server = function(input, output) {
output$aa <- renderDataTable({iris})
output$myTable <- renderUI({
dataTableOutput("aa")
})
}
))