All of the buttons in a shiny app I am making use shinyWidgets. I also use a fileInput button and I would like the button of this to be in the same style as my shinyWidgets::actionBttn. Is there a way of doing this?
library(shiny)
library(shinyWidgets)
shinyUI(fluidPage(
# Application title
titlePanel("Uploac a file"),
fileInput("Myfile",label="",multiple = FALSE),br(),
actionBttn("textPrep",label = "Browse")
))
You can do something like this:
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
# Application title
titlePanel("Upload a file"),
fileInput("Myfile", label="", multiple = FALSE),
br(),
actionBttn("textPrep", label = "Browse")
)
server <- function(input, output){
addCssClass(class = "bttn bttn-unite bttn-default bttn-no-outline",
selector = ".btn-file")
}
shinyApp(ui, server)
Related
So im trying to use the fileInput widget in Shiny to upload a video and then have that video be displayed in the mainPanel. Im new to R and have used a mixture of examples to try to find a solution so if there's any code errors then that'll be why. Thanks in advance for any help!
My ui script:
library(shiny)
shinyUI(fluidPage(
headerPanel(title = 'Shiny Example'),
sidebarLayout(
sidebarPanel(
fileInput("file", "Choose Video File", accept = ".mp4"),
uiOutput("selectfile")
),
mainPanel(
uiOutput('video')
)
)
)
)
My server script:
library(shiny)
shinyServer(function(input, output) {})
Works with Firefox:
library(shiny)
options(shiny.maxRequestSize = 30*1024^2)
ui <- fluidPage(
headerPanel(title = 'Shiny Example'),
sidebarLayout(
sidebarPanel(
fileInput("file", "Choose Video File", accept = ".mp4")
),
mainPanel(
uiOutput('video')
)
)
)
server <- function(input, output){
Video <- eventReactive(input[["file"]], {
input[["file"]][["datapath"]]
})
output[["video"]] <- renderUI({
req(Video())
file.rename(Video(), "www/myvideo.mp4")
tags$video(
width="320", height="240", controls="",
tags$source(src="myvideo.mp4", type="video/mp4")
)
})
}
shinyApp(ui, server)
You must have a www subfolder.
I have the shiny app below with 2 actionButton(). I want when I press Datatable the Datatable2 to be disabled and when I click again on Datatable the Datatable2 to be available for pressing again.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("exc","Datatable"),
actionButton("exc2","Datatable2")
),
mainPanel(
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
This is really straightforward if you use the toggleState() function from the shinyjs package.
The help for that function gives you an extremely similar situation. In your case:
library(shiny)
ui <- fluidPage(
useShinyjs(), #this activates shinyjs
sidebarLayout(
sidebarPanel(
actionButton("exc","Datatable"),
actionButton("exc2","Datatable2")
),
mainPanel(
)
)
)
server <- function(input, output) {
observeEvent(input$exc, {
toggleState("exc2") #identify the element to toggle between active/inactive
})
}
shinyApp(ui = ui, server = server)
In my current application I am using a navlistPanel similar to the one below and I was wondering whether it would be possible to add a selectInput UI element to the navlist?
I have tried this in my ui.R but it doesn't work:
fluidPage(
titlePanel("Application Title"),
navlistPanel(
"Header",
tabPanel("First"),
tabPanel("Second"),
tabPanel("Third")
# selectInput(inputId, label, choices, selected = NULL) <- I've tried this but it doesn't work
)
)
Any solutions/workarounds are welcome.
I was wondering whether using sidebarLayout + sidebarPanel would work where the sidebarPanel imitates the behaviour of a navlistPanel but wasn't able to implement it.
A clean solution will be difficult, but how about something like this:
library(shiny)
shinyApp(
ui <- fluidPage(
titlePanel("Application Title"),
navlistPanel("Header", id = "navOut",
tabPanel("First", "First"),
tabPanel(selectInput("navSel", "Selection:", c("b", "c")), textOutput("txt"))
)
),
server <- shinyServer(function(input, output){
output$txt <- renderText(input$navSel)
})
)
If you are okay with using shinydashboard, it is fairly simple.
library(shiny)
library(shinydashboard)
rm(list=ls)
######/ UI Side/######
header <- dashboardHeader(title = "Test")
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("First Tab",tabName = "FTab", icon = icon("globe")),
menuItem("Second Tab",tabName = "STab", icon = icon("star"))
),
selectInput("navSel", "Selection:", c("b","c"))
)
body <- dashboardBody()
ui <- dashboardPage(header, sidebar, body)
######/ SERVER Side/######
server <- function(input, output, session) {
}
shinyApp(ui, server)
i need to give flexibility to app user so that they can edit/modify a table . I am using the below codes
UI code:
tabItem(tabName = "manual_override",
fluidRow(
editableDTUI("table1")
Server Codes:
callModule(editableDT,"table1",data=reactive(bigtable),inputwidth=reactive(100))
but the problem is that bigtable has more than 15 columns to display and the horizontal scroll is not appearing
I have tried the same with library(DT) with 20 col.
If that solves your problem.
ui.r
library(shiny)
library(DT)
shinyUI(
fluidPage(
navbarPage("Big file upload + Horizental Scrolling",
tabPanel("Data Import",
fluidRow(
fileInput("file","Upload Your CSV",multiple = FALSE),
column(6,
div(style = 'overflow-x: scroll', DT::dataTableOutput('csv_data')))
)
)
)
)
)
server.r
library(shiny)
shinyServer(function(input, output) {
csv_data_fun<-eventReactive(input$file,{
df<-read.csv(input$file$datapath,
header =TRUE)
return(df)
})
output$csv_data<-DT::renderDataTable({
DT::datatable(csv_data_fun(),rownames = FALSE)%>%formatStyle(columns=colnames(csv_data_fun()),background = 'white',color='black')
})
})
output Screen
Please check whether you want this
I have done with editDT, But this time with default mtcars dataset.
Added the code in UI part
div(style = 'overflow-x: scroll',editableDTUI("table1"))
New Code
library(shiny)
library(editData)
if (interactive()) {
ui <- fluidPage(
textInput("mydata","Enter data name",value="mtcars"),
column(6,
div(style = 'overflow-x: scroll',editableDTUI("table1")
)
)
)
server <- function(input, output) {
df=callModule(editableDT,"table1",dataname=reactive(input$mydata),inputwidth=reactive(170))
output$test=renderPrint({
str(df())
})
}
shinyApp(ui, server)
}
Please check this time if this solves your problem. You can tweak the things to change according to your requirements.
Please accept the answer if solves your issue.
I just want to remove text value (put blank text) of a textInput after clicking on it. I tryed "updateTextInput" or "onclick" from shinyjs without success, any idea ?
if (interactive()) {
ui <- fluidPage(
titlePanel("test textInput clicking"),
sidebarLayout(
sidebarPanel(
textInput("sequenceTextInput", label = "", value = "Enter sequence
here...")
),
mainPanel(
)
))
server = function(input, output) {
}
shinyApp(ui, server)
}
You can get this to work with shinyjs as follows:
library(shinyjs)
ui <- fluidPage(
titlePanel("test textInput clicking"),
sidebarLayout(
sidebarPanel(
useShinyjs(),
textInput("sequenceTextInput", label = "", value = "Enter sequence here...")
),
mainPanel(
)
))
server = function(input, output,session) {
onclick("sequenceTextInput",updateTextInput(session,"sequenceTextInput",value=""))
}
shinyApp(ui, server)
Hope this helps!