Im new to R shiny and have ran into a weird issue. Im using a selectizeGroupUI function to have some filter inputs in the UI. for some reason one of my filter options always lines up oddly. Ive attached the code from my UI below along with a screenshot of the actual output. any help would be greatly appreciated.
ui <- fluidPage(theme = shinytheme("cerulean"),
titlePanel(h1("Powered")),
sidebarLayout(
sidebarPanel(
fluidRow(
checkboxGroupInput(
inputId = "vars",
label = h3("Filters:"),
choices = c("Program", "Site", "Buyer", "Part_Number"),
selected = c("Program", "Site", "Buyer", "Part_Number")
),
panel(
column(
width = 8,
selectizeGroupUI(
id = "my-filters",
params = list(
Program = list(inputId = "Program", label = h5("Program:")),
Buyer = list(inputId = "Buyer", label = h5("Buyer:")),
Site = list(inputId = "Site", label = h5("Site:")),
#Buyer = list(inputId = "Buyer", title = "Buyer:"),
Part_Number = list(inputId = "Part_Number", label = h5("Part Number:"))
), inline = FALSE
))),
status = "primary"),
fluidRow(
selectInput("select1","Part Tracker", choices = unique(mydataTS$Part_Number))
),
fluidRow(
tags$image(src = "B.png",height= "30%" , width= "30%" ,align = "left"),
tags$image(src = "A.png",height= "30%" , width= "30%" ,align = "right")
),
width = 4 ),
)
Also here is the server side
mydataTS1 <-excel_sheets("~/Desktop/Updated-Dashboard-code3:15/Prototype v5/Dashboard-TSData4.xlsx") %>% map_df(~read_xlsx("~/Desktop/Updated-Dashboard-code3:15/Prototype v5/Dashboard-TSData4.xlsx",.))
shinyServer(
function(input, output, session) {
vars_r <- reactive({input$vars})
res_mod <- callModule(module = selectizeGroupServer,id = "my-filters", data = mydataTS1, vars = vars_r, inline = FALSE)
print(res_mod)
output$table <- DT::renderDataTable({
req(res_mod())
res_mod()
})
OUTPUT OF UI
My apologies for the bad first question, I'm new to SO but learning.
Let me know if any other information is required.
Related
I created an application with the shinyMobile package and I would like to know if it is possible to make it available on the Play and Apple Store as a regular app.
My app:
library(shinyMobile)
if(interactive()){
library(shiny)
library(shinyMobile)
library(shinyWidgets)
shinyApp(
ui = f7Page(
title = "Tab layout",
f7TabLayout(
tags$head(
tags$script(
"$(function(){
$('#tapHold').on('taphold', function () {
app.dialog.alert('Tap hold fired!');
});
});
"
)
),
panels = tagList(
f7Panel(title = "Left Panel", side = "left", theme = "light", "Blabla", effect = "cover"),
f7Panel(title = "Right Panel", side = "right", theme = "dark", "Blabla", effect = "cover")
),
navbar = f7Navbar(
title = "Tabs",
hairline = FALSE,
shadow = TRUE,
leftPanel = TRUE,
rightPanel = TRUE
),
f7Tabs(
animated = FALSE,
swipeable = TRUE,
f7Tab(
tabName = "Tab1",
icon = f7Icon("envelope"),
active = TRUE,
f7Shadow(
intensity = 10,
hover = TRUE,
f7Card(
title = "Card header",
f7Stepper(
"obs1",
"Number of observations",
min = 0,
max = 1000,
value = 500,
step = 100
),
plotOutput("distPlot1"),
footer = tagList(
f7Button(inputId = "tapHold", label = "My button"),
f7Badge("Badge", color = "green")
)
)
)
),
f7Tab(
tabName = "Tab2",
icon = f7Icon("today"),
active = FALSE,
f7Shadow(
intensity = 10,
hover = TRUE,
f7Card(
title = "Card header",
f7Select(
inputId = "obs2",
label = "Distribution type:",
choices = c(
"Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp"
)
),
plotOutput("distPlot2"),
footer = tagList(
f7Button(label = "My button", href = "https://www.google.com"),
f7Badge("Badge", color = "orange")
)
)
)
),
f7Tab(
tabName = "Tab3",
icon = f7Icon("cloud_upload"),
active = FALSE,
f7Shadow(
intensity = 10,
hover = TRUE,
f7Card(
title = "Card header",
f7SmartSelect(
inputId = "variable",
label = "Variables to show:",
c("Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear"),
multiple = TRUE,
selected = "cyl"
),
tableOutput("data"),
footer = tagList(
f7Button(label = "My button", href = "https://www.google.com"),
f7Badge("Badge", color = "green")
)
)
)
)
)
)
),
server = function(input, output) {
output$distPlot1 <- renderPlot({
dist <- rnorm(input$obs1)
hist(dist)
})
output$distPlot2 <- renderPlot({
dist <- switch(
input$obs2,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm
)
hist(dist(500))
})
output$data <- renderTable({
mtcars[, c("mpg", input$variable), drop = FALSE]
}, rownames = TRUE)
}
)
}
I produce conventional shinyapps, but I would like to know if there is a way to make a shinMobile available on mobile platforms.
I even tried to do something, but nothing that came close to a satisfactory solution.
I have 4 dependent selection fields realized with selectizeGroup functions. I would like to limit the number of choices to only one item in each field. Is it possible?
The code below works like a charm for multiple selections in each field. I would like to limit the selections so only picking one is possible. Where and what parameter to add if it exists?
Here is my working selectizeGroup application:
ui <- fluidPage(
fluidRow(
column(
width = 10, offset = 1,
tags$h3("Filter data with selectize group"),
panel(
selectizeGroupUI(
id = "my-filters",
inline = TRUE,
params = list(
p_lev5 = list(
inputId = "p_lev5",
title = "Level 5",
placeholder = 'select',
options = list(limit = 1)
),
p_min = list(
inputId = "p_min",
title = "Group minor",
placeholder = 'select'
),
sm = list(
inputId = "sm",
title = "Manager",
placeholder = 'select'
),
rp = list(
inputId = "rp",
title = "Representative",
placeholder = 'select'
)
),
),
status = "primary"
),
plotOutput("plot1")
)
)
)
server = function(input, output, session) {
res_mod <- callModule(
module = selectizeGroupServer,
id = "my-filters",
data = df_prc_ch_minor,
vars = c("p_lev5", "p_min", "sm", "rp")
)
output$plot1 <-
renderPlot({
req( input[["my-filters-p_lev5"]],
input[["my-filters-p_min"]],
input[["my-filters-sm"]],
input[["my-filters-rp"]])
fn_plt_prcech(
input[["my-filters-p_lev5"]],
input[["my-filters-p_min"]],
input[["my-filters-sm"]],
input[["my-filters-rp"]])
})
}
shinyApp(ui, server)
The part options = list(limit = 1) is what I dream about, of course. Thank you for all the indications.
i have some a bunch of user inputs built using selectizeGroupUI from shinywidgets package .When i try to bookmark them i get no saved values.it seems hard to bookmark selectizeGroupUI.Does any one can help me?.
library(shiny)
library(shinyWidgets)
data("mpg", package = "ggplot2")
ui <- function(request) {
fluidPage(
fluidRow(
column(
width = 10,
offset = 1,
bookmarkButton(),
tags$h3("Filter data with selectize group"),
panel(
selectizeGroupUI(
id = "my-filters",
params = list(
manufacturer = list(inputId = "manufacturer", title = "Manufacturer:"),
model = list(inputId = "model", title = "Model:"),
trans = list(inputId = "trans", title = "Trans:"),
class = list(inputId = "class", title = "Class:")
)
), status = "primary"),
DT::dataTableOutput(outputId = "table"))))
}
server <- function(input, output, session) {
vals <- reactiveValues(sum = NULL)
res_mod <- callModule(
module = selectizeGroupServer,
id = "my-filters",
data = mpg,
vars = c("manufacturer", "model", "trans", "class"))
output$table <- DT::renderDataTable(res_mod())
# Bookmarking code --------------------------
onBookmark(function(state) {
state$values$filtered <- res_mod()
})
onRestore(function(state) {
vals$sum <- state$values$filtered
})
}
shinyApp(ui, server, enableBookmarking = "server")
In the given R shiny script below, I am trying to use a conditional panel with Picker Input shiny widget. There are three options in pickerInput, upon selection of "times" option, I wish to create new pickerInputs using a conditional panel, the following is possible using selectInput, but I need the same for Picker Input. Thanks and please help.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Picket",titleWidth = 290),
dashboardSidebar(width = 0),
dashboardBody(
tabsetPanel(type = "tab",
tabPanel("Overview", value = 1,
box(
column(1,
dropdown(
pickerInput(inputId = "resources",
label = "",
choices = c("cases",
"activities",
"times"),
choicesOpt = list(icon = c("fa fa-bars",
"fa fa-bars",
"fa fa-safari")),
options = list(`icon-base` = "")),
circle = FALSE, status = "primary", icon = icon("list", lib = "glyphicon"), width = "300px"
),
conditionalPanel(
condition = "input.Position == 'times' ",
dropdown(
pickerInput(inputId = "Id072",
label = "Select/deselect all options",
choices = c("A","Check-out", "b","c","d","e","f")
)))))),
id= "tabselected"
)
))
server <- function(input, output) {
}
shinyApp(ui, server)
Shouldnt this condition = "input.Position == 'times' ", be condition = "input.resources == 'times' ",?
The process_map() function in the server in the R shiny script creates the diagram image as below. My requirement is that there are two attributes "FUN" and "units" that are part of the performance() function. They have standard four values each that are available in the ui code below under PickerInput ID's Case4 and Case5. Currently, I am hard coding the value to create the map, can you help me to use the id's in the server code and make it dynamic such that when I select the value in the PickerInput, the formula fetches the value directly. Thanks and please help.
library(shiny)
library(shinydashboard)
library(bupaR)
library(processmapR)
library(lubridate)
library(dplyr)
library(edeaR)
library(shinyWidgets)
library(DiagrammeR)
ui <- dashboardPage(
dashboardHeader(title = "Diagram Plot",titleWidth = 290),
dashboardSidebar(width = 0),
dashboardBody(
tabsetPanel(type = "tab",
tabPanel("Overview", value = 1,
box(
column(1,
dropdown(
pickerInput(inputId = "resources",
label = "",
choices = c("Throughput Time"),
choicesOpt = list(icon = c("fa fa-bars",
"fa fa-bars",
"fa fa-safari")),
options = list(`icon-base` = "")),
circle = FALSE, status = "primary", icon = icon("list", lib = "glyphicon"), width = "300px"
),
conditionalPanel(
condition = "input.resources == 'Throughput Time' ",
tags$br(),
tags$br(),
tags$br(),
dropdown(
pickerInput(inputId = "Case4",
label = "Select the Process Time Summary Unit",
choices = c("min","max","mean","median"), options = list(`actions-box` = TRUE),
multiple = F),
circle = FALSE, status = "primary", icon = icon("eye-close", lib = "glyphicon"), width = "300px"
),
tags$br(),
tags$br(),
tags$br(),
dropdown(
pickerInput(inputId = "Case5",
label = "Select the Process Time Unit",
choices = c("mins","hours","days","weeks"), options = list(`actions-box` = TRUE),
multiple = F, selected = "days"),
circle = FALSE, status = "primary", icon = icon("eye-close", lib = "glyphicon"), width = "300px"
))),
title = "Process Map",
status = "primary",height = "575", width = "500",
solidHeader = T,
column(10,grVizOutput("State")),
align = "left")
),
id= "tabselected"
)))
server <- function(input, output) {
output$State <- renderDiagrammeR(
{
if(input$resources == "Throughput Time")
patients %>% process_map(performance(FUN = mean,units = "days"))
else
return()
})}
shinyApp(ui, server)
test this:
output$State <- renderDiagrammeR({
if(input$resources == "Throughput Time")
{
if(input$Case4=="mean"){
patients %>% process_map(performance(FUN = mean,units = input$Case5))}
else if(input$case4=="min"){
patients %>% process_map(performance(FUN = min,units = input$Case5))
}else if(input$case4=="max"){
patients %>% process_map(performance(FUN = max ,units = input$Case5))
}else{
patients %>% process_map(performance(FUN = median ,units = input$Case5))
}
}else
return()
})
or you can use this:
patients %>%
process_map(performance(FUN = eval(parse(text=input$Case4)) ,units = input$Case5))
enjoy;)
here is a sample:
library(shiny)
ui <- fluidPage(
selectInput(inputId = "func", label = "Choose The Function", choices = c("mean", "sum", "median"))
,
textOutput("text")
)
server <- function(input, output, session) {
main_data <- reactive({
data.frame(a= rnorm(100), b=rnorm(100) )
})
output$text <- renderText({
df <- main_data()
apply(df,2, FUN = eval(parse(text=input$func)) )
})
}
shinyApp(ui = ui, server = server)
You could use do.call to call a function from its name, see the example below. You can add arguments by adding them in the list in the do.call function, e.g. list(x,units=input$Case5).
library(shiny)
x=c(1,2,3,4,5,6,7)
ui <- fluidPage(
selectInput('select','Select Function: ', choices=c('mean','max','min','median')),
textOutput('text')
)
server <- function(input,output)
{
output$text <- renderText({
result = do.call(input$select, list(x))
paste0('The ', input$select, ' of [', paste(x,collapse=', '),'] is ', result)
})
}
shinyApp(ui,server)
Hope this helps!