Shiny: Data frame only displays 10 rows - r

I have a Shiny app which can either display a plot or print a dataframe. While it does both, it only prints the 1st 10 rows of the data frame and add "... 86 more rows". I would like to display at least 40 rows of the data frame. I tried both a & head(a, n=50) but it displays only 10 rows of the total. How can I make it display more rows.
This is what I have
server.R
output$IPLMatch2TeamsPlot <- renderPlot({
printOrPlotIPLMatch2Teams(input, output)
})
# Analyze and display IPL Match table
output$IPLMatch2TeamsPrint <- renderPrint({
a <- printOrPlotIPLMatch2Teams(input, output)
head(a,n=50)
#a
})
output$plotOrPrintIPLMatch2teams <- renderUI({
# Check if output is a dataframe. If so, print
if(is.data.frame(scorecard <- printOrPlotIPLMatch2Teams(input, output))){
verbatimTextOutput("IPLMatch2TeamsPrint")
}
else{ #Else plot
plotOutput("IPLMatch2TeamsPlot")
}
})
ui.R
tabPanel("Head to head",
headerPanel('Head-to-head between 2 IPL teams'),
sidebarPanel(
selectInput('matches2TeamFunc', 'Select function', IPLMatches2TeamsFuncs),
selectInput('match2', 'Select matches', IPLMatches2Teams,selectize=FALSE, size=20),
uiOutput("selectTeam2"),
radioButtons("plotOrTable1", label = h4("Plot or table"),
choices = c("Plot" = 1, "Table" = 2),
selected = 1,inline=T)
),
mainPanel(
uiOutput("plotOrPrintIPLMatch2teams")
)

When you know your output is going to be a data.frame and not just any random bit of text, you can choose an output optimized for displaying tabular data. You could try renderTable and tableOutput instead of your renderPrint and verbatimTextOutput. Another option is renderDataTable from the DT package. This create a table that puts extra rows on different pages so you can acces all rows and you can modify how many rows it will show at any time.
For example, replacing your current renderPrint with the following:
output$IPLMatch2TeamsPrint <- DT::renderDataTable({
a <- printOrPlotIPLMatch2Teams(input, output)
datatable(a,
options = list(
"pageLength" = 40)
)
})
and replacing your verbatimTextOutput("IPLMatch2TeamsPrint") with DT::dataTableOutput("IPLMatch2TeamsPrint") Should give you a table with 40 rows and the option to see more rows as different pages in the table.
You might want to change the names from print to table as well for clarity since you're not just printing anymore.

Related

Shiny App: How to collect all text inputs into a data frame without listing them individually (how to index reactive values?)

I have a tab of my app where I display a bunch of text inputs based on a three-column data frame that contains: variable_name, text_prompt, and example_data. The code below seems to work fine since it displays how I want it to. Eventually, I will be feeding it different data frames, depending on the circumstances, so I need to be able to do everything programmatically.
library(shiny)
library(tidyverse)
library(DT)
additional.data.fields <- tibble (var.name = c("project.id", "director.name"),
prompt.text = c("Enter Project ID", "Enter Director's name"),
var.value = c("e.g. 09-111", "e.g. Paul Smith"))
ui <- fluidPage(
tabsetPanel(
#Generate Input fields from dataframe
tabPanel("Input", #value = "input.2",
# Generate input fields with pmap
actionButton("submit", "Submit"),
pmap(additional.data.fields, ~textInput(..1, ..2, value = ..3)),
),
#Output data to tell if it updates with button click
tabPanel("Output", value = "output",
DT::dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
# Create a reactive values object to store the input data
values <- reactiveValues()
# Set the reactive values object when the submit button is clicked
observeEvent(input$submit, {
var.names <- pull(additional.data.fields, var.name)
#THIS IS THE PART I DON'T KNOW HOW TO DO
#input.data <- ???
#I'll add dummy data so that the program loads
input.data <- tibble(var.names,
temp = 1:length(var.names))
values$data <- input.data
})
# Render the input data table
output$data <- DT::renderDataTable({
values$data
})
}
shinyApp(ui, server)
But what I want - and really have no idea how to do - is to get it back into a data frame after the user hits "submit" (I only need two columns in the subsequent data frame; I don't need the text_prompt data again.)
I know that the user input creates a list of read-only ReactiveValues called "input". But I can't figure out how to do anything with this list besides access using known names (i.e. I know that there is a variable named "project_id" which I can access using input$project_id). But what I want is not to have to write them all out, so that I can change the data used to create the input fields. So I need a way to collect them in a data frame without knowing all the individual names of the variables or even how many there are.
I figured this out on my own. You can't index reactive values with []. However, for some reason you can using [[]].
I would love to know why this is, if anyone has an answer that can help me understand why it works this way.
Here's the key bit of code that I was missing before:
input.data <- tibble (names = var.names,
values = map_chr(var.names, ~input[[.x]]))
The full code that works as I want it is pasted below. I'd still appreciate any feedback or recommendations for improvement.
library(shiny)
library(tidyverse)
library(DT)
additional.data.fields <- tibble (var.name = c("project.id", "director.name"),
prompt.text = c("Enter Project ID", "Enter Director's name"),
var.value = c("e.g. 09-111", "e.g. Paul Smith"))
ui <- fluidPage(
tabsetPanel(
#Generate Input fields from dataframe
tabPanel("Input", #value = "input.2",
# Generate input fields with pmap
actionButton("submit", "Submit"),
pmap(additional.data.fields, ~textInput(..1, ..2, value = ..3)),
),
#Output data to tell if it updates with button click
tabPanel("Output", value = "output",
DT::dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
# Create a reactive values object to store the input data
values <- reactiveValues()
# Set the reactive values object when the submit button is clicked
observeEvent(input$submit, {
var.names <- pull(additional.data.fields, var.name)
input.data <- tibble (names = var.names,
values = map_chr(var.names, ~input[[.x]]))
values$data <- input.data
})
# Render the input data table
output$data <- DT::renderDataTable({
values$data
})
}
shinyApp(ui, server)

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)

select rows in a table and then extract key and search in the other table and show the rows in R shiny

I have a dataset like this.
I made a new dataset and in this new one, I put unique rows of my original dataset. the new dataset shown in the dashboard and user can select some rows. based which rows selected I extracted the name like "PA0001" and now I have search all rows with this name in the original dataset and show to users.
my code is like below:
ui <- luidPage(
titlePanel("Prototype of Project"),
br(),
br(),
mainPanel(
DT::dataTableOutput("main_table"),
br(), be(),
tableOutput("gene_data")
)
)
server <- function(input, output) {
output$main_table <- DT::renderDataTable({
data_search = distinct(data[,1:3])
data_search
},filter = "top")
output$gene_data = renderTable({
s = input$main_table_rows_selected
data_search = distinct(data[,1:3])
gene_name = data_search[s,1]
print(gene_name)
selected_row = data[data$Locus_Tag %in% gene_name,]
print(selected_row)
selected_row
})
}
the problem is: when I select one rows everything is fine, but when I select more rows my selected_row data frame is empty.

Filtering shiny data table with 2 dependent select inputs in different columns

I want to create a shiny app, that filters data table with two select inputs, that one of them is multiple and dependent on another one. First select input is category and the second one is brand. Brand is dependent on category input. I already made two dependent select inputs, but when I go to the filtering process of data table I get stuck. Because when I run app and filter data table with dependent multiple select, I get error " Warning in df$C_BRAND == input$brand :
longer object length is not a multiple of shorter object length".
I understand that whe I choose only one value on the second select its good, but when there is more, filtering fales.
runApp(list(
ui = basicPage(
sidebarPanel(
selectInput("kat", "Kategorija", choices = unique(df1$C_CTG), selected = unique(df1$C_CTG)[1]),
tags$hr(),
selectInput("brand", "Brandas", choices = df1$C_BRAND[df1$C_CTG == unique(df1$C_CTG)[1]],
multiple = TRUE)
),
mainPanel(
DT::dataTableOutput("table")
)
),
server = function(input, output, session) {
observe({
kat <- input$kat
updateSelectInput(session, "brand", choices = df1$C_BRAND[df1$C_CTG == kat])
})
df <- main2019
filterData1 <- reactive({
df[which(df$C_CTG == input$kat & df$C_BRAND == input$brand),]
})
output$table <- DT::renderDataTable({
DT::datatable(filterData1(),selection="multiple",rownames = F)
})
}
))
I know that I have to change this code line
df[which(df$C_CTG == input$kat & df$C_BRAND == input$brand),]
But I dont know what to put there, that when I choose more options in select input, filtering would work.
Here I made simple small sample of my datatable:
C_CTG <- sample(c(1:5),8,replace=TRUE)
brand <- sample(c(6:10),8,replace=TRUE)
store <- sample(c("shoes", "phones", "food", "drinks", "pets"),8, replace = TRUE)
input <- data.frame(C_CTG,brand,store)
Here is example of my generated data table
I expect for example, that in my first select I would choose value "2" in input$C_CTG and then in second select input$brand I would get to choose from "7" or "10" values and depending on what I will choose (7 or 10 or both) data table would show one row where input$C_CTG=2 and input$brand=10 or two rows where input$C_CTG=2 and input$brand=7 or it could show 3 rows when I chose input$C_CTG=2 and input$brand=c(7,10)
I hope that this example will let you understand what I want to make.

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
)
}
}
})

Resources