Use selection from gvisTable in shiny - r

Quick question: How is it possible to use/get the selection of a gvisTable in shiny?
I can achieve this with the DT package like this:
library(DT)
library(shiny)
server <- function(input, output) {
output$dt <- renderDataTable({
datatable(cbind(c(1,2,3,4,5),c(5,4,3,2,1)))
})
output$dtselect <- renderText({
input$dt_rows_selected
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
"Selected Rows from Datatable in Text Output"
),
mainPanel(dataTableOutput("dt"),
textOutput("dtselect"))
)
)
shinyApp(ui = ui, server = server)
Is it possible to get the same selection with gvis? I googled a lot but could not find somebody reproducing the same in shiny.

You can add a listenerto the options and bind it to a variable called text as I did
rm(list = ls())
library(shiny)
library(googleVis)
mydata <- as.data.frame(cbind(c(1,2,3,4,5),c(5,4,3,2,1)))
server <- function(input, output) {
output$myTable <- renderGvis({
gvisTable(mydata, chartid = "mydata",
options = list(gvis.listener.jscode = "var text = data.getValue(chart.getSelection()[0].row,0);Shiny.onInputChange('text', text.toString());"))})
output$dtselect <- renderText({input$text})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
"Selected Rows from Datatable in Text Output"
),
mainPanel(htmlOutput("myTable"),textOutput("dtselect"))
)
)
shinyApp(ui = ui, server = server)

Variant to handle multiple selection (as told here )
library(googleVis)
library(shiny)
mydata <- as.data.frame(cbind(c(1,2,3,4,5),c(5,4,3,2,1)))
shinyApp(
ui = fluidPage(
htmlOutput("myTable")
)
,
server = function(input,output){
observe({
print(input$r_select)
})
output$myTable <- renderGvis({
gt= gvisTable(mydata,chartid="mydata")
jsInsert ="
google.visualization.events.addListener(chart, 'select', selectHandler);
var selectedRows = new Array();
function selectHandler() {
var selection = chart.getSelection();
for (var idx in selection){
var item = selection[idx];
if (item) {
i = selectedRows.indexOf(item.row);
if (i == -1){
selectedRows.push(item.row);
data.setProperty(item.row, 0,'style','background-color:#d6e9f8;');
data.setProperty(item.row, 1,'style','background-color:#d6e9f8;');
} else {
selectedRows.splice(i,1);
data.setProperty(item.row,0,'style',null);
data.setProperty(item.row,1,'style',null);
}
}
}
chart.setSelection(null);
Shiny.onInputChange('r_select',selectedRows);
chart.draw(data,options);
}
chart.draw(data,options);
"
gt$html$chart[['jsDrawChart']] <- gsub("chart.draw\\(data,options\\);", jsInsert, gt$html$chart[['jsDrawChart']])
gt
})
}
)
Print values of selected rows in observe.
Indexing start from 0

Related

How to store inputed table shiny

I have this shiny app. The main aim is to upload excel sheet with data and plot some graphs in tabs. User is able to select a sheet to make the graph. The seet will render to observe the selected data. This works well.
But I am struggling to manipulate with input data to make the graph.
I tried to use reactive value named data and then make the graph from that. I am quite new with shiny apps.
library(shiny)
library(readxl)
library(dplyr)
library(tidyverse)
library(lubridate)
ui <- fluidPage(
titlePanel("OTD project update"),
sidebarPanel(
fileInput('file1', 'Insert File', accept = c(".xlsx")),
textInput('file1sheet','Name of Sheet (Case-Sensitive)')),
mainPanel(tabsetPanel(
type = "tabs",
tabPanel("Data", tableOutput("value")),
tabPanel("OTD", plotOutput("OTD"))
)
)
)
server <- function(input, output) {
sheets_name <- reactive({
if (!is.null(input$file1)) {
return(excel_sheets(path = input$file1$datapath))
} else {
return(NULL)
}
})
output$value <- renderTable({
if (!is.null(input$file1) &&
(input$file1sheet %in% sheets_name())) {
return(read_excel(input$file1$datapath,
sheet = input$file1sheet))
} else {
return(NULL)
}
})
data <- reactive({
if (!is.null(input$file1) &&
(input$file1sheet %in% sheets_name())) {
return(read_excel(input$datapath,
sheet = input$file1sheet))
} else {
return(NULL)
}
})
}
shinyApp(ui, server)
It may be better to use the sheet names in radio buttons to pick instead of typing it. Also, there was a typo. Try this
library(shiny)
library(readxl)
library(dplyr)
library(tidyverse)
library(lubridate)
library(DT)
ui <- fluidPage(
titlePanel("OTD project update"),
sidebarPanel(
fileInput('file1', 'Insert File', accept = c(".xlsx")),
#textInput('file1sheet','Name of Sheet (Case-Sensitive)')
uiOutput("sheet")
),
mainPanel(tabsetPanel(
type = "tabs",
tabPanel("Data", DTOutput("table")),
tabPanel("OTD", plotOutput("plot"))
)
)
)
server <- function(input, output) {
sheets_name <- reactive({
if (!is.null(input$file1)) {
return(excel_sheets(path = input$file1$datapath))
} else {
return(NULL)
}
})
data <- reactive({
req(sheets_name())
if (!is.null(input$file1)) {
return(read_excel(input$file1$datapath, sheet = input$mysheet))
} else {
return(NULL)
}
})
output$sheet <- renderUI({
req(sheets_name())
radioButtons("mysheet", "Select a Sheet", choices = sheets_name())
})
output$table <- renderDT(data())
output$plot <- renderPlot({plot(cars)})
}
shinyApp(ui, server)

Delete the row in DT table shiny

I am trying to delete the row in the table below but not able to . Can anyone please guide me here.
The row should get deleted when the user selects the row and then clicks on action button
library(shiny)
library(httr)
library(jsonlite)
library(readxl)
library(DT)
library(glue)
ui <- fluidPage({
au <- read_excel("au.xlsx")
au <- as.data.frame(au)
df <- reactiveValues(asd = NULL)
mainPanel(
dataTableOutput("ir"),
actionButton("ac", "ac")
)
})
server <- function(input, output, session) {
output$ir <- renderDataTable({
df$asd <- head(iris)
datatable(df$asd)
})
observeEvent(input$ac,{
# browser()
df$asd <- df$asd[-c(as.numeric(input$ir_rows_selected)),]
})
}
shinyApp(ui, server)
Here is the way using a Shiny button:
library(shiny)
library(DT)
ui <- fluidPage(
actionButton("delete", "Delete selected row"),
br(),
DTOutput("tbl")
)
server <- function(input, output, session){
output[["tbl"]] <- renderDT({
datatable(iris[1:5,],
callback = JS(c(
"$('#delete').on('click', function(){",
" table.rows('.selected').remove().draw();",
"});"
))
)
}, server = FALSE)
}
shinyApp(ui, server)
And here is the way using a button integrated in the DT table:
library(shiny)
library(DT)
ui <- fluidPage(
br(),
DTOutput("tbl")
)
server <- function(input, output, session){
output[["tbl"]] <- renderDT({
datatable(iris[1:5,],
extensions = 'Buttons',
options = list(
dom = 'Bfrtip',
buttons = list(
list(
extend = "collection",
text = "Delete selected row",
action = DT::JS(c(
"function ( e, dt, node, config ) {",
" dt.rows('.selected').remove().draw();",
"}"))
)
)
)
)
}, server = FALSE)
}
shinyApp(ui, server)
With these methods, the table is not re-rendered when the row is deleted.

Output more than 1 datatables in shiny main panel

I have a shiny app that a user can check whether they want the data table displayed in the main panel. Depending on the numericinput, if they select 1, only 1 datatable be displayed or if they select 2 it will display 2 datatables I am not so sure how to code this in shiny R since I am new to this. Thank you for looking into this.
Here is my code
library("shiny")
df1 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df1<-rbind(df1,setNames(as.list(c(10,20,30,40)), names(df2)))
df2 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df2<-rbind(df2,setNames(as.list(c(100,200,300,400)), names(df2)))
df3 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df3<-rbind(df3,setNames(as.list(c(1000,2000,3000,4000)), names(df2)))
ui <-fluidPage(
sidebarPanel(
checkboxInput("add_data", "Add Data Table(s)"),
conditionalPanel(condition="input.add_data === true",
numericInput("numofdata",
label="Number of Data Table(s):",
min = 1,
max = 3,
value = 1,
step = 1),
uiOutput("num_of_data"),
textOutput("see_ranges")
),
actionButton("submit", "Submit")
),
mainPanel(
titlePanel("Output Data Table"),
DT::dataTableOutput("datatable.view", width = "95%")
) # end of main panel
)
server <- function(input, output, session) {
output$num_of_data <- renderUI({
lapply(1:input$numofdata, function(i) {
print(trend_list())
})
})
output$see_ranges <- renderPrint({
print(trend_list())
})
data.filter <- reactive({
df(i)
})
output$datatable.view <- DT::renderDataTable(
{
input$submit
if (input$submit==0) return()
isolate({
for(i in 1:input$numoftrends) {
datatable(data.filter(i),
rownames=FALSE,
extensions = c("FixedColumns", "FixedHeader", "Scroller"),
options = list(searching=FALSE,
autoWidth=TRUE,
rownames=FALSE,
scroller=TRUE,
scrollX=TRUE,
pagelength=1,
fixedHeader=TRUE,
class='cell-border stripe',
fixedColumns =
list(leftColumns=2,heightMatch='none')
)
)
}
})
})
}
shinyApp(ui = ui, server = server)
You should look at this article:
http://shiny.rstudio.com/gallery/creating-a-ui-from-a-loop.html
You will seen then that one has to create multiple renderDataTable instead of muliple datatable within one renderDataTable().
Also in your code you call df like a function df() but it is only defined as a variable.
See a generic running example below.
EDIT: Changed dynamic part of UI.
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10, 3)
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
observe({
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
tagList(lapply(1:input$amountTable, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
shinyApp(ui, server)

How to make a shiny module for displaying a button conditionally?

The goal is to have a shiny module ui1.R activating the submit button only when something is typed in lsuId. The current code doesn't retrieve any errors, but it seems it never calls toggleState.
ui.R
library(shiny)
library(shinyjs)
htmlOutput("page")
server.R
rm(list = ls())
library(shiny)
library(dplyr)
library(shinyjs)
Logged <- FALSE
shinyServer(function(input, output) {
observeEvent(input$"ui1Output-confirm", {
Logged <<- T
})
observe({
input$"ui1Output-confirm"
if (Logged == FALSE) {
output$page <- renderUI({
ui1Output('ui1Output')
})
output$lsuId <- renderText({ input$lsuId })
}
if (Logged == TRUE)
{
output$page <- renderUI({ ui2 })
}
})
callModule(ui1,'ui1')
})
ui1.R
library(shinyjs)
ui1Output <- function(id, label = "ui1") {
ns <- NS(id)
shinyUI(fluidPage(
useShinyjs(),
titlePanel("Form"),
div(textInput(ns("lsuId"), "This has to be filled", ""),
actionButton(ns("confirm"), "Submit", class = "btn-primary")
)
))
}
ui1 <- function(input, output, session) {
shinyjs::toggleState(id = "confirm", condition = F)
observeEvent(input$lsuId!="", {
shinyjs::toggleState(id = "confirm", condition = T)
})
}
ui2.R
ui2<- shinyUI(fluidPage(
div("well done!")
))
global.R
source('ui1.R') #login page
source('ui2.R')
Here's how I would approach this one:
ui.R
library(shiny)
shinyUI(
fluidPage(
fluidRow(column(width = 12,
align = 'center',
h1('Conditional Submit Button'))),
fluidRow(column(width = 12,
align = 'center',
textInput(inputId = 'text.field',
label = 'What is your greatest fear?',
value = ''),
uiOutput('submit.button')))
)
)
server.R
library(shiny)
shinyServer(
function(input, output) {
output$submit.button <-
renderUI(expr = if (nchar(input$text.field)) {
submitButton()
} else {
NULL
})
}
)
This approach doesn't use shinyjs, which I think is a positive (fewer dependencies), but I don't know if there's some reason you are interested in doing it with shinyjs that isn't stated in your question.
Here, ui.R simply has a textInput UI element with inputId 'text.field' and a promise that another UI element will be rendered in server.R called 'submit.button'.
In server.R, output$submit.button is set to NULL if the number of characters in input$text.field is 0, and set to submitButton() otherwise.
observe({
if (is.null(input$lsuId) || input$lsuId == "") {
shinyjs::disable("submit")
} else {
shinyjs::enable("submit")
}
})

R shiny build links between tabs with DT package

Solution for creating links between tabs a have found here R shiny build links between tabs is really nice, but it's not working with DT package (for me..).
Can anybody tell me, what am I doing wrong in my example code using DT library in compare to the solution without DT package?
library(shiny)
library(DT)
server <- function(input, output) {
output$iris_type <- DT::renderDataTable({
datatable(data.frame(Species=paste0("<a href='#filtered_data'>", unique(iris$Species), "</a>")),
escape = FALSE,
options = list(initComplete = JS(
'function(table) {
table.on("click.dt", "tr", function() {
Shiny.onInputChange("rows", table.row( this ).index());
tabs = $(".tabbable .nav.nav-tabs li a");
$(tabs[1]).click();
});
}')))
})
output$filtered_data <- DT::renderDataTable({
if(is.null(input$rows)){
iris
}else{
iris[iris$Species %in% unique(iris$Species)[as.integer(input$rows)+1], ]
}
})
}
ui <- shinyUI(fluidPage(
mainPanel(
tabsetPanel(
tabPanel("Iris Type", DT::dataTableOutput("iris_type")),
tabPanel("Filtered Data", DT::dataTableOutput("filtered_data"))
)
)
))
shinyApp(ui = ui, server = server)
You could try the code below. I changed the function switching the tabs to the callback (which has table as an argument) and in your output$filtered_data, replaced iris by datable(iris) since you are rendering with DT::renderDataTable
library(shiny)
library(DT)
server <- function(input, output) {
output$iris_type <- DT::renderDataTable({
datatable(data.frame(Species=paste0("<a href='#filtered_data'>", unique(iris$Species), "</a>")),
escape = FALSE,
callback = JS(
'table.on("click.dt", "tr", function() {
tabs = $(".tabbable .nav.nav-tabs li a");
$(tabs[1]).click();})'))
})
output$filtered_data <- DT::renderDataTable({
selected <- input$iris_type_rows_selected
if(is.null(selected)){
datatable(iris)
} else {
datatable(iris[iris$Species %in% unique(iris$Species)[selected], ])
}
})
}
ui <- shinyUI(fluidPage(
mainPanel(
tabsetPanel(
tabPanel("Iris Type", DT::dataTableOutput("iris_type")),
tabPanel("Filtered Data", DT::dataTableOutput("filtered_data"))
)
)
))
shinyApp(ui = ui, server = server)
Please note this requires DT >= 0.0.62.
In the end I used a little hack with onclick event on . Which way do you think is more clear? (NicE's or this one?)
library(shiny)
library(DT)
server <- function(input, output) {
output$iris_type <- DT::renderDataTable({
datatable(data.frame(Species=paste0("<a href='#filtered_data'",
"alt='",unique(iris$Species),"'",
"onclick=\"",
"tabs = $('.tabbable .nav.nav-tabs li');",
"tabs.each(function() {",
"$(this).removeClass('active')",
"});",
"$(tabs[1]).addClass('active');",
"tabsContents = $('.tabbable .tab-content .tab-pane');",
"tabsContents.each(function() {",
"$(this).removeClass('active')",
"});",
"$(tabsContents[1]).addClass('active');",
"$('#filtered_data').trigger('change').trigger('shown');",
"Shiny.onInputChange('species', getAttribute('alt'));",
"\">",
unique(iris$Species),
"</a>")),
escape = FALSE)
})
output$filtered_data <- DT::renderDataTable({
if(is.null(input$species)){
datatable(iris)
}else{
datatable(iris[iris$Species %in% input$species, ])
}
})
}
ui <- shinyUI(fluidPage(
mainPanel(
tabsetPanel(
tabPanel("Iris Type", DT::dataTableOutput("iris_type")),
tabPanel("Filtered Data", DT::dataTableOutput("filtered_data"))
)
)
))
shinyApp(ui = ui, server = server)

Resources