I am creating a input list for user selection using selectInput(....multiple=TRUE), where user can select multiple options, but I am unable to check/read what options user selects in my server.R.
If anyone has successfully tried it can you please share?
For example -
For a directory which has folowing file -
/User/DE/AvsB.de.txt-
Feature.ID Read.Count.All Read.Count.A Read.Count.B FC
ENSG00000121898 3367.375403 6734.750807 0 0
ENSG00000104435 2161.235573 4322.471145 0 0
ENSG00000229847 2111.660196 4223.320392 0 0
ENSG00000046889 1302.993351 2605.986702 0 0
/User/DE/CvsD.de.txt -
Feature.ID Read.Count.All Read.Count.C Read.Count.D FC
ENSG00000248329 373.0309339 746.0618679 0 0
ENSG00000144115 352.3786793 704.7573586 0 0
ENSG00000158528 351.6252529 703.2505057 0 0
ENSG00000189058 350.5375828 701.0751656 0 0
library(gtools)
D_files <- list.files(path = "/User/DE/",pattern = "*.de.txt" ,recursive = F, full.names = T)
D_filename <- vector()
for(i in 1:length(D_files)){
D_filename[i] <- D_files[i]
}
D_filename <- unlist(strapplyc(D_filename, "/User/DE/(.*).de.txt"))
names(D_files)<- D_filename
ui <- fluidPage(
mainPanel(
uiOutput("Quad_plot_comparison"),
HTML("<br><br>"),
br()
)
)
server <- function(input, output) {
output$Quad_plot_comparison <- renderUI({
selectInput(inputId = "vars",label = h3("Select comparison"), choices = mixedsort(D_files), multiple = T)
})
}
shinyApp(ui, server)
My code shows the file names in the input box, but I need to do following
1- Select multiple file names from the box
2- Read user input ( variables in the input box)
3- Read the files corresponding to these user input into a data frame
I am not even able to get the second step to work, any help will work!
Thanks!
This is a small example on how to use multiple selection in selectInput. You can adapt it to you scenario by reading the file in the reactive:
library(shiny)
shinyApp(ui=fluidPage(selectInput("select", "choose", c(1,2,3), multiple = TRUE),
textOutput("selected", inline=TRUE)),
server=function(input, output){
selected <- reactive(ifelse(is.null(input$select), "nothing",
paste(input$select, collapse=",")))
output$selected <- renderText(paste("Selected=",selected()))
})
Related
New to Shiny, I am trying to create a very simple app respecting the following sequence of events:
(1) Upload a dataframe,
(2) Wait until the user set the filtering parameter (Category in the example below),
(3) Press a Go! button,
(4) Display the first rows of the subset data frame.
Let's say I have a file df.tab to upload and process.
df <- data.frame(Category=c("A","A","A","B","B","B"), X=c(1,2,3,1,2,3), Y=c(1,2,3,34,21,1))
df
Category X Y
1 A 1 1
2 A 2 2
3 A 3 3
4 B 1 34
5 B 2 21
6 B 3 1
write.table(df, file="df.tab", row.names=F, quote=F, sep="\t")
My app.R looks like:
library(shiny)
# Define UI ----
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("input_df",label=h4("Dataset")),
selectInput("category",h4("Category"), choices = list("A" = 1,"B" = 2),selected = 1),
actionButton("goButton",label = "Go!")
),
mainPanel(
tableOutput("view")
)
)
)
# Define server logic ----
server <- function(input, output) {
data <- eventReactive(
input$input_df,
{
File <- input$input_df
if(is.null(File)){
return(NULL)
}else{
df <- read.table(File$datapath, header = T, sep = "\t")
}
}
)
data_sub <- eventReactive(
input$category,
{
df_sub <- subset(data(), Category == input$category)
}
)
output$view <- renderTable(
{
head(data_sub())
}
)
}
# Run the app ----
shinyApp(ui = ui, server = server)
However, the app is either not responsive or does not display any rows.
Note that I created 2 distinct reactive events data and data_sub in order to avoid loading the file every time I select a different category (and potentially to avoid stack errors with a recursive function).
Any help would be greatly appreciated.
Here is a working server function. Use reactive, not eventReactive and it is quite straightforward.
NOTE that your example assumes you have a Category column, I modified below to make it work with anything.
# Define server logic ----
server <- function(input, output) {
dataset <- reactive({
File <- input$input_df
req(File)
read.table(File$datapath, header = TRUE, sep = "\t")
})
data_sub <- reactive({
if("Category" %in% names(dataset())){
subset(dataset(), Category == input$category)
} else {
dataset()
}
})
output$view <- renderTable({
head(data_sub())
})
}
I get an error while using shiny dq_render_handsontable which I guess it's a bug of the dq_shiny package. I would appreciate if anyone could know any work around.
I am trying to interactively update a table via an action button ("Generate" in the code below). The tables which I am trying to switch among, have different number of columns. All works up to the display of the new table, i.e., once I click on "Generate" I can see the new table with additional columns. BUT the problem is that once I try to edit the cells of the data frame with a more columns after editting the first one with less columns, the following error appear:
Warning: Error in [<-.data.frame: new columns would leave holes after existing columns
I guess that is certainly a bug of dq_render_handsontable that doesn't recognize the new columns added to handsontable. Anyone knows a workaround? Maybe refreshing the table before showing a new data frame with more columns?
I attach the peice of the code to reproduce the error:
library(shiny)
library(rhandsontable)
library(dqshiny)
library(rlang)
ui = fluidPage(
dq_handsontable_output("InputTable", 9)
,
# actionButton("render", "Render HoT"),
actionButton("simulationInput_2", "Generate"),
fluidRow(id="bigRow", class="hidden",
style="height:100vh;background:#ff8f00;")
)
server = function(input, output) {
hw <- c("Hello", "my", "funny", "world!")
data1 <- data.frame(A=hw, B=hw[c(2,3,4,1)], C=1:4, D=Sys.Date() - 0:3,
A2=hw, B2=hw[c(2,3,4,1)], C2=1:4, D2=Sys.Date() - 1:4,
stringsAsFactors = FALSE)
hw <- c("Hello", "my", "funny", "world!")
data2 <- data.frame(A=hw, B=hw[c(2,3,4,1)], C=1:4, D=Sys.Date() - 0:3,
# A2=NA, B2=NA, C2=NA, D2=NA,
stringsAsFactors = FALSE)
cont = 0
observeEvent(input$simulationInput_2, {
cont <<- cont+1
print(cont)
if(mod(cont,2)==0){
data <- data2
}else{
data <- data1
}
renderInputTable(data)
render_hot("InputTable")
})
renderInputTable <- function(data){
dq_render_handsontable(
"InputTable",
data, #"rand",
# filters = F, #c("S", "T", "R", "R"),
filters = rep(NA, ncol(data)),
table_param = list(rowHeaders = NULL, selectCallback = TRUE))
}
observeEvent(input$random_select, toggle("bigRow"))
observeEvent(input$render, render_hot("InputTable"))
}
shinyApp(ui, server)
I could overcome the problem by a trick which is renaming the dq_shiny table ID which is actually a bug of dq_render_handsontable:
library(shiny)
library(rhandsontable)
library(dqshiny)
library(rlang)
library(magrittr)
library(data.table)
ui = fluidPage(
tags$div(id="simulationInputTable_divOutside", style="padding:0px;margin:0px",
tags$div(id="simulationInputTable_divInside1", style="padding:0px;margin:0px",
dq_handsontable_output("InputTable1", 9)),
tags$div(id="simulationInputTable_divInside2", style="padding:0px;margin:0px",
dq_handsontable_output("InputTable2", 9)),
tags$div(id="simulationInputTable_divInside3", style="padding:0px;margin:0px",
dq_handsontable_output("InputTable3", 9))
)
,
# actionButton("render", "Render HoT"),
actionButton("simulationInput_2", "Generate"),
fluidRow(id="bigRow", class="hidden",
style="height:100vh;background:#ff8f00;")
)
server = function(input, output) {
columns <- c(1,2,3,4)
hw <- c("Hello", "my", "funny", "world!")
cont = 0
observeEvent(input$simulationInput_2, {
cont <<- cont+1
data1 <- data.frame(A=hw, B=hw[c(2,3,4,1)], C=1:4, D=Sys.Date() - 0:3,
A2=hw, B2=hw[c(2,3,4,1)], C2=1:4, D2=Sys.Date() - 1:4,
stringsAsFactors = FALSE)
name = paste0("InputTable",cont)
divName = paste0("simulationInputTable_divInside",cont-1)
hide(divName)
dq_render_handsontable(
name,
data1, #"rand",
# filters = F, #c("S", "T", "R", "R"),
filters = rep(NA, ncol(data1)),
table_param = list(rowHeaders = NULL, selectCallback = TRUE))
})
observeEvent(input$random_select, toggle("bigRow"))
observeEvent(input$render, render_hot("InputTable"))
}
shinyApp(ui, server)
I am creating a Shiny application and when I am debugging with the browser() function I have errors with the if-statement
For example, if I write this (complete example below):
if(1 < 2)
{
h <- 5
}
And I receive this:
debug at #3: h <- 5
What could be wrong? It looks that if-statment doesn't work inside the browser.
Thanks
library(shiny)
# Global variables can go here
n <- 200
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
plotOutput('plot')
)
# Define the server code
server <- function(input, output) {
browser()
if(1 < 2)
{
h <- 5
}
output$plot <- renderPlot({
hist(runif(input$n))
})
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
I want to perform some actions like writing in a dataframe post i close the modaldialogue. Consider below example.
obs8<-observe({ req(input$Continue) if(input$password3 > 0 & input$password4 > 0 & (input$password3==input$password4)==TRUE & (is.validpw(input$password3))==TRUE & (is.validpw(input$password4))==TRUE){
showModal(modalDialog(
title=tags$h4(tags$strong("Password Changed Successfully")),
easyClose=FALSE,
footer=modalButton("Close")
))
I am trying to execute below code post the if condition is true and modal is displayed but no luck.
PASSWORD$Passord <- as.character(PASSWORD$Passord)
PASSWORD$Passord[PASSWORD$Passord==pwd] <- input$password3
PASSWORD$Passord <- as.factor(PASSWORD$Passord)
write.csv(PASSWORD,"<PATH>",row.names=FALSE)
I rewrote it as pure Shiny without all the password stuff and it works fine:
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
obs8<-observe({
req(input$bins)
if(input$bins > 40){
showModal(modalDialog(
title=tags$h4(tags$strong("Password Changed Successfully")),
easyClose=FALSE,
footer=modalButton("Close")
))
write.csv("1, 2, 1, 2", "<PATH>", row.names = FALSE)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
There's something wrong with the other stuff you're doing, but I can't tell what it is without a reproducible example
A txt.file data contaning a matrix of integers with 5 integers for each column and 1000 rows.
So if we press
data
we get this output
96520
69850
...
36884
We can get a random row by this
getnumbers <- sample(data,1, replace=FALSE)
By getting a random row in data the task is to enter the next row (by press a,b,c,d,e) and check if it's correct. So if we have the kth entry in data we want to get the k+1 entry in data by pressing the digits and see if it's correct.
check <- function(a,b,c,d,e){
if( identical( data[k+1] , c(a,b,c,d,e)) == TRUE ) {
return("Correct") }
else{return("Not correct")}
How can I implement this R code in Shiny so I can make it interactive using ubuntu ?
Hopefully I understood your question correctly but here's how you could do it:
library(shiny)
data <- matrix(round(runif(5*3)),ncol=3)
ui <- shinyUI(fluidPage(
fluidRow(
column(6, h4("Randomly Selected Row [k]")),
column(6, h4("Nex Row [k+1]"))
),
fluidRow(
column(6, textOutput("selRow")),
column(6, textOutput("nxtRow"))
),
fluidRow(
column(8, textInput("guessStr","Gues row: ")),
column(4, actionButton("guess","guess"))
),
textOutput("guessRes")
))
server <- shinyServer(function(input, output, session) {
# Make the current rownumber a reactive
r.num <<- 0
makeReactiveBinding('r.num')
# If rownumber changes update UI
observe({
if(is.null(r.num)) return(NULL)
output$selRow <- renderPrint({data[r.num,]})
output$nxtRow <- renderPrint({data[r.num+1,]})
})
# Get a row number by random, can't select last row
randomRow <- function(){
r.num <<- sample(1:nrow(data)-1, 1)
}
# If user presses guess button
observeEvent(input$guess, {
# I convert to numerical but this can be modified to work with characters to
input.str <- as.numeric(strsplit(input$guessStr,',')[[1]])
msg <- sprintf("You guessed that the next row is: %s",input$guessStr)
if( identical(data[r.num+1,], input.str)){
msg <- paste(msg," , this was correct!")
}
else{
msg <- paste(msg," , this was wrong")
}
output$guessRes <- renderPrint({msg})
})
# Initiate the guessing by randmozing a row
randomRow()
})
shinyApp(ui = ui, server = server)