Rhandsontable non-consecutive cell selection in shiny app - r

I am trying to use Rhandsontable in a Shiny app to make a 8x12 table that will be used as input matched to a 97 column dataframe. Each cell in the table corresponds to 1 column in the dataframe (-1 for the x-axis).
This is my current code for testing:
server <- function(input, output) {
mat = matrix(, nrow=8, ncol=12, dimnames= list(LETTERS[1:8],1:12))
output$table = renderRHandsontable({
rhandsontable(mat, readOnly = T, selectCallback = T) %>%
hot_cols(colWidths=22) %>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = 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="")
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width=5,
rHandsontableOutput("table"),
verbatimTextOutput("selected")
),
mainPanel(
)
)
)
shinyApp(ui,server)
This works great for shift-click based multiple selection, selection of whole rows, whole columns, and single cells. However, I need to be able to select also in the standard cntrl+click way to select discontinuous blocks of cells. Is this not feasible in rhandsontable package? I can't find any documentation on it, nor can I find anything else on SO. Help or recommendations on what packages/tools can accomplish this would be greatly appreciated.

Related

Selection of table with flexdashboard

I am work with flexdashboard.I already find some tempalate example (https://jjallaire.shinyapps.io/shiny-biclust/ ) and now I want to adapt in accordance with my needs. But I face with one problem.
Namely here I already used reactive function and below you can see my code from function.
num<-reactive(as.integer(input$clusterNum)
Selection here is made with selection number from 1 to 5. After selection from drop down menu and select one of number from 1 to 5, this selection going to next block of code and select appropirate cluster. You can see code below
renderTable(
BicatYeast[which(res#RowxNumber[, num()]), which(res#NumberxCol[num(), ])]
)
So far so good. But now I want to try to use this kind selection on my data. My dataset is list with two tables (table 1 and table 2) . You can see how is look in R.
Now I want to use same command for selection of my data and I tryed with command line
data[which(num()]
but this not work.
So can anybody help me how solve this problem and select table 1 of my list ?
This is how to display one table of the list:
library(shiny)
# example data
data <- list(
iris,
ggplot2::mpg,
iris,
iris,
iris
)
ui <- fluidPage(
numericInput("clusterNum", label = "Cluster number", value = 1, min = 1, max = 5, step = 1),
tableOutput("table")
)
server <- function(input, output, session) {
output$table <- renderTable({
data[[input$clusterNum]]
})
}
shinyApp(ui, server)

selectInput() in Shiny R not returning any values

I am trying to develop a Shiny app, a simple one. My intention at this point is to create a table and filter that table by various inputs.
Right now this is my code:
library("shiny")
library("gapminder")
library("ggplot2")
library("colourpicker")
library("plotly")
ui <- fluidPage(
h1("Demo"),
sliderInput(inputId = "valor", label = "Rango ",
min = min(data$value), max = max(data$value),
value = c(min(data$value), max(data$value))),
selectInput(inputId = "opc", label = "Measurements", choices = levels(data$measurement)),
tableOutput("table")
)
server <- function(input, output) {
output$table <- renderTable({
data <- data
data <- subset(
data,
value >= input$valor[1] & value <= input$valor[2]
)
data <- subset(
data,
measurement == input$opc
)
data
})
}
levels(data$measurement)
shinyApp(ui, server)
as you can see, very simple. However, this code returns the table empty and the selectInput with no options of selection. However, if I put the values of the column by hand, the code works fine!
selectInput(inputId = "opc", label = "Measurements", choices = c("heart_rate","oxygen_saturation")),
The code above works great, the table suddenly displays data again and it filters correctly. I just don't get it! The sliderInput works great as well. The data set has been included as an enviroment variable.
This are the two different outputs (first picture with written values, second picture using levels(data$measurement)):
Why is this happening to me?!

Row-slider for the rendered table made using R - DataTable for ShinyApp

I have to display a large data frame on shiny-mainPanel(). I am using library("DT") for the purpose with renderDT({}) and datatable(df,rownames = FALSE). The rows in the data frame have very long string values which are distorting the shape of the rendered table on the mainPanel.
Here is the distorted-table with all the columns
Here is the clean-table with fewer columns
I want the display all the columns just like displayed in the clean-table. I am trying to make a slider for gliding through the rows but couldn't find any in-built option for datatable()
function on the UI
mainPanel(DT::dataTableOutput("table"))
function on the Server
output$table <- renderDT({datatable(df,rownames = FALSE)})
You can set the option scrollX = TRUE in Datatable.
All the options of the Datatable javascript library, in particular scrollX, can be set in Shiny using the òptions parameter.
Try :
ui <- fluidPage(
title = 'DataTable Options',
tabPanel('Display length', DT::dataTableOutput('ex1'))
)
server <- function(input, output) {
# A lot of columns
df <- cbind(head(mtcars),head(iris))
output$ex1 <- DT::renderDataTable(
DT::datatable(df, options = list(scrollX = T))
)
}
shinyApp(server = server,ui)

Create datatable based on cell selection of another datatable in a shiny app

I have a simple shiny app with 2 datables.
#ui.r
navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
),
mainPanel(
DT::dataTableOutput("hot3"),
br(),
DT::dataTableOutput("hot5")
)
)))
#server.r
library(shiny)
library(DT)
server <- function(input, output,session) {
DF= data.frame(Sel. = rep(TRUE,2),
Label=paste("Test",as.integer(1:2)),
Marg=rep("Marg1",2),
Avail.=as.integer(rep.int(50,2)),
Sel =as.integer(rep.int(50,2)),
stringsAsFactors = FALSE)
output$hot3 <-DT::renderDataTable(
DF,
selection=list(mode="single", target="cell")
)
output$hot5 <-DT::renderDataTable({
DF = data.frame(
Sel= rep(TRUE, as.numeric(input$hot3_cells_selected)),
Id= 1:as.numeric(input$hot3_cells_selected),
Label=paste("Item",as.integer(1:as.numeric(input$hot3_cells_selected))),
Pf=as.integer(rep.int(0,as.numeric(input$hot3_cells_selected))),
stringsAsFactors = FALSE)
DF
})
}
What I want to achieve is when I click on the "Avail" cell (50) to create a new data frame with 50 rpws which will be displayed in a new data table.
but I take as error
Error in rep: invalid 'times' argument
This error is thrown by the rep function since you don't provide a valid times argument. In this case, input$hot3_cells_selected returns a vector representing the row and column indices of the selected cell, respectively. You can access the actual content of the cell using:
DF[input$hot3_cells_selected]
However, you need some additional adjustments to make your code more robust. For example, input$hot3_cells_selected is empty until a cell is selected, which will cause a similar problem with the rep function. Or, your should cover the case where a non-numeric cell is selected (i.e Test1 or Marg1). Below is a possible naïve solution:
# changing only this part of the code will be enough
# inserted DF[input$hot3_cells_selected] when needed below
output$hot5 <-DT::renderDataTable({
# checking whether any cell is selected or not
if(length(input$hot3_cells_selected) > 0) {
# checking whether the selected cell includes a number or not
# note that suppressWarnings is optional
if(!is.na(suppressWarnings(as.numeric(DF[input$hot3_cells_selected])))) {
# you don't need to store the data frame, so removed the assignment
# even if you wanna store it for future reference, use a unique name (not DF)
data.frame(
Sel= rep(TRUE, as.numeric(DF[input$hot3_cells_selected])),
Id= 1:as.numeric(DF[input$hot3_cells_selected]),
Label=paste("Item",as.integer(1:as.numeric(DF[input$hot3_cells_selected]))),
Pf=as.integer(rep.int(0,as.numeric(DF[input$hot3_cells_selected]))),
stringsAsFactors = FALSE
)
}
}
})

cannot get index of column selected/clicked in DT package for shiny

I am trying to make a basic program in R shiny framework so that I can display an interactive data table. The basic function I need to perform but can't is getting the row and column index of any selected/clicked cell. I have done research online and followed the tutorials exactly, but what is shown in the tutorials does not appear to be working. Since I think getting clicks is harder, I have settled with getting the row and column index of whatever cell is selected. Here is what I currently have for the ui.R and server.R files:
library(shiny)
library(shinyTable)
library(DT)
server <- function(input, output, session) {
lastTransToMat = data.table(cbind(c(.5,.5),c(.8,.2)))
output$transtable = DT::renderDataTable(lastTransToMat,options = list(target = 'column+row'))
output$response <-DT::renderDataTable({
rows= as.numeric(input$transtable_rows_selected)
cols = as.numeric(input$transtable_columns_selected)
print(rows)
print(cols)
response = data.table(cbind(c(paste0("rows: ",rows),c(paste0("cols: " ,cols)))))
print(response)
return(response)
})
}
shinyUI(fluidPage(
titlePanel("transition table"),
mainPanel(
DT::dataTableOutput('transtable'),
DT::dataTableOutput('response')
)
))
When I runApp() on this, I am only able to get the index of the row, but not the index of the column. See output below:
numeric(0)
V1
1: rows: 1
2: cols:
There is a similar data.table output in the shiny app itself.
Does anyone know why this is happening?
How can I get both the row and column index of a selection? And what about clicks?
Best,
Paul
EDIT:
As per user5029763's suggestion, I replaced my server.R function with the following:
#ui.R
library(shiny)
library(shinyTable)
library(DT)
shinyUI(fluidPage(
titlePanel("transition table"),
mainPanel(
DT::dataTableOutput('transtable'),
DT::dataTableOutput('response'),
htmlOutput('response2')
)
))
#server.R
server <- function(input, output, session) {
lastTransToMat = data.table(cbind(c(.5,.5),c(.8,.2)))
output$transtable = DT::renderDataTable(lastTransToMat,server = F,options = list(target = 'cell'))
output$response <-DT::renderDataTable({
cell= as.numeric(input$transtable_cell_clicked)
print(cell)
response = data.table(cbind(c(paste0("cell: "),c(paste0(cell)))))
print(response)
return(response)
})
output$response2 <- renderUI({
cells <- input$transtable_cell_clicked
if(length(cells) == 0) return( div('No cell is selected') )
cells <- data.frame(cells)[-3]
response <- paste0(c('Row', 'Column'), ': ', cells, collapse = ' / ')
div(response)
})
}
Output before any click:
Output after click/selection:
Is this the same as the output you get when you runApp() on this?
EDIT: Also just FYI, I tried this on another computer with the most updated version of R and got the same output, so I don't think it has to do with my version/computer.
If what you want is to get the index of clicked cells you could go with:
output$transtable = DT::renderDataTable(
lastTransToMat,
server = F,
selection = list(target = 'cell')
)
Then, input$transtable_cell_clicked will be a list with row/column index and the value within the cell. Just remember that the column index starts at 0.
EDIT: one way to print out
#server.R
output$response2 <- renderUI({
cells <- input$transtable_cell_clicked
if(length(cells) == 0) return( div('No cell is selected') )
cells <- data.frame(cells)[-3]
response <- paste0(c('Row', 'Column'), ': ', cells, collapse = ' / ')
div(response)
})
#ui.R
htmlOutput('response2')

Resources