1.In my app i just want to show the data of the each row separately for Ex if i click any value in the first column the data should show the whole row
like if i click on Mazda RX4 it should show the whole row of the data
2.with the help of extensions = 'ColReorder' i can drag the column inside the table if i drag the first column to others position that clickable should work
for eg if i move the 1st(new_name) column into 4th that clickeable is not working
Any answers would be appreciated
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(fluidRow(
DT::dataTableOutput("myDatatable"),
verbatimTextOutput("selectedCells")
))
df <- cbind(new_name =rownames(mtcars), data.frame(mtcars, row.names= NULL))
server <- shinyServer(function(input, output, session) {
output$myDatatable <- DT::renderDataTable(
df, extensions = 'ColReorder', options = list(colReorder = TRUE),selection = list(mode = "single", target ="cell"),
server = FALSE,
rownames = T
)
output$selectedCells <- renderPrint({
s = input$myDatatable_cells_selected
if (!is.null(s) && ncol(s) != 0) {
mtcars[,1]
} else {
NULL
}
})
})
shinyApp(ui, server)
Tested:
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(fluidRow(
DT::dataTableOutput("myDatatable"),
verbatimTextOutput("selectedCells")
))
df <- cbind(new_name =rownames(mtcars), data.frame(mtcars, row.names= NULL))
server <- shinyServer(function(input, output, session) {
output$myDatatable <- DT::renderDataTable(
df, extensions = 'ColReorder', options = list(colReorder = TRUE),selection = list(mode = "single", target ="cell"),
server = FALSE,
rownames = T
)
output$selectedCells <- renderPrint({
s_val = input$myDatatable_cell_clicked$value
s = input$myDatatable_cells_selected
if (!is.null(s) && ncol(s) != 0) {
df[df$new_name==s_val,]
} else {
NULL
}
})
})
shinyApp(ui, server)
You can have the value of selected cell with:
s_val = input$myDatatable_cell_clicked$value
After that, you can search this value in your data and print the entire row:
df[df$new_name==s_val,]
Related
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 want users of my Shiny app to fill in the values of a 2x2 table with row and column names. Of course, I could do it with 4 input boxes, but I assume that it will be tricky to position everything neatly. Despite that, I would prefer a table layout such as the one provided by the DT package. Thus, my question is: Is it possible to have a datatable (or something similar) filled by the user?
You can use shinysky
devtools::install_github("AnalytixWare/ShinySky") package
or rhandsontable to do what you want:
rm(list = ls())
library(shiny)
library(shinysky)
server <- shinyServer(function(input, output, session) {
# Initiate your table
previous <- reactive({mtcars[1:10,]})
MyChanges <- reactive({
if(is.null(input$hotable1)){return(previous())}
else if(!identical(previous(),input$hotable1)){
# hot.to.df function will convert your updated table into the dataframe
as.data.frame(hot.to.df(input$hotable1))
}
})
output$hotable1 <- renderHotable({MyChanges()}, readOnly = F)
output$tbl = DT::renderDataTable(MyChanges())
})
ui <- basicPage(mainPanel(column(6,hotable("hotable1")),column(6,DT::dataTableOutput('tbl'))))
shinyApp(ui, server)
A solution with DT:
library(DT)
library(shiny)
dat <- data.frame(
V1 = c(as.character(numericInput("x11", "", 0)), as.character(numericInput("x21", "", 0))),
V2 = c(as.character(numericInput("x21", "", 0)), as.character(numericInput("x22", "", 0)))
)
ui <- fluidPage(
fluidRow(
column(5, DT::dataTableOutput('my_table')),
column(2),
column(5, verbatimTextOutput("test"))
)
)
server <- function(input, output, session) {
output$my_table <- DT::renderDataTable(
dat, selection = "none",
options = list(searching = FALSE, paging=FALSE, ordering=FALSE, dom="t"),
server = FALSE, escape = FALSE, rownames= FALSE, colnames=c("", ""),
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-container');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
output$test <- renderText({
as.character(input$x11)
})
}
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)
I am running an example from here.
library(rhandsontable)
library(shiny)
runApp(shinyApp(
ui = fluidPage(rHandsontableOutput("hot")),
server = function(input, output, session) {
fname <- "mtcars2.csv"
values <- reactiveValues()
setHot <- function(x) values[["hot"]] = x
observe({
if(!is.null(values[["hot"]])) write.csv(values[["hot"]], fname)
})
output$hot <- renderRHandsontable({
if (!is.null(input$hot)) {
DF <- hot_to_r(input$hot)
} else {
DF <- read.csv("mtcars.csv", stringsAsFactors = FALSE)
}
setHot(DF)
rhandsontable(DF) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE) %>%
hot_cols(columnSorting = TRUE)
})
}
))
I want changes made to table be saved in file mtcars2.csv. I also want to preserve row order. In project home page it says "sorting only impacts the widget and will not reorder the original data set". Can I somehow get current view of a table and save it?
The best way to answer this question will be to file an issue at https://github.com/jrowen/rhandsontable. Currently, these lines define only a partial list of handsontable events. This list does not include afterColumnSort which would be what you need. Here is a quick hack to partially answer your question.
library(rhandsontable)
library(shiny)
library(htmlwidgets)
runApp(shinyApp(
ui = fluidPage(
rHandsontableOutput("hot"),
tags$script(
'
setTimeout(
function() {
HTMLWidgets.find("#hot").hot.addHook(
"afterColumnSort",
function(){
console.log("sort",this);
Shiny.onInputChange(
"hot_sort",
{
data: this.getData()
}
)
}
)
},
1000
)
'
)
),
server = function(input, output, session) {
observeEvent(
input$hot_sort
,{
print(input$hot_sort$data)
}
)
output$hot <- renderRHandsontable({
if (!is.null(input$hot)) {
DF <- hot_to_r(input$hot)
} else {
DF <- mtcars
}
rhandsontable(DF) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE) %>%
hot_cols(columnSorting = TRUE)
})
}
))
I don't think there is a way to preserve the sorted columns in DataTables for shiny, Sad!
With the below code I'm able to save changes made in shiny app to the file mtcars2.csv. Interestingly! post sorting by desired column, clicking on any data cell and pressing enter key saves the row order to the mtcars2.csv. Agree with timelyportolio's point on filing an issue on git.
R Code:
library(shiny)
library(rhandsontable)
runApp(shinyApp(
ui = fluidPage(titlePanel("Edit Data File"),
helpText("Changes to the table will be automatically saved to the source file."),
# actionButton("saveBtn", "Save"),
rHandsontableOutput("hot")),
shinyServer(function(input, output, session) {
values = reactiveValues()
data = reactive({
if (is.null(input$hot)) {
hot = read.csv("mtcars.csv", stringsAsFactors = FALSE)
} else {
hot = hot_to_r(input$hot)
}
# this would be used as a function input
values[["hot"]] = hot
hot
})
observe({
# input$saveBtn
if (!is.null(values[["hot"]])) {
write.csv(values[["hot"]], "mtcars.csv", row.names = FALSE)
}
})
output$hot <- renderRHandsontable({
hot = data()
if (!is.null(hot)) {
hot = rhandsontable(hot) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE) %>%
hot_cols(columnSorting = TRUE)
hot
}
})
})
))
I am using rhandsontable in a Shiny App and I would like to know how to use the getSelected() method of Handsontable in this case, as I intend to apply changes on the data.frame.
thank you!
You can obtain the selected row, column, range, and cell values, as well as the edited cells using selectCallback=TRUE. You can edit a cell by double-clicking on it, and accept the changes by pressing "return" or "enter".
Minimal example:
library(shiny)
library(rhandsontable)
ui=fluidPage(
rHandsontableOutput('table'),
verbatimTextOutput('selected')
)
server=function(input,output,session)({
df=data.frame(N=c(1:10),L=LETTERS[1:10],M=LETTERS[11:20])
output$table=renderRHandsontable(
rhandsontable(df,selectCallback = TRUE,readOnly = FALSE)
)
output$selected=renderPrint({
cat('Selected Row:',input$table_select$select$r)
cat('\nSelected Column:',input$table_select$select$c)
cat('\nSelected Cell Value:',
input$table_select$data[[
input$table_select$select$r]][[input$table_select$select$c]])
cat('\nSelected Range: R',input$table_select$select$r,
'C',input$table_select$select$c,':R',input$table_select$select$r2,
'C',input$table_select$select$c2,sep="")
cat('\nChanged Cell Row Column:',input$table$changes$changes[[1]][[1]],
input$table$changes$changes[[1]][[2]])
cat('\nChanged Cell Old Value:',input$table$changes$changes[[1]][[3]])
cat('\nChanged Cell New Value:',input$table$changes$changes[[1]][[4]])
})
}) # end server
shinyApp(ui = ui, server = server)
While rhandsontable is a real good implementation of handsontable (credit goes to #jrowen), currently it does not include getSelected().
The event of a user altering any cell (including selecting / deselecting a checkbox) is tracked by shiny. This gives the opportunity to use checkboxes to let the user to select (or de-select) one or more rows.
Unfortunately the logic to understand what has been selected needs to be developed on the server side by your code.
The snippet of code below may give you some idea on how to manage it.
options(warn=-1)
library(rhandsontable)
library(shiny)
options(warn=-1)
quantity <- id <- 1:20
label <- paste0("lab","-",quantity)
pick <- FALSE
iris_ <- data.frame(id=id,pick=pick, quantity=quantity,label=label,iris[1:20,] ,stringsAsFactors = FALSE)
mtcars_ <- data.frame(id=id,pick=pick, quantity=quantity,label=label,mtcars[1:20,] ,stringsAsFactors = FALSE)
iris_$Species <- NULL # i.e. no factors
#---------------------------
ui <- fluidPage(
fluidRow(
column(6,rHandsontableOutput('demTb')),
column(3,uiOutput("demSli")),
column(3, radioButtons("inButtn", label=NULL, choices= c("iris","mtcars"), selected = "iris", inline = TRUE))
)
)
server <- function(session, input, output) {
selData <- ""
output$demSli <- renderUI({
if(is.null(input$demTb) ) return()
isolate({
df_ <- hot_to_r(input$demTb)
index <- which(df_$pick==T)
if(length(index)==0) return()
labs <- iris_$label[index]
pages <- "test"
iter <- length(labs)
buttn <- 1
valLabs <- sapply(1:iter, function(i) {
if(is.null(input[[paste0(pages,"d",labs[i],buttn)]] )) {
0
} else { as.numeric(input[[paste0(pages,"d",labs[i],buttn)]]) }
})
#
toRender <- lapply(1:iter, function(i) {
sliderInput(inputId = paste0(pages,"d",labs[i],buttn),
label = h6(paste0(labs[i],"")),
min = -100,
max = 100,
step = 1,
value = valLabs[i],
post="%",
ticks = FALSE, animate = FALSE)
})
})
return(toRender)
})
#--------------------
rds <- reactive({
# if( is.null(input$demTb) ) {
if( input$inButtn == "iris") {
if(selData == "" | selData == "mtcars") {
selData <<- "iris"
return(iris_) # first time for iris
}
} else {
if(selData == "iris" ) {
selData <<- "mtcars"
return(mtcars_) # first time for mtcars
}
}
df_ <- hot_to_r(input$demTb)
isolate({
index <- which(df_$pick==T)
if(length(index)==0) return(df_)
labs <- iris_$label[index]
pages <- "test"
iter <- length(labs)
buttn <- 1
}) # end isolate
valLabs <- sapply(1:iter, function(i) {
if(is.null(input[[paste0(pages,"d",labs[i],buttn)]] )) {
0
} else {
as.numeric(input[[paste0(pages,"d",labs[i],buttn)]])/100
}
})
dft_ <- data.frame(label=labs, multi=valLabs, stringsAsFactors = FALSE)
dft_ <- merge(iris_,dft_,by="label", all.x=T)
dft_$quantity <- sapply(1:length(dft_$quantity), function(z) {
if( is.na( dft_$multi[z]) ) {
dft_$quantity[z]
} else { iris_$quantity[z]*(1 + dft_$multi[z]) }
})
dft_[with(dft_,order(as.numeric(id))),]
df_[with(df_,order(as.numeric(id))),]
df_$quantity <- df_$quantity
return(df_)
})
output$demTb <- renderRHandsontable({
if(is.null(rds() )) return()
df_ <- rds()
df_ <- df_[with(df_,order(as.numeric(id))),]
rhandsontable(df_, readOnly = FALSE, rowHeaders= NULL, useTypes= TRUE) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE)
})
}
shinyApp(ui, server)