Inside the dashboardHeader, how can you programatically generate dropdown menu items?
dropdownMenu(
type = "notifications",
notificationItem(
text = "message",
icon = icon("welcome"),
status = "warning"
),
notificationItem(
text = "message",
icon = icon("welcome"),
status = "warning"
),
... #Generate lots more messages
What is the general method in R to generate messages, say from another function that takes in an argument which is the number of messages:
GenerateMessages <- function(number.of.messages) {
#Code to generate messages
}
What would be the code, would it be written in the UI or the Server functions in shiny, dashboard header?
I'll answer my own question since it goes beyond the basic dynamic tutorial. I really like this solution because my notifications and logic can go outside of my code, it shortened my app.R by hundreds of lines.
The general form is:
Code inside the UI function:
# Code to create outputs goes in dashboardHeader
dropdownMenuOutput("messages.type"),
dropdownMenuOutput("notifications.type"),
dropdownMenuOutput("tasks.type")
Code inside Server function:
# Code to generate headers
output$messages.type <- renderMenu(
dropdownMenu(type = "messages", .list = MessageGenerator())
)
output$notifications.type <- renderMenu(
dropdownMenu(type = "notifications", .list = NotificationsGenerator())
)
output$tasks.type <- renderMenu(
dropdownMenu(type = "tasks", .list = TasksGenerator())
)
The main logic is in the MessageGenerator() function. These functions generate a list required to render in the output. The data structure is from a data.frame containing the message information with the proper headers.
This solution scales to generate messages of the three types Messages, Tasks, and Notifications using three functions MessageGenerator(), TasksGenerator(), NotificationsGenerator().
Related
I've this piece of code which is generating me an QR code, from an input field, and than saving it as .svg.
observeEvent(input$safe_qr,{
qr <- qr_code(input$qr_gen)
generate_svg(qr, "QR_Code.svg",
size = 100,
foreground = "black",
background = "white",
show = interactive())
renderPlot(qr)
})
Now I don't really need to save it, I want to see it next to my input field on the page. I have no idea how put an image inside the page.
One thing I was trying was Plot(qr) then a new window opened in edge and showed me the saved QR code. But yeah that's not what I want.
Here's a working shiny app to allow arbitrary QR generate (of text), showing in both SVG and PNG.
library(shiny)
ui <- fluidPage(sidebarLayout(
sidebarPanel(
textInput("text", label = NULL, placeholder = "(some phrase)"),
imageOutput("svgplot")
),
mainPanel(
plotOutput("plot")
)
))
server <- function(input, output, session) {
QR <- eventReactive(input$text, {
qrcode::qr_code(input$text)
})
output$svgplot <- renderImage({
txt <- isolate(input$text)
tf <- tempfile(fileext = ".svg")
qrcode::generate_svg(QR(), tf, size = 100, foreground = "black", background = "white", show = FALSE)
list(
src = normalizePath(tf),
contentType = "image/svg+xml",
width = 100, height = 100,
alt = paste("My QR code:", sQuote(txt, FALSE))
)
}, deleteFile = TRUE)
output$plot <- renderPlot({ plot(QR()) })
}
shinyApp(ui, server)
You don't need to show both, I thought I'd compare/contrast how to show them since they require different steps.
Key takeaways:
renderImage allows us to show an arbitrary image that the browser should support. The expression in this call must be a list with the attributes for the HTML img attribute, so here my list(...) is creating
<img src="path/to/tempfile.svg" contentType="image/svg+xml" width=100 height=100 alt="...">
I'm doing a two-step here: create the QR object as reactive data, and then anything that will use that will depend on QR() (my QR object). This way there will be fewer reactive-chain calls. This may not be strictly necessary if all you're doing is showing a single QR code, over to you.
shiny::renderImage requires the deleteFile= argument; if all you want to is show it, this is fine; if the user wants to right-click on the displayed SVG file and download it locally, it's still fine. In fact, since the "link" text is data:image/svg+xml;base64,PD94bWwgdmVy... and is a fairly long string (39K chars in one example), even if the temp file is deleted, this link remains unchanged and working.
I have been having problems combining the hide(), show() and reset() functions from the shinyjs package.
I have two divs. One div collects data using multiple user inputs and ends with a submit button. Once the submit button is pressed, another div should appear that shows the collected data in a table. In this second div, there is another button that should reset the original giv and show it again so that more data can be collected.
I tried to produce a reproducible example using some code from the shinyjs help page:
library(shiny)
library(shinyjs)
shinyApp(
ui = fluidPage(
useShinyjs(),
div(
id = "form",
textInput("name", "Name", "Dean"),
radioButtons("gender", "Gender", c("Male", "Female")),
selectInput("letter", "Favourite letter", LETTERS)
),
div(
id = "formreset",
textInput("name", "Newform", "Dean"),
radioButtons("gender", "Newform", c("Male", "Female")),
selectInput("letter", "Newform letter", LETTERS)
),
actionButton("reset_originalDiv", "Reset to original div"),
actionButton("resetName", "Reset name"),
actionButton("resetGender", "Reset Gender"),
actionButton("change_div", "Change div")
),
server = function(input, output) {
observeEvent(input$resetName, {
reset("name")
})
observeEvent(input$resetGender, {
reset("gender")
})
observeEvent(input$change_div, {
hide("form")
show("formreset")
})
observeEvent(input$reset_originalDiv, {
reset("form")
hide("formreset")
show("form")
})
}
)
As you can see, when clicking the "Reset to original div", the original div is not shown again.
Where is my mistake?
Thank you very much in advance.
Up front: perhaps show(.) is not the show you think it is, use shinyjs::show.
Finding this: add a debugging step to one of the observeEvent blocks that calls show:
observeEvent(input$change_div, {
browser()
hide("form")
show("formreset")
})
Run the app, then click on the appropriate button.
If we look at hide, it is what we think it should be:
Browse[2]> hide
function (id = NULL, anim = FALSE, animType = "slide", time = 0.5,
selector = NULL, asis = FALSE)
{
...
}
<bytecode: 0x000000000a6a7538>
<environment: namespace:shinyjs>
However, perhaps show is not:
Browse[2]> show
standardGeneric for "show" defined from package "methods"
function (object)
standardGeneric("show")
<bytecode: 0x000000001b740f30>
<environment: 0x000000001a823fb0>
Methods may be defined for arguments: object
Use showMethods(show) for currently available ones.
(This generic function excludes non-simple inheritance; see ?setIs)
This is showing us methods::show, whose first argument is indeed a character, and its return value is not really important to us in general, since shinyjs::show's return value is NULL, operating solely in side-effect. Because of what it does, we will get no warning or error indicating something might be amiss.
If you change all of your references to shinyjs::show, perhaps it will work.
Note: the first time I ran this app, it behaved as I just documented with the incorrect show. Once I tested the fix, now I cannot reproduce the problem with regular show("formreset"), so it is possible that something else may be going on. Using shinyjs::show is never wrong or different (unless you really are expecting to use a different show).
I'm not positive on the why of the behavior, but if you remove the hide("formreset") and move reset("form") to the last call made in the observeEvent(input$reset_originalDiv... you get the behavior you're looking for.
observeEvent(input$reset_originalDiv, {
shinyjs::show("form")
reset("form")
# hide("formreset")
})
You might want to use toggle in an observe({}) block based on the style condition of the form div class, which when hidden is "display:none" to manage the formreset button.
I need help in adding variables checkbox in r shiny within the tabPanel. I have already developed an r shiny app, in which on one of the page the data is displayed on the basis of some filterers and keywords search box.
So, I want to include one checkbox group of variables for the uploaded file.
I saw some of the solution but, non of them is based on tabPanel. Is it possible to have variable checkBox with tabPanel and how to place this under UI and SERVER. Also, as rest of the development is done so, would like to have solution with tabPanel if possible. Thanks
Tried adding the checkBoxInput but with not working with tabPanel and disturbing the current tabPanel
Below is my UI and SERVER
Here, the complete code is not displayed but, with following ui and server, wanted to add checkBoxInputgroup of variable and it should take the variable values from dfcase().
ui <- tabPanel('Evidence Finder in Background Text',
selectizeInput("Words1",
label="Important Words - Dictionary",
choices= TRUE,
multiple = TRUE,
options = list(maxOptions = 20000)),
DT::dataTableOutput("table2")
)
output$table2 <- DT::renderDataTable(server = FALSE,{
dfcase_bckg = as.data.frame(dfcase())
DT::datatable(dfcase_bckg,
rownames = FALSE,
escape = TRUE,
class = 'cell-border stripe',
selection = "single",
extensions = 'Buttons',
)
}
)
This is the view of the app and to left side i need the list of variables with checkbox
I am building an interactive Shiny app using Neo4j graph data by using RNeo4j package to connect Neo4j with R.
The app contains a table showing properties of graph data pulled from Neo4j, users can view and change table content (properties of graph data).
The changes can be written back to Neo4j as an update of graph data properties. This function can be completed using updateProp & getOrCreateNode functiona in RNeo4j package.
However, I have a reactive error.
Below is my code:
library(RNeo4j)
library(dplyr)
library(shiny)
library(shinydashboard)
library(visNetwork)
library(tidyr)
library(sqldf)
library(igraph)
library(plotly)
library(stringi)
library(stringr)
graph = startGraph("http://localhost:7474/db/data/", username = "xxx", password = "xxx")
summary(graph)
# build dashboard
# UI items list
header <- dashboardHeader(
title = "Neo4j"
)
sidebar <- dashboardSidebar(
sidebarMenu (
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard1",
box(textOutput("aa")),
box(title = "CATEGORY", DT::dataTableOutput("category")),
box(uiOutput("category_status"))
)
)
)
# UI
ui <- dashboardPage(header, sidebar, body)
# Server
server <- function(input, output, session) {
# Query graph data and properties from Neo4j and store them in table format in R
query = "
MATCH (c:Category)
RETURN c.id AS Category, c.Price AS Price, c.status AS Category_Status
"
info = cypher(graph, query) # R Table to store Neo4j data
# Build Shiny output tables
output$i1 <- renderTable(info)
output$category = DT::renderDataTable(info, selection = 'single')
# This is to build the function of change the status of category with 3 options
output$category_status = renderUI({
x = info[input$category_rows_selected, ]
if (length(x)){
selectInput("category_status", "",
c( "Sold", "On Sale","Out of Stock"),
selected = x$Category_Status)
}
})
# Table to examine if the status change was made successfully
output$aa<-renderText(input$category_status)
# Write back the changes made in Shiny to Neo4j using "updateProp" & "getOrCreateNode" function in RNeo4j
if(info$Category_Status[input$category_rows_selected] != input$category_status) {
category_num = as.numeric(substring(info$Category[input$category_rows_selected], 16))
updateProp(getOrCreateNode(graph, "Category", Category = paste("CC_CCAA_AAC.0C-", category_num, sep="")),
status = input$status)
}
}
# Shiny dashboard
shiny::shinyApp(ui, server)
Below is the error message:
Listening on http://127.0.0.1:4401
Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
55: stop
54: .getReactiveEnvironment()$currentContext
53: .subset2(x, "impl")$get
52: $.reactivevalues
50: server [#44]
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
By trail and error, the Shiny app can work properly if I remove the code of written the changes back to Neo4j, which is the last part of the code. However, this is the core function of this project.
Also, this written-back function worked properly by standing alone outside of Shiny. So the problem is the interaction between 2 parts.
I am wondering if I can add observeEvent in Shiny to solve this problem.
Thanks in advance.
As you said the last part of your code caused the problem. The reason behind is that you use reactives in this code chunk. That is you use input$category_rows_selected, input$category_status and input$status which do not have a fixed value but depend on your interaction with the app.
Depending on what you want to do you have basically 2 options:
Include the code chunk in isolate. In this case, however, your code will never be updated when you change the respective inputs.
Include the code chunk in observe. In this case whenever either of the inputs (as listed above) change its value, this code will be executed. If you want your code chunk to run only if some of the inputs change you can isolate the inputs you do not want to take a dependency on.
For instance this code will be executed whenever input$category_rows_selected or input$category_status change but not if input$status change because it is wrapped in isolate:
observe({
if(info$Category_Status[input$category_rows_selected] != input$category_status) {
category_num = as.numeric(substring(info$Category[input$category_rows_selected], 16))
updateProp(getOrCreateNode(graph, "Category",
Category = paste("CC_CCAA_AAC.0C-", category_num, sep="")),
status = isolate(input$status))
}
})
This is my first question on stackoverflow, and I've been using R for 3 months. I have a lot to learn! Any help is much appreciated. Thank you in advance for your time.
What I WANT to happen:
The user selects a category (Animals or Foods) from a drop-down box and clicks Next once. The appropriate ui component will render and display. Then the Next button should be disabled (grayed-out) whenever the right box of the Chooser Input component is empty. Only when the user has at least one selection in the right box, should Next button be enabled and the user may click it.
The PROBLEM: After the Chooser Input component is rendered, the right box is empty, but Next is NOT disabled. Here is the error:
Warning in run(timeoutMs) :
Unhandled error in observer: argument is of length zero
observeEvent(input$widget2)
Below are a demo ui.R and sever.R to recreate my problem. (However, I will be implementing the solution into a larger, more complex GUI.) The code uses shinyBS, so you will first need to install the package and load the library. The code also uses chooserInput, which requires two files: chooser.R and www/chooser-binding.js. See the following link for more information:
http://shiny.rstudio.com/gallery/custom-input-control.html
ui
### The following libraries need to be loaded BEFORE runApp()
### library(shiny)
### library(shinyBS)
source("chooser.R") # Used for Custom Input Control UI component (chooserInput)
# chooser.R is saved in the same location as the ui.R and server.R files
# chooserInput also requires chooser-binding JScript script file, which should be located within "www" folder
shinyUI(navbarPage("navbarPage Title",
tabPanel("tabPanel Title", titlePanel("titlePanel Title"),
fluidPage(
#### NEW ROW #####################################################################################################
fluidRow(wellPanel(
# Instructions for initial screen
conditionalPanel(condition = "input.ButtonNext == 0", tags$b("Step 1: Choose category and click 'Next'")),
# Instructions for 'Foods'
conditionalPanel(condition = "input.ButtonNext == 1 && input.widget1 == 'Foods'", tags$b("Step 2: Move Food(s) of interest to the right box and click 'Next'")),
# Instructions for 'Animals'
conditionalPanel(condition = "input.ButtonNext == 1 && input.widget1 == 'Animals'", tags$b("Step 2: Move Animals(s) of interest to the right box and click 'Next'"))
)),
#### NEW ROW #####################################################################################################
fluidRow(
# Drop down box for first selection
conditionalPanel(
condition = "input.ButtonNext == 0",
selectInput("widget1", label = "",
choices = c("Foods",
"Animals"))),
# This outputs the dynamic UI components based on first selection
uiOutput("ui1")
),
#### NEW ROW #####################################################################################################
fluidRow(tags$hr()), # Horizontal line separating input UI from "Next" button
#### NEW ROW #####################################################################################################
fluidRow(
column(1, offset=10,
# UI component for 'Next' button
conditionalPanel(condition = "input.ButtonNext < 2", bsButton("ButtonNext", "Next"))
),
column(1,
HTML("<a class='btn' href='/'>Restart</a>")
)
)
) # End of fluidPage
) # End of tabPanel
)) # End of navbarPage and ShinyUI
server
shinyServer(function(input, output, session) {
# Widget to display when number of clicks of "Next" button (ButtonNext) = 1
output$ui1 <- renderUI({
if(input$ButtonNext[1]==1) {
print("I am in renderUI") # Used to help debug
# Depending on the initial selection, generate a different UI component
switch(input$widget1,
"Foods" = chooserInput("widget2", "Available frobs", "Selected frobs", leftChoices=c("Apple", "Cheese", "Carrot"), rightChoices=c(), size = 5, multiple = TRUE),
"Animals" = chooserInput("widget2", "Available frobs", "Selected frobs", leftChoices=c("Lion", "Tiger", "Bear", "Wolverine"), rightChoices=c(), size = 5, multiple = TRUE)
)
}
}) # End of renderUI
# Disable "Next" button when right side of multi select input is empty
observeEvent(input$widget2, ({
widget2_right <- input$widget2[[2]]
print(widget2_right) # Used to help debug
if(widget2_right == character(0)) {
updateButton(session, "ButtonNext", disabled = TRUE)
} else {
updateButton(session, "ButtonNext", disabled = FALSE)
}
})) # End of observeEvent
}) # End of shinyServer
A similar question (link below) mentioned using Priorities and Resume/Suspend but no example was provided. If that is a valid solution to my problem, please provide some code.
R shiny Observe running Before loading of UI and this causes Null parameters
EXTRA NOTE: The code provided is a small demo recreated from a much larger GUI that I developed for the user to make a series of selections, clicking 'Next' between each selection. Depending on the selections they make each step, new choices are generated from a csv file. Therefore, the ui component that is rendered and displayed is dependent on how many times the user has clicked 'Next' and which selections they've previously made. In the end, the selections are used to sort a large data set so the user can plot only the data they are interested in. The dual conditions are why I used conditionalPanel and the VALUE of the actionButton to render and display the current ui component that the user needs. My code works (except for the problem above - HA!). However, I have read that it is poor coding practice to use the VALUE of an actionButton. If there are any suggestions for another method to handle the dual conditions, please let me know.
In server.R, I replaced
if(widget2_right == character(0))
with
if(length(widget2_right)==0)
and now the program works as I wanted it to.
When the right-box is empty, widget2_right = character(0). I learned that comparing vectors to character(0) results in logical(0), not TRUE or FALSE. However, length(character(0)) = 0. Therefore, if(length(widget2_right)==0) will be TRUE whenever no selections are in the right-box.