I'm creating a table using renderTable but the HTML inside the table is not rendering:
This is the code snipit of interest:
if (is.null(Compare_Count) || is.na(Compare_Count) || length(Compare_Count) == 0L ) {
CT_Table[i, 3] <- HTML("<i class='icon-arrow-up'></i>")
} else if (CT_Table[i, 2] > Compare_Count) {
CT_Table[i, 3] <- print(tags$i(class='icon-arrow-up', style="text-color: green"), quote = FALSE)
}
Neither HTML, paste, or c work.
How can I get the arrows to show?
Thanks!
server.r: [Note, this is an example. The code is not complete, brackets may be mismatched, etc. Not important to the question.]
output$example <- renderTable(include.rownames=FALSE,{
CT_Table <- count(Canidates,vars=c("Name"))
CT_Table <- CT_Table[order(CT_Table["Recent Reviews: "], decreasing=T),]
for (i in 1:nrow(CT_Table)) {
Compare_Name <- paste(CT_Table$Product[i])
Compare_Count <- Can_trend[Can_trend$Name == Compare_Name, 2]
if (is.null(Compare_Count) || is.na(Compare_Count) || length(Compare_Count) == 0L )
{
CT_Table[i, 3] <- HTML("<i class='icon-arrow-up'></i>")
} else if (CT_Table[i, 2] > Compare_Count) {
CT_Table[i, 3] <- tags$i(class='icon-arrow-up', style="text-color: green")
} else if (CT_Table[i, 2] < Compare_Count) {
CT_Table[i, 3] <- tags$i(class='icon-arrow-down', style="text-color: red")
} else if (CT_Table[i, 2] == Compare_Count) {
CT_Table[i, 3] <- tags$i(class='icon-minus', style="text-color: yellow")
}
}
}
CT_Table
})
ui.r is just a simple call to tableOutput or htmlOutput, but neither renders the html pasted into the column.
This was fixed with sanitize.text.function = function(x) x;
it needs to be included like this:
output$example <- renderTable({
table <- someTable_Data_here
table
}, sanitize.text.function = function(x) x)
This is the gist here
also, a note,
I have noticed that you can call xtable inside the renderTable function, and it will properly render the table.
BUT you should note that options you pass to xtable have no effect! Instead you need to pass those options to the 'renderTable' function.
so if you want to call this:
output$example <- renderTable({
table <- someTable_Data_here
xtable(table, align=c("llr"))
}, sanitize.text.function = function(x) x)
what you need to do is:
output$example <- renderTable({
table <- someTable_Data_here
table
},align=c("llr"), sanitize.text.function = function(x) x)
The RStudio team and the RShiny guys are awesome. I'm sure a ton of the documentation is still being written, and I hope this helps someone in the mean time.
Related
I am in my server.r file and trying to create an output via renderText with a conditional statement. The below code is throwing me the error:
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.)```
I have a feeling I have the architecture of this code wrong.
if (A > B)
{
output$sample <- renderText({ do some calculation)})
}
else if(A <= B)
{
output$sample <- renderText({do some other calculation)})
}
I have attempted to reformat to the below but get the same error. I feel I may be fundamentally wrong in my approach here. Any help welcomed.
output$sample <-
if (A > B)
{
renderText({ do some calculation)})
}
else if(A <= B)
{
renderText({do some other calculation)})
}
Server part where the issue was has been resolved here with some reactive objects. Please try this
ab <- reactive({req(input$account_value) - req(input$blocked_funds)})
# free funds
output$free_funds <- renderText({ab()})
# current margin
cm <- reactive({
req(input$account_value,input$blocked_funds)
if (input$account_value > input$blocked_funds){
curmargin <- round(input$account_value/(input$account_value+input$blocked_funds), digits = 2)
}else {
curmargin <- round((.5*(input$account_value))/input$blocked_funds, digits = 2)
}
})
output$current_margin <- renderText({cm()})
rm <- reactive({
req(input$account_value,input$blocked_funds)
round(input$account_value/(input$account_value + input$blocked_funds*2.5)*100,digits = 1)
})
# New margin
output$revised_margin <- renderText({
paste(rm(),"%",sep = "")
})
I am trying to render a Data table in R shiny on selected inputs but getting an error:-
output$reconOutput <- renderUI({
reconOutput <- sort(unique(as.vector(my_data$ReconIdName)), decreasing = FALSE)
reconOutput <- append(reconOutput, "All", after = 0)
selectizeInput("reconchoose", "Recon:", reconOutput)
})
output$statusOutput <- renderUI({
statusOutput <- sort(unique(as.vector(my_data$Status)), decreasing = FALSE)
statusOutput <- append(statusOutput, "All", 0)
selectizeInput("statuschoose", "Status:", statusOutput)
})
output$issuesbyReconName<- renderDataTable(
data <- reactive({
req(input$reconchoose)
req(input$statuschoose)
if(input$reconchoose == "All") {
filt1 <- quote(recon != "#?><")
} else {
filt1 <- quote(recon == input$reconchoose)
}
if (input$statuschoose == "All") {
filt2 <- quote(status != "#?><")
} else {
filt2 <- quote(status== input$statuschoose)
}
raw %>%
filter_(filt1) %>%
filter_(filt2)
})
)
Could you please guide me on this?
output$issuesbyReconName
1: shiny::runApp
Warning: Error in if: missing value where TRUE/FALSE needed
Is it related to any null value in columns that is creating a conflict in the code?
Can you share your input side code as well? It looks like it might be caused by there being no default value for some of the input objects, leading to the error.
Try either to set a default value for these objects or start the IF series with something like
if (is.na(input$reconchoose)) return("") else
In the example below, I have 3 DT::datatables. I want the user to be able to select no more than one row from all these tables. I thence use dataTableProxy and selectRow, as per the section "Manipulate An Existing DataTables Instance" in the documentation. It works fine.
However, in my application, I have 24 (call that value N) tables. If I try to adapt the code below to my 24 tables page, I get an horrendous number of lines of code.
What is a smarter way of doing this?
In particular, how can I:
declare the observers dynamically? (answered by user5029763)
know which table (not row) has been clicked upon last? (ie. how to re write reactiveText()?)
EDIT : I copied in user5029763's answer (see below) in the code below.
DTWrapper <- function(data, pl = 5, preselec = c()){
datatable(data,
options = list(pageLength = pl, dom='t',ordering=F),
selection = list(mode = 'single', selected= preselec),
rownames = FALSE)
}
resetRows <- function(proxies, self){
for (i in 1:length(proxies)){
if (self != i){
proxies[[i]] %>% selectRows(NULL)
}
}
}
lapply(1:3, function(id) {
observe({
rownum <- input[[paste0("tab",id,"_rows_selected")]]
if (length(rownum) > 0) { resetRows(proxyList(), id) }
})
})
server = function(input, output) {
output$tab1 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop))
output$tab2 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop))
output$tab3 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop))
proxyList <- reactive({
proxies = list()
for (i in 1:3){
tableID <- paste("tab", i, sep="")
proxies[[i]] = dataTableProxy(tableID)
}
return(proxies)
})
reactiveText <- reactive({
rownum1 <- input$tab1_rows_selected
rownum2 <- input$tab2_rows_selected
rownum3 <- input$tab3_rows_selected
if (length(rownum1) > 0){return(c(rownum1, 1))}
if (length(rownum2) > 0){return(c(rownum2, 2))}
if (length(rownum3) > 0){return(c(rownum3, 3))}
})
output$txt1 <- renderText({
paste("You selected row ", reactiveText()[1]
, " from table ", reactiveText()[2], ".", sep="")
})
}
shinyApp(
ui = fluidPage(
fluidRow(column(4,DT::dataTableOutput("tab1"))
, column(4,DT::dataTableOutput("tab2"))
, column(4, DT::dataTableOutput("tab3")))
,fluidRow(column(4,textOutput("txt1")))
),
server = server
)
The textOutput is: "You selected the Xth row from the Yth table".
After edit:
You could try modules. Another way would be a lapply.
lapply(1:3, function(id) {
observe({
rownum <- input[[paste0("tab",id,"_rows_selected")]]
if (length(rownum) > 0) {
resetRows(proxyList(), id)
msg <- paste0("You selected row ", rownum, ", from table ", id, ".")
output$txt1 <- renderText(msg)
}
})
})
Edited to add reproducible code
I am building a Shiny app and encountered a problem with a while loop inside an observe function. The program does not display the reactive values after while loop. Here is the relevant code snippets from ui.r and server.r
ui.r
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
textAreaInput("inText", label = "Enter text", rows = 3),
submitButton("Predict")
),
mainPanel(
textOutput("outText"),
textOutput("outCount"),
textOutput("outPred")
)
)
))
Server.r
library(shiny)
library(stringr)
predict <- function(term)
{
if(term == 3)
table <- list()
else
if(term == 0)
table <- c("input","text","empty")
else
table <- c("words","were","found")
return(table)
}
shinyServer(
function(input, output) {
state <- reactiveValues()
observe({
state$inText <- input$inText
state$wcount <- sapply(gregexpr("[[:alpha:]]+", state$inText), function(x) sum(x > 0))
if( state$wcount > 2)
term.c <- 3
else
if( state$wcount == 2)
term.c <- 2
else
if( state$wcount == 1)
term.c <- 1
else
term.c <- 0
cont <- TRUE
while(cont == TRUE) {
if(term.c == 3) {
state$predList <- predict(term.c)
if(length(state$predList) > 0) break
else term.c <- 2
}
if(term.c == 2) {
state$predList <- predict(term.c)
if(length(state$predList) > 0) break
else term.c <- 1
}
if(term.c == 1) {
state$predList <- predict(term.c)
if(length(state$predList) > 0) break
else term.c <- 0
}
if(term.c == 0) {
state$predList <- c("Did", "not", "find", "term")
break
}
}
})
output$outText <- renderPrint({ input$inText })
output$outCount <- renderPrint({ sapply(gregexpr("[[:alpha:]]+", input$inText), function(x) sum(x > 0)) })
output$outPred <- renderPrint({ state$predList })
}
)
Enter two words and the values are displayed properly. Enter three words and an empty list is returned to state$predList which will give it a 0 length. the program should then execute the second if statement and populate state$predList with a non-zero length list. this happens but the display is never refreshed and the program goes into an infinite loop. It jumps to the first line of the observe function and continues in an infinite loop. I see this when I add browser().
Am I not using the reactive values correctly? Thanks for any assistance.
I am trying to write a Shiny app for a class I'm teaching that draws a random sample from a dataset and computes summary statistics. Whenever I press the reset button on the UI, a new subset should be sampled. Here is my code so far:
shinyServer(function(input, output) {
# Output for Ch. 1 Problems: Central Tendency
# Prepare data
observeEvent(input$Ch1.Prob.CT.reset, {
Ch1.Prob.CT.n <- sample(8:12, 1)
Ch1.Prob.CT.obs <- sample(1:nrow(cars), Ch1.Prob.CT.n)
})
data <- eventReactive(input$Ch1.Prob.CT.reset, {
cars[Ch1.Prob.CT.obs, 'dist', drop=F]
})
# Outputs
output$Ch1.Prob.CT.Data <- renderDataTable({
data()
})
output$Ch1.Prob.CT.Mean.out <- renderUI({
if (is.na(input$Ch1.Prob.CT.Mean.in)) { # Error checking
p("No answer provided")
} else if (round(input$Ch1.Prob.CT.Mean.in, digits = 4) == round(mean(Ch1.Prob.CT.data[,1]), digits = 4)) {
p("Correct", style = "color:green")
} else {
p("Incorrect", style = "color:red")
}
})
})
The problem is that the sample is not random; it is always the same, every time. Even when I press the reset button, the sample is exactly the same as the one before.
Why is Shiny not randomizing? And how can I make it randomize again?
Add a line such as
set.seed(as.integer(Sys.time()))
before you need random numbers
Such code:
observeEvent(input$xxx, {
x <- ...
})
f <- eventReactive(input$xxx, {
[do something with x]
})
does not work.
You can simply remove the observer and do:
f <- eventReactive(input$xxx, {
x <- ...
[do something with x]
})
If you want to use a variable subject to modifications inside an observer, you have to use a reactive list, like this :
values <- reactiveValues()
values$x <- [initial value of x]
observeEvent(input$xxx, {
values$x <- ...
})
(In addition, don't use some dots (.) in the names of the shiny elements.)