Hello and thanks for reading me. I am working on a small app that shows a table in shiny with the "reactable" library, but I would like to obtain a reactive value when I click on a certain cell, with which I can get a text output type "paste0("you chose" , value0)", but so far I haven't found a correct way to do it. Does anyone have any idea how to do that
The actual code im using is:
shinyApp(
ui = fluidPage(
reactableOutput("tabla")
),
server = function(input, output){
output$tabla <- renderReactable({
iris |>
reactable(
columns = list(
Species = colDef(cell = function(value) {
htmltools::tags$a(href = value, target = "_blank", value)
})
)
)
})
}
)
library(shiny)
library(reactable)
shinyApp(
ui = fluidPage(
reactableOutput("tabla"),
verbatimTextOutput("selected")
),
server = function(input, output){
output$tabla <- renderReactable({
iris |>
reactable(
columns = list(
Species = colDef(cell = function(value) {
htmltools::tags$a(href = value, target = "_blank", value)
})
),
selection = "single", onClick = "select"
)
})
value0 <- reactive({
getReactableState("tabla", "selected")
})
output$selected <- renderPrint({
req(value0())
print(paste("you chose" , value0()))
})
}
)
Read more here
Related
I am trying to get the table row information (such as row name. number, or cell value) when I click the lineup table, but I don;t know how. Can someonle help with it? Any input will be greatly appreciated.
The following is my sample code to show the problem
library(shiny)
library(crosstalk)
library(lineupjs)
library(magrittr)
ui <- fluidPage(
splitLayout(
column(12,
lineupOutput("table1", height=300),
textInput("val1", "Value1", "Tobeupdated1")
),
column(12,
DT::dataTableOutput("table2"),
textInput("val2", "Value2", "Tobeupdated2")
)
)
)
server <- function(input, output,session) {
dfshow <- head(iris,n=5)
shared_iris <- SharedData$new(dfshow)
t<-1
output$table1 <- renderLineup({
lineup(shared_iris)
})
output$table2<- DT::renderDT(dfshow, selection = 'single', rownames = FALSE, editable = TRUE)
observeEvent(input$table1_rows_selected,{
rowIndex <- input$table1_rows_selected
updateTextInput(session, "val1", value = as.character(input$table1_rows_selected))
})
observeEvent(input$table2_rows_selected,{
rowIndex <- input$table2_rows_selected
updateTextInput(session, "val2", value = as.character(input$table2_rows_selected))
})
}
shinyApp(ui = ui, server = server)
What I want is when I click the lineup table1, I want to update the value below the table1, like as the one on the right. Thanks.
It's hidden in the shared_iris$selection() method.
Do something like this:
library(shiny)
library(crosstalk)
library(lineupjs)
library(magrittr)
ui <- fluidPage(
splitLayout(
column(12,
lineupOutput("table1", height=300),
textInput("val1", "Value1", "Tobeupdated1")
),
column(12,
DT::dataTableOutput("table2"),
textInput("val2", "Value2", "Tobeupdated2")
)
)
)
server <- function(input, output,session) {
dfshow <- head(iris,n=5)
shared_iris <- SharedData$new(dfshow)
t<-1
output$table1 <- renderLineup({
lineup(shared_iris)
})
output$table2<- DT::renderDT(dfshow, selection = 'single', rownames = FALSE, editable = TRUE)
observeEvent(shared_iris$selection(),{
rowIndex <- which(shared_iris$selection())
updateTextInput(session, "val1", value = as.character(rowIndex))
})
observeEvent(input$table2_rows_selected,{
rowIndex <- input$table2_rows_selected
updateTextInput(session, "val2", value = as.character(input$table2_rows_selected))
})
}
shinyApp(ui = ui, server = server)
I have an app, which fetches data from an SQL-db, then allows the user to edit it, and this should be saved to the DB. In the repex I have used a CSV-file, but the logic should still be comparable.
However, the data is saved in the session once I edit the column value, but if I switch input or close the app and re-open, it's back to the original. Edits are not reflected in the summary table. What am I doing wrong?
# Load libraries
library(DT)
library(gt)
library(shiny)
library(shinydashboard)
library(dplyr)
# Load data (run once for replication; in real use case will be a DB-connection)
#gtcars_tbl <- gtcars
#write.csv(gtcars_tbl, "gtcars_tbl.csv", row.names = FALSE)
# Simple UI
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Summary table", tabName = "summary", icon = icon("project-diagram")),
menuItem("Edit table", tabName = "edit", icon = icon("project-diagram")),
uiOutput("country")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "summary",
h2("Summary of GT Cars"),
gt_output(outputId = "gt_filt_tbl")
),
tabItem(tabName = "edit",
h2("Editer GT Cars"),
DTOutput("edit")
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "GT Cars"),
sidebar,
body)
# Define server functions
server <- function(input, output, session) {
# Load data
gtcars_tbl <- read.csv("gtcars_tbl.csv")
countries <- sort(as.vector(unique(gtcars_tbl$ctry_origin)))
# Create dropdown output
output$country <- renderUI({
selectInput("country", "Country", countries)
})
# Create reactive table
gt_tbl_react <- reactiveVal(NULL)
gt_tbl_react(gtcars_tbl)
# Create filtered table
gt_filt_tbl <- reactive({
req(input$country)
gt_tbl_react() %>%
filter(ctry_origin == input$country)
})
# Render summary table
output$gt_filt_tbl <- render_gt({
gt_filt_tbl() %>%
group_by(ctry_origin, mfr) %>%
summarise(
N = n(),
Avg_HP = mean(hp),
MSRP = mean(msrp)
) %>%
gt(
rowname_col = "ctry_origin",
groupname_col = "mfr")
})
# Render editable table
output$edit <- renderDT(
gt_tbl_react() %>%
filter(ctry_origin == input$country),
selection = 'none', editable = TRUE,
rownames = TRUE,
extensions = 'Buttons'
)
observeEvent(input$edit_cell_edit, {
gtcars_tbl[input$edit_cell_edit$row,input$edit_cell_edit$col] <<- input$edit_cell_edit$value
write.csv(gtcars_tbl, "gtcars_tbl.csv", row.names = FALSE)
})
}
# Run app
shinyApp(ui, server)
The issue is that input$edit_cell_edit$row and input$edit_cell_edit$col are provided according to the subsetted dataframe that is displayed whereas you are changing the values on complete dataframe.
Use this in observeEvent -
observeEvent(input$edit_cell_edit, {
inds <- which(gtcars_tbl$ctry_origin == input$country)
gtcars_tbl[inds[input$edit_cell_edit$row],input$edit_cell_edit$col] <- input$edit_cell_edit$value
write.csv(gtcars_tbl, "gtcars_tbl.csv", row.names = FALSE)
})
I have an R shiny app with a DT datatable that is rendered using the datatable function in order to set various options. I would like to use dataTableProxy and replaceData to update the data in the table, but all the examples I can find assume the DT is rendered directly from the data object, not using the datatable function. The reprex below shows what I would like to do, but replaceData doesn't work in this pattern. How do I do this? Thanks.
# based on
# https://community.rstudio.com/t/reorder-data-table-with-seleceted-rows-first/4254
library(shiny)
library(DT)
ui = fluidPage(
actionButton("button1", "Randomize"),
fluidRow(
column(6,
h4("Works"),
DT::dataTableOutput('table1', width="90%")),
column(6,
h4("Doesn't Work"),
DT::dataTableOutput('table2', width="90%"))
)
)
server = function(input, output, session) {
my <- reactiveValues(data = iris)
output$table1 <- DT::renderDataTable(isolate(my$data))
output$table2 <- DT::renderDataTable({
DT::datatable(isolate(my$data),
options = list(lengthChange=FALSE, ordering=FALSE, searching=FALSE,
columnDefs=list(list(className='dt-center', targets="_all")),
stateSave=TRUE, info=FALSE),
class = "nowrap cell-border hover stripe",
rownames = FALSE,
editable = FALSE
) %>%
DT::formatStyle('Sepal.Width', `text-align`="center")
})
observeEvent(input$button1, {
# calculate new row order
row_order <- sample(1:nrow(my$data))
my$data <- my$data[row_order, ]
proxy1 <- DT::dataTableProxy('table1')
DT::replaceData(proxy1, my$data)
proxy2 <- DT::dataTableProxy('table2')
DT::replaceData(proxy2, my$data)
})
}
shinyApp(ui, server)
Update: Very strangely, removing rownames = FALSE made it all possible. I'm not exactly sure why, but probably rownames might be essential for replacing Data.
# based on
# https://community.rstudio.com/t/reorder-data-table-with-seleceted-rows-first/4254
library(shiny)
library(DT)
ui = fluidPage(
actionButton("button1", "Randomize"),
fluidRow(
column(6,
h4("Works"),
DT::dataTableOutput('table1', width="90%")),
column(6,
h4("Doesn't Work"),
DT::dataTableOutput('table2', width="90%"))
)
)
server = function(input, output, session) {
my <- reactiveValues(data = iris)
output$table1 <- DT::renderDataTable(isolate(my$data))
output$table2 <- DT::renderDataTable({
DT::datatable(isolate(my$data),
options = list(lengthChange=FALSE, ordering=FALSE, searching=FALSE,
columnDefs=list(list(className='dt-center', targets="_all")),
stateSave=TRUE, info=FALSE),
class = "nowrap cell-border hover stripe",
# rownames = FALSE,
editable = FALSE
) %>%
DT::formatStyle('Sepal.Width', `text-align`="center")
})
observeEvent(input$button1, {
# calculate new row order
row_order <- sample(1:nrow(my$data))
my$data <- my$data[row_order, ]
proxy1 <- DT::dataTableProxy('table1')
DT::replaceData(proxy1, my$data)
proxy2 <- DT::dataTableProxy('table2')
DT::replaceData(proxy2, my$data)
})
}
shinyApp(ui, server)
I am new to the shiny, I would like to edit different multiple data frames by radio button or selectinput by using rhandsontable package. However, my script can not show other data frame but only the first one, I don't know what is the problem.
ui.R:
library(rhandsontable)
fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("select2", label = h3("Choose to edit"),
choices = list("003.csv", "004.csv", "005.csv",
"006.csv", "007.csv"),
selected = "003.csv"),
actionButton("saveBtn", "Save changes")
),
mainPanel(
rHandsontableOutput("hot")
)))
server.R
values <- reactiveValues()
setHot <- function(x) values[["hot"]] <<- x
function(input, output, session) {
fname <- reactive({
x <- input$select2
return(x)
})
observe({
input$saveBtn # update csv file each time the button is pressed
if (!is.null(values[["hot"]])) {
write.csv(x = values[["hot"]], file = fname(), row.names = FALSE)
}
})
output$hot <- renderRHandsontable({
if (!is.null(input$hot)) { # if there is an rhot user input...
DF <- hot_to_r(input$hot) # convert rhandsontable data to R object
and store in data frame
setHot(DF) # set the rhandsontable values
} else {
DF <- read.csv(fname(), stringsAsFactors = FALSE) # else pull table from the csv (default)
setHot(DF) # set the rhandsontable values
}
rhandsontable(DF) %>% # actual rhandsontable object
hot_table(highlightCol = TRUE, highlightRow = TRUE, readOnly = TRUE) %>%
hot_col("Status", readOnly = FALSE)
})}
I can edit and save the dataframe that it shows the first one 003.csv, however when i use the drop down list to 004.csv, it didn't show the dataframe. please advise.
This will write (and possibly overwrite ⚠ any existing file with) dummy data:
for (i in c("003.csv", "004.csv", "005.csv", "006.csv", "007.csv")) {
write.csv(cbind(V1 = rep(i, 3), Status = "foo"), i, row.names = FALSE)
}
I overhauled server a bit:
library(shiny)
library(rhandsontable)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(
"select2", label = h3("Choose to edit"), selected = "003.csv",
choices = list("003.csv", "004.csv", "005.csv", "006.csv", "007.csv")
),
actionButton("saveBtn", "Save changes")
),
mainPanel(
rHandsontableOutput("hot")
)
)
)
server <- function(input, output, session) {
DF <- reactiveVal()
observe({
DF(read.csv(input$select2, stringsAsFactors = FALSE))
})
observe({
if (!is.null(input$hot)) DF(hot_to_r(input$hot))
})
observeEvent(input$saveBtn, {
if (!is.null(DF())) write.csv(DF(), input$select2, row.names = FALSE)
})
output$hot <- renderRHandsontable({
rhandsontable(DF()) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, readOnly = TRUE) %>%
hot_col("Status", readOnly = FALSE)
})
}
shinyApp(ui, server)
I am new to using DT in R shiny.Basically what i am trying to do here is to use the select value from the first table to filter the second table.
my Ui.r is
library(shiny)
library(shinydashboard)
ui <- dashboardPage(skin="green",
dashboardHeader(title="Inventory Management"),
dashboardSidebar(disable = TRUE),
dashboardBody(fluidRow(column(4,box(status="success",
uiOutput("Firstselection"),
br(),
uiOutput("Secondselection"))
),
column(4,infoBoxOutput("salesbox")),
column(4,infoBoxOutput("Runoutbox")),
column(4,infoBoxOutput("Excessbox"))),
actionButton("actionbtn","Run"),
fluidRow(tabBox(tabPanel(
DT::dataTableOutput(outputId="table"),title = "Stock Available for the category chosen",width = 12),
tabPanel(DT::dataTableOutput(outputId="asso"),title = "Associated products",width = 12)))
))
and my server is
server <-function(input, output, session) {
observeEvent(input$actionbtn, {source('global.r',local = TRUE)
#choose sub category based on category
output$Firstselection<-renderUI({selectInput("ray",
"Category:",
c("All",unique(as.character(bestpred$lib_ray))))})
output$Secondselection<-renderUI({selectInput("sray",
"Sub Category:",
c("All",unique(as.character(bestpred[bestpred$lib_ray==input$ray,"lib_sray"]))))})
# Filter data based on selections
output$table <- DT::renderDataTable({
data <- bestpred
if (input$ray != "All"){
data <- data[data$lib_ray == input$ray,]
}
if (input$sray != "All"){
data <- data[data$lib_sray == input$sray,]
}
data
},filter="top"
)
output$salesbox<-renderInfoBox({infoBox("Total Sales",sum(data()$Total_Sales),icon = icon("line-chart"))})
output$Runoutbox<-renderInfoBox({infoBox("Total Runout",sum(data()$status=="Runout"),icon = icon("battery-quarter"))})
output$Excessbox<-renderInfoBox({infoBox("Total excess",sum(data()$status=="Excess"),icon = icon("exclamation-triangle"))})
output$asso <- DT::renderDataTable({
asso <- test1
s=data[input$tablatable_rows_selected,1]
asso <- asso[asso$num_art == s,]
asso
},filter="top")
})}
So when i select a row in the output table i wanna use that as an filter for my asso table
this code dosent poup any error but the output table asso is always empty
Find a generalized solution in the following:
Adapted from here: https://yihui.shinyapps.io/DT-rows/
library(shiny)
library(DT)
server <- shinyServer(function(input, output, session) {
output$x1 = DT::renderDataTable(cars, server = FALSE)
output$x2 = DT::renderDataTable({
sel <- input$x1_rows_selected
if(length(cars)){
cars[sel, ]
}
}, server = FALSE)
})
ui <- fluidPage(
fluidRow(
column(6, DT::dataTableOutput('x1')),
column(6, DT::dataTableOutput('x2'))
)
)
shinyApp(ui, server)