I have selectInputs in my Shiny application but they leave a lot of blank gaps.
selectInput("vicNation", "Select victim nationality: ",
choices = sort(unique(newngo$Victim.Nationality)), selected = NULL,
multiple = TRUE, selectize = TRUE, width = NULL, size = NULL)
When I run it i get:
Is it possible to move the selectInput to beside the text so there is less blank spaces
As mentioned in the comments:
ui <- fluidPage(
fluidRow(column(3,
"Select victim nationality: "),
column(6,
selectInput("vicNation", label = NULL,
choices = c('German','English','French'), selected = NULL,
multiple = TRUE, selectize = TRUE, width = NULL, size = NULL)
)
)
)
Related
I'm trying to create a data collection tool on R Shiny where the user can select as many categories as apply to them and then enter values for each. I've used uiOutput to allow the user to add a new category choice after clicking an action button.
For some reason, the numericInput that is created after clicking the action button will deselect after a split-second when the user is typing in a number, so it only catches one digit and you have to click it repeatedly to type in a full number.
I've tried changing the numericInput to a textInput and the same thing happens, so it's something to do with how I'm generating the uiOutput in the server, does it continually refresh and is there any way to stop it?
Example code given below, click on the new row button then try typing in the numericInput and you'll see. I have been stuck on this for ages and can't find any other questions similar so any help massively appreciated, thanks
library(tidyverse)
library(shiny)
library(shinyjs)
ui <- fluidPage(
fluidRow(wellPanel(h3("Category and quantity input"))),
wellPanel(fluidRow(column(width=4,selectInput("type0",label = h4("type"), choices= list("choice1" = 1,"choice2" = 2, "choice3"=3))),
column(width=4,numericInput("quantity0", label = h4("quantity"), value = 0, min=0)),
column(width=4,actionButton("New_row",label="Add new row"))),
uiOutput("new_row_added")
))
server <- function(input, output) {
ids <<- NULL
observeEvent(input$New_row,{
if (is.null(ids)){
ids <<- 1
}else{
ids <<- c(ids, max(ids)+1)
}
output$new_row_added <- renderUI({
tagList(
lapply(1:length(ids),function(i){
check_input_type <- paste0("type", ids[i])
check_input_quantity <- paste0("quantity", ids[i])
if(is.null(input[[check_input_type]])){
# Create a div that contains 3 new sub divs
div(fluidRow(column(width=4,
div(selectInput(paste0("type",ids[i]),label = "", choices= list("choice1" = 1,"choice2" = 2, "choice3"=3)))),
column(width=4,div(numericInput(paste0("quantity",ids[i]), label = "", value = 00, min=0))))
)
} else {
# Create a div that contains 3 existing sub divs
div(fluidRow(column(width=4,
div(selectInput(paste0("type",ids[i]),label = "", choices= list("choice1" = 1,"choice2" = 2, "choice3"=3), selected = input[[check_input_type]]))),
column(width=4,div(numericInput(paste0("quantity",ids[i]), label = "", min=0, value = input[[check_input_quantity]]))))
)
}
})
)
})
})
}
shinyApp(ui = ui, server = server)
You need to isolate input[[check_input_type]]. By doing isolate(input[[check_input_type]]). If not, every time a new number is inserted inside that input, the ui will re render and cause the deselection.
App:
library(tidyverse)
library(shiny)
library(shinyjs)
ui <- fluidPage(
fluidRow(wellPanel(h3("Category and quantity input"))),
wellPanel(
fluidRow(
column(width = 4, selectInput("type0", label = h4("type"), choices = list("choice1" = 1, "choice2" = 2, "choice3" = 3))),
column(width = 4, numericInput("quantity0", label = h4("quantity"), value = 0, min = 0)),
column(width = 4, actionButton("New_row", label = "Add new row"))
),
uiOutput("new_row_added")
)
)
server <- function(input, output) {
ids <<- NULL
observeEvent(input$New_row, {
if (is.null(ids)) {
ids <<- 1
} else {
ids <<- c(ids, max(ids) + 1)
}
output$new_row_added <- renderUI({
tagList(
lapply(1:length(ids), function(i) {
check_input_type <- paste0("type", ids[i])
check_input_quantity <- paste0("quantity", ids[i])
if (is.null(isolate(input[[check_input_type]]))) {
# Create a div that contains 3 new sub divs
div(fluidRow(
column(
width = 4,
div(selectInput(paste0("type", ids[i]), label = "", choices = list("choice1" = 1, "choice2" = 2, "choice3" = 3)))
),
column(width = 4, div(numericInput(paste0("quantity", ids[i]), label = "", value = 00, min = 0)))
))
} else {
# Create a div that contains 3 existing sub divs
div(fluidRow(
column(
width = 4,
div(selectInput(paste0("type", ids[i]), label = "", choices = list("choice1" = 1, "choice2" = 2, "choice3" = 3), selected = isolate(input[[check_input_type]])))
),
column(width = 4, div(numericInput(paste0("quantity", ids[i]), label = "", min = 0, value = input[[check_input_quantity]])))
))
}
})
)
})
})
}
shinyApp(ui = ui, server = server)
I understand scrollY should constrain the height of the data table. I have a data table configured as below, but when I choose a page size of 100, the table just expands. I want the table to remain visible on the page, with the page navigation at the bottom always visible, and the user to have to scroll through the content.
output$search_results <- DT::renderDataTable(filtered_df(),
server=TRUE,
extensions = c('Buttons', 'ColReorder', 'FixedColumns','FixedHeader', 'KeyTable'),
options = list(
#dom = 'Blfrtip',
dom = 'Blptilp',
colReorder = TRUE,
buttons = c('copy', 'csv', 'excel'),
autoWidth = TRUE,
scrollX = TRUE,
scrollY = "500px",
fixedColumns = list(leftColumns = 2),
fixedHeader = TRUE,
keys=TRUE,
lengthMenu = c(5,10,20,50,100),
columnDefs = list(list(width = '500px', targets = c(0,1)))
)
)
I am trying to build a shiny app with shinyMobile, and storing the results using shinyStore, I have been looking at several answers but I haven't been able to fix this. I think there might be an issue with the multiple option.
Here is the code:
library(shiny)
library(shinyMobile)
library(shinyStore)
Species_List <- structure(list(Scientific_name = c("Juncus alpinoarticulatus ssp. nodulosus",
"Diphasiastrum complanatum ssp. complana-tum", "Rubus macrophyllus",
"Equisetum scirpoides", "Trifolium hybridum ssp. hybridum", "Narthecium ossifragum",
"Peucedanum oreoselinum", "Sonchus oleraceus", "Juncus subnodulosus",
"Minuartia viscosa"), Danish_name = c("siv, stilk-", "ulvefod, flad",
"brombær, storbladet", "padderok, tråd-", "kløver, alsike-",
"benbræk", "svovlrod, bakke-", "svinemælk, almindelig", "siv, butblomstret",
"norel, klæbrig")), row.names = c(NA, -10L), class = "data.frame")
shinyApp(
ui = f7Page(
title = "Species app",
f7SingleLayout(
navbar = f7Navbar(
title = "Select Species",
hairline = TRUE,
shadow = TRUE
),
toolbar = f7Toolbar(
position = "bottom",
f7Link(label = "Link 1", href = "https://www.google.com"),
f7Link(label = "Link 2", href = "https://www.google.com")
),
initStore("store", "shinyStore-ex1"),
# A button to save current input to local storage
actionButton("save", "Save", icon("save")),
# A button to clear the input values and local storage
actionButton("clear", "Clear", icon("stop")),
# main content
f7Shadow(
intensity = 16,
hover = TRUE,
f7SmartSelect(inputId = "SpeciesListSc",
label = "Select all species",
multiple = TRUE,
choices = unique(Species_List$Scientific_name),
virtualList = T,
openIn = "sheet")
)
)
),
server = function(input, output, session) {
observe({
if (input$save <= 0){
updateF7SmartSelect(session, inputId = "SpeciesListSc", selected = isolate(input$store)$SpeciesListSc, choices = unique(Species_List$Scientific_name), multiple = TRUE)
}
})
observe({
if (input$save > 0){
updateStore(session, name = "SpeciesListSc", isolate(input$SpeciesListSc))
}
})
}
)
I have a datatable where the footer has "Previous/Next" text. Currently it is overlapping the "Displaying 1 of 15" text. Is there a way to move this so I dont get an over lap?
Here is a picture as well as the code. I am not very familiar with html/java script so if you could provide an answer explaining why you are using the specific code that would be greatly appreciated
library(shiny)
library(bs4Dash)
library(DT)
x = data.frame(one = rep("Hey how is everyones day? I need some help on this shiny application and learn how to use some of the features on datatable.", 10),
two = rep("this is the second column of text. ", 10),
three = rep("this is the third column of text", 10))
ui = bs4DashPage(
old_school = FALSE,
sidebar_min = TRUE,
sidebar_collapsed = FALSE,
controlbar_collapsed = FALSE,
controlbar_overlay = TRUE,
title = "Basic Dashboard",
navbar = bs4DashNavbar(),
sidebar = bs4DashSidebar(),
controlbar = bs4DashControlbar(),
footer = bs4DashFooter(),
body = bs4DashBody(
DTOutput("table")
)
)
server = function(input, output) {
output$table = renderDataTable({
datatable(x, rownames = F, style = "bootstrap", extensions = 'Responsive', options = list(
#dom = 't'
))
})
}
shinyApp(ui, server)
When i run the same code on shiny dashboard, it comes out the way I would want it to look like. So i believe it is something to do with Bs4Dash styling sheet. Below is how it looks with shinydashboard
You need to redraw your table after initialization.
$('#tableIdHere').DataTable().draw();
You can try this out , Hope it will sove your problem.
library(shiny)
library(bs4Dash)
library(DT)
x = data.frame(one = rep("Hey how is everyones day? I need some help on this shiny application and learn how to use some of the features on datatable.", 10),
two = rep("this is the second column of text. ", 10),
three = rep("this is the third column of text", 10))
ui = bs4DashPage(
old_school = FALSE,
sidebar_min = TRUE,
sidebar_collapsed = FALSE,
controlbar_collapsed = FALSE,
controlbar_overlay = TRUE,
title = "Basic Dashboard",
navbar = bs4DashNavbar(),
#sidebar = bs4DashSidebar(),
controlbar = bs4DashControlbar(),
footer = bs4DashFooter(),
body = bs4DashBody(
DTOutput("table")
)
)
server = function(input, output) {
output$table = renderDataTable({
datatable(x, rownames = F, extensions = 'Responsive', options = list(
#dom = 't'
))
})
}
shinyApp(ui, server)
I have only removed style = "bootstrap" from the renderDataTable and that serve the perpose
Your css is overwritten with some other default css. Please check if your classes are similarly named or clashing with each other.
I'm trying to eliminate the space between this table and the left side of browser window, but when I do, it messes up the spacing of the nav bar links and title.
How can I remove padding/margin on the excelR table, without altering the padding/margin of the navbar/ui/li elements?
library(shiny)
library(excelR)
shinyApp(
ui = navbarPage("title", selected = "main",
position = "fixed-top",
tags$style(type="text/css", "body {padding-top: 70px;}"),
tags$head(
tags$style(
"body {overflow-y: hidden;}"
)
),
tags$head(
tags$style(type = "text/css", ".container-fluid {padding-left:0px;
padding-right:0px; margin-right:0px; margin-left:0px;}")
),
tabPanel("main", id = "main",
fluidPage(
excelOutput("table", width = "100%", height = "1000px")
#htmlOutput("table", width = "100%", height = "500px")
)
)
),
server = function(input, output, session) {
output$table <-renderExcel(
excelTable(
data = iris,
autoColTypes = FALSE,
autoFill = TRUE,
fullscreen = FALSE,
lazyLoading = TRUE,
search = TRUE,
tableHeight = "800px",
pagination <- NULL
)
)
}
)
You can simply add this additional css to your code:
tags$style(type = "text/css", ".navbar{padding-left:15px;
padding-right:15px ; margin-right:auto; margin-left:auto;}")
),
Hope this helps!