I am having an issue with the _row_last_clicked option provided for tables created in shiny interfaces with the rstudio DT library. I am trying to select a row in a datatable, make modifications to it and output it to the shiny ui.r. It works for the first-time selection, but when I again click on the same table row which I just selected previously, the _row_last_clicked seems to remain unresponsive (=NULL?). Here is a mininmal example (ui.r likely irrelevant) of what I am trying to achieve:
# server.r-side:
table_x<-# ... loads the dataframe
redo_cal<-reactiveValues()
redo_cal$a<-1
observe({
redo_cal$a
output$some_table <- DT::renderDataTable(
table_x,
server = TRUE, # same problem with FALSE
selection =c('single')
)
})
observeEvent(
input$some_table_row_last_clicked,{
s<-input$some_table_row_last_clicked
table_x[s,]<- # some reversible modifications based on the row selection ...
redo_cal$a<-(redo_cal$a+1) # trigger above renderDataTable
})
The issue persists for both the latest github version of DT as well as the release found on CRAN. I have read several related posts but couldn`t figure out a satisfying solution. Thank you very much for your help!
If i understand you right you need some_table_row_selected
and table_x(dd$d - in my example) be reactiveValues
See example where
# some reversible modifications based on the row selection == log of x
Every time you select row value of x in this row log-ed
library(shiny)
library(DT)
data=data.frame(x=1:10,y=2:11)
ui=shinyUI(
fluidPage(
DT::dataTableOutput("tt")
)
)
server=shinyServer(function(input, output) {
dd=reactiveValues(d=data)
output$tt=DT::renderDataTable(
datatable(
dd$d,selection =c('single')
)
)
observeEvent(input$tt_rows_selected,{
dd$d[input$tt_rows_selected,1]<-log(dd$d[input$tt_rows_selected,1])
})
})
shinyApp(ui,server)
In each session your data refreshed
PS
Best minimal example its something which anyone can copy\paste and test.
Related
In my shiny app, a user can select a row in a data table which will display information about the row. If the row is deselected, the information about the row will disappear.
On occasion, a row will be selected by proxy, which will trigger the same information about the row to be displayed. However, if the user clicks the row to deselect it, the row is still selected, even though it appears to be deselected. The information about the row does not disappear, and if you were to change something about the table (switch page and go back, change page length, etc.), the row is highlighted again, indicating it is still selected. Only after clicking it three times (phantom deselect, select, deselect) would the row truly be deselected.
This seems like it is an issue with the DT package, but I'm not sure. I'm using version 0.4 of DT and version 1.1.0 of shiny. Here is a reproducible example:
library(shiny)
library(DT)
ui <- fluidPage(
fluidRow(DTOutput("table")),
fluidRow(actionButton("select", "Select First Row by Proxy")),
fluidRow(textOutput("selected_row"))
)
server <- function(input, output, session) {
output$table <- renderDT({datatable(mtcars, selection = "single")})
observeEvent(input$select, {
selectRows(proxy = dataTableProxy("table"), selected = 1)
})
observeEvent(input$table_rows_selected, {
output$selected_row <- renderText(paste0("Row selected: ", input$table_rows_selected))
})
}
shinyApp(ui = ui, server = server)
This was resolved when I upgraded to the next version of the DT package.
Guys i am new to Shiny and here i am facing issue with R to shiny translation,
i am using SelectInput to give teacher_IDs as input to filter the corresponding students data on sever.r.
Data looks like this
upto here below code works fine.
library(shiny)
x <- fluidPage("this is fluid page",
selectInput("Selecter","slide to select",choices = ID$Teacher_ID,
selected = "1003935242" ),
tableOutput("data")
################### server.r #################
)
shinyServer(function(input, output)
output$data = renderTable({
TeachersData[TeachersData$Teacher_ID==input$Selecter,]
})
})
But here below when i add more code that actually calculates statistical values using anova,kruskal etc in RenderTable() block like below, i get error message
Error:All observations are in the same group
***, i tried to resolve by doing split and creating groups with factor and few other things but cant resolve.
there is no problem in the code, it seems problem manipulation of the data with shiny way.
############ server.r problematic ##########
shinyServer(function(input, output) {
output$data = renderTable({
Instro = TeachersData[TeachersData$Teacher_ID==input$Selecter,]
Data_Procedure1= Instro
Data_Procedure1$Score=as.numeric(as.character(Data_Procedure1$Score))
Data_Procedure1_ByCourse=Subset_Data_ByCourse_fct(Data_Procedure1)
ANOVA_Procedure1= Compare_ANOVA_Procedure1_fct(Data_Procedure1,
Data_Procedure1$Score, as.factor(Data_Procedure1$Course_ID), alpha)
p_Procedure1 = ANOVA_Procedure1$p_value
Method_Procedure1= ANOVA_Procedure1$test_name
PairWise_Compare_Procedure1=Pairwise_Comparison_fct(Method_Procedure1,
Data_Procedure1, Data_Procedure1$Score,
as.factor(Data_Procedure1$Course_ID ))
result <- as.data.frame(PairWise_Compare_Procedure1)
})
})
Error message
Please anyone help to figure out, Thank you so much.
First of all, is this 'ID$Teacher_ID' loading ok? Are the options showing up at the UI? Sometimes this may be a problem.
Secondly, if I understood your problem correctly, you should change this:
TeachersData[TeachersData$Teacher_ID==input$slide,]
to this:
TeachersData[TeachersData$Teacher_ID==input$Selecter,]
If that is not the issue, maybe you should show what is input$slide?
Thank you #Ricardo for helping out, but the problem was something else.
after further digging out, i found that there is problem with the data set. because when i was filtering the data then some Teacher_ID's in data were having single records and no further sub-grouping, that's was statistical model was unable to capture observations of those Teacher_ID's and throwing error of having all observations in the same group. so when after i filtered out this type data that is not statistically significant everything works fine now.
I have a use case where am visualizing operational data for a dashboard. I would like it to be such that the visualization is updated periodically as data is added to the database. The logic in my mind is to first check if the number of rows in the live database table is equal to the number of rows in the corresponding dataframe within R. If yes, then no need to pull data, if no, then pull data from database. What I want to avoid is to just pull data (actual database table has over 5 million rows) periodically regardless of whether there is new data or not.
I have created a subset of the data here. The code below I wrote as a proof of concept to first wrap my head around how invalidateLater() and reactiveValues() work in R and how I could possibly use them. It simply reads the number of rows in the database table and displays it to the user. If the number of rows changes, the user interface is updated with the new number of rows. Note that to reproduce you may want to put data into a database so you can simulate adding and deleting rows to see reaction of the "app". I used postgres, and an ODBC connection. If you run the code as-is, you will notice that when rows are added to the db, when the app is doing the checking, the user interface (textOutput() widget) grays out for a few seconds and appears to be in a state of meditation before eventually correctly displaying the new number of rows. This is using the code which first checks if there are differences in row numbers between database and value held in R.
However if I comment out that part of the code which check for differences (comment out the block below)
sharedValues$data <- if(!is.null(sharedValues$data)){
if(nrow(sqlFetch(conn2,"test2")) == sharedValues$data){
return(sharedValues$data)
}
}
else{
sharedValues$data <- nrow(sqlFetch(conn2,"test2"))
return(sharedValues$data)
}
and instead just pull data periodically regardless if there is a change or not (uncomment this line)
#sharedValues$data <- nrow(sqlFetch(conn2,"test2"))
the interface reacts superbly, there is no lag (graying out of the widget text) and the new row value is displayed on the user interface.
My question is what causes the "lag-like" behavior when running the first alternative (which is the desired alternative) of first checking for database changes before making an expensive database select query), yet when the code is amended to pull data regardless of database changes (which seems to me inefficient) this lag-like behavior rears its ugly head? The entire code is below:
library(shiny)
library(shinydashboard)
library(rCharts)
library(curl)
library(RODBC)
conn2 <- odbcConnect("postgres") # database connection object
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(textOutput("text1"),width = 6)
)
)
)
server <- function(input, output, session) {
sharedValues <<- reactiveValues()
observe({
invalidateLater(30000,session)
cat("updating data...\n")
sharedValues$data <- if(!is.null(sharedValues$data)){
if(nrow(sqlFetch(conn2,"test2")) == sharedValues$data){
return(sharedValues$data)
}
}
else{
sharedValues$data <- nrow(sqlFetch(conn2,"test2"))
return(sharedValues$data)
}
#sharedValues$data <- nrow(sqlFetch(conn2,"test2"))
})
output$text1 <- renderText({
y <- sharedValues$data
return(y)
})
}
shinyApp(ui, server)
Any help greatly appreciated.
According to this answer, this can be fixed by manipulating the CSS in ui.R
tags$style(type="text/css",
".recalculating { opacity: 1.0; }"
)
Note: After coming up with the answer I reworded the question to make if clearer.
Sometimes in a shiny app. I want to make use of a value selected by the user for a widget, as well as the previous value selected for that same widget. This could apply to reactive values derived from user input, where I want the old and the new value.
The problem is that if I try to save the value of a widget, then the variable containing that value has to be reactive or it will not update every time the widget changes. But, if I save the the value in a reactive context it will always give me the current value, not the previous one.
How can I save the previous value of a widget, but still have it update every time the user changes the widget?
Is there a way that does not require the use of an actionButton every time the user changes things? Avoiding an actionButton can be desirable with adding one is otherwise unnecessary and creates excess clicking for the user.
Seeing as the session flush event method seems to be broken for this purpose, here is an alternative way to do it using an observeEvent construct and a reactive variable.
library(shiny)
ui <- fluidPage(
h1("Memory"),
sidebarLayout(
sidebarPanel(
numericInput("val", "Next Value", 10)
),
mainPanel(
verbatimTextOutput("curval"),
verbatimTextOutput("lstval")
)
)
)
server <- function(input,output,session) {
rv <- reactiveValues(lstval=0,curval=0)
observeEvent(input$val, {rv$lstval <- rv$curval; rv$curval <- input$val})
curre <- reactive({req(input$val); input$val; rv$curval})
lstre <- reactive({req(input$val); input$val; rv$lstval})
output$curval <- renderPrint({sprintf("cur:%d",curre())})
output$lstval <- renderPrint({sprintf("lst:%d",lstre())})
}
options(shiny.reactlog = TRUE)
shinyApp(ui, server)
Yielding:
Update This answer was posted before the advent of the reactiveValues/observeEvent model in shiny. I think that #MikeWise 's answer is the better way to do this.
After some playing around this is what I came up with. The ui.r is nothing special
ui.r
library(shiny)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(inputId="XX", label="Choose a letter",choices=letters[1:5])
),
mainPanel(
textOutput("Current"),
textOutput("old")
)
)
))
"Current" will display the current selection and "old" displays the previous selection.
In the server.r I made use of three key functions: reactiveValues, isolate and session$onFlush.
server.r
library(shiny)
server <- function(input, output,session) {
Values<-reactiveValues(old="Start")
session$onFlush(once=FALSE, function(){
isolate({ Values$old<-input$XX })
})
output$Current <- renderText({paste("Current:",input$XX)})
output$old <- renderText({ paste("Old:",Values$old) })
}
The server.r works like this.
First, Values$old is created using the reactiveValues function. I gave it the value "Start" to make it clear what was happening on load up.
Then I added a session$onFlush function. Note that I have session as an argument in my server function. This will run every time that shiny flushes the reactive system - such as when the selectizeInput is changed by the user. What is important is that it will run before input$XX gets a new value - so the value has changed at the selectizeInput but not at XX.
Inside the session$onFlush I then assign the outgoing value of XX to Values$old. This is done inside an isolate() as this will prevent any problems with input$XX gets updated with the new values. I can then use input$XX and Values$old in the renderText() functions.
I am new to Shiny and trying to build a more accessible input and output for a function I built. I am giving this to people that don't run R so trying to build something that runs my functions in the background and then spits out the answer.
I am having some trouble getting everything in the way that I want it unfortunately and dealing with a bunch of errors. However, here is my more pointed question:
The actual function that I want to run takes a name (in quotations as "Last,First") and a number.
PredH("Last,First",650)
So I want a shiny application that takes a name input and a number input that then runs this program and then spits back out a data table with my answer. So a couple of questions.
How do I get it in the right form to input into my equation on the server side script, do I need to return it in the function so it can be accessed using a function$table type access? (Right now I am just printing using cat() function in the console for the function but know that may not be usable for this type of application.
I want to return a dataframe that can be gotten at PredH14$table. How do I go about building that shiny?
Here is my code so far:
UI:
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("Miles Per Gallon"),
# Sidebar with controls to select the variable to plot against mpg
# and to specify whether outliers should be included
sidebarPanel(
textInput("playername", "Player Name (Last,First):", "Patch,Trevor"),
radioButtons("type", "Type:",
list("Pitcher" = "P",
"Hitter" = "H"
)),
numericInput("PAIP", "PA/IP:", 550),
submitButton("Run Comparables")
),
mainPanel(
textOutput("name")
)
Server:
library(shiny)
shinyServer(function(input, output) {
sliderValues <- reactive({
data.frame(
Name = c("name", "PA"),
Value = c(as.character(playername),
PAIP),
stringsAsFactors=FALSE)
})
name=input[1,2]
PAIP=input[2,2]
testing <- function(name,PAIP){
a=paste(name,PAIP)
return(a) }
output$name=renderText(testing$a)
})
I am not quite sure I understood your question 100% but I clearly see you are wondering how to pass the input of the UI into the server and maybe, the other way back.
In your server code, clearly you are not getting any input from the UI. Basically you have created three input variables in your ui.R:
1. input$playername
2. input$type
3. input$PAIP
And one output:
1. output$name
Just let you know, the function sliderValues <- reactive(..) is called every time there is any input from the input... like people click the dropdown list or people modifies words in the text box.
You can even get started without the submit button just to get started. But the existence of the submit button actually makes everything easier. Create a submit button for an input form. Forms that include a submit button do not automatically update their outputs when inputs change, rather they wait until the user explicitly clicks the submit button.
So you can put your code in a way similar like this:
# server.R
library(shiny)
shinyServer(function(input, output) {
sliderValues <- reactive({
result <- ... input$playername ... input$type ... input$PAIP
return(result)
})
output$name <- renderPlot/renderText (... sliderValues...)
})
# ui.R
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Miles Per Gallon"),
sidebarPanel(
textInput("playername" ... ),
radioButtons("type" ... ),
numericInput("PAIP" ... ),
submitButton("...")
),
mainPanel(
textOutput/plotOutput...("name")
)
))
In the end, check out the shiny example that might be what you want.
library(shiny)
runExample('07_widgets')