Back again. Working on a project and I'm stuck. My click isn't working. I've tried every iteration and can't figure it out. Basically I want to select multiple lines in a datatable via a click, at which point I'll do some more filtering. The click I'm having issues with. Here's my code... Do you see anything I'm missing? Thanks.
library(forecast)
library(shiny)
library(shinythemes)
library(ggplot2)
library(dplyr)
library(scales)
library(DT)
library(forecast)
library(shiny)
library(shinythemes)
library(ggplot2)
library(dplyr)
library(scales)
library(DT)
source("NEW.R", local = TRUE)
branch1 <- unique(distinctlineitems$BRANCH)
ui <- navbarPage(
theme = shinytheme("cosmo"),
title = "EXPENDITURES",
tabPanel("TAB1",
sidebarLayout(
sidebarPanel(
checkboxGroupInput("branches",label = NULL,choices = branch1 ,selected = NULL),
actionButton('selectallB','Select All'),
textInput("words", "Search"),
h5("Separate keywords with commas."),
plotOutput("plot", width = "100%"),
plotOutput("season", width = "100%")),
# Show a plot of the generated distribution
mainPanel(
fluidRow(csvDownloadUI("dwnld", "DOWNLOAD"), style = "padding:10px"),
DT::dataTableOutput("table")
server <- function(input, output, session) {
branchfilter <- reactive({
filt <- distinctlineitems[distinctlineitems$BRANCH %in% input$branches,]
return(filt)
})
graphids <- reactive({
if(length(input$table_rows_selected) < 1) return(NULL)
id <- input$table_rows_selected
x <- branchfilter()$REMARKS[id]
})
output$table <- renderDataTable({
test <- DT::datatable(branchfilter(),
filter = "top",
rownames = FALSE,
selection = "multiple")
})
Turns out I was able to answer my own question on this one. Because I was trying to test it under a Reactive I was unable to see the output. In order to test, I had to wrap in an observe statement. So easy. After the fact. Thanks tobiaseli_te.
observe(print(graphids()))
Related
Below is a minimal reproducible example of my problem. What I need to do is render a datatable inside of a bootstrap card. In the example below, the rendering of output$somethingMore does just that. However, in my real world example, I have a slightly more complicated scenario where I cannot pass the data table to the card as I have done there.
Instead, I need to create a table rendered as in my output$brokenIdea example and then take that object and put it inside the card. Of course, my brokenIdea example below is indeed broken, or perhaps even more fallible than that in that's conceptually a bad idea.
However, I am looking to see if there is a solution to this idea so that output$brokenIdea can be created and then passed to the card in a renderUI.
For some context for those who might ask why, this is needed because I have an editable DT table in my real world app and (to my knowledge) being able to edit a data table as in this example here requires an observer paying attention to whether the table outputted in the browser is edited.
My code doesn't have those details in it, but the example above does show the context of the overall situation.
library(shiny)
library(bslib)
library(shinyWidgets)
library(DT)
card <- function(body, title) {
div(class = "card",
div(icon("chart-line", style = "color:white"), class = "card-header bg-success text-white text-center font-weight-bold", title),
div(class = "card-body d-flex justify-content-center", body)
)
}
ui <- fluidPage(
navbarPage(
theme = bs_theme(bootswatch = "flatly", version = 4),
title = 'Methods',
tabPanel('One'),
),
mainPanel(
h1('Hello World'),
uiOutput('something'),
br(),
DTOutput('somethingElse'),
br(),
uiOutput('somethingMore'),
#uiOutput('brokenIdea')
)
)
server <- function(input, output) {
output$something <- renderUI({
card('Test', 'Hello')
})
output$somethingElse <- renderDT({
tab <- data.frame(x= rnorm(5), y = rnorm(5))
DT::datatable(tab)
})
### I could do this
output$somethingMore <- renderUI({
tab <- data.frame(x= rnorm(5), y = rnorm(5))
out <- DT::datatable(tab)
card(out, 'Hi')
})
### But what I need is
output$brokenIdea <- renderUI({
card(output$somethingElse, 'Can this work')
})
}
shinyApp(ui, server)
Put your DTOutput('somethingElse')...) inside renderUI
library(shiny)
library(bslib)
library(shinyWidgets)
library(DT)
card <- function(body, title) {
div(class = "card",
div(icon("chart-line", style = "color:white"), class = "card-header bg-success text-white text-center font-weight-bold", title),
div(class = "card-body d-flex justify-content-center", body)
)
}
ui <- fluidPage(
navbarPage(
theme = bs_theme(bootswatch = "flatly", version = 4),
title = 'Methods',
tabPanel('One'),
),
mainPanel(
h1('Hello World'),
uiOutput('something'),
br(),
br(),
uiOutput('somethingMore'),
uiOutput('brokenIdea')
)
)
server <- function(input, output) {
output$something <- renderUI({
card('Test', 'Hello')
})
tab <- reactive({
invalidateLater(3000)
data.frame(x= rnorm(5), y = rnorm(5))
})
output$somethingElse <- renderDT({
DT::datatable(tab())
})
### I could do this
output$somethingMore <- renderUI({
tab <- data.frame(x= rnorm(5), y = rnorm(5))
out <- DT::datatable(tab)
card(out, 'Hi')
})
### But what I need is
output$brokenIdea <- renderUI({
card(DTOutput('somethingElse'), 'Can this work')
})
}
shinyApp(ui, server)
reactive is used in my example to hold the table. To simulate the table changing dynamically, I make it change every 5 seconds.
I have the shiny dashboard below in which I want to use a variable from my pickerInput() and create a plot. The issue is that if I use ,for example name or snID instead of input$DB the plot is created. But when I use input$DB I get: Warning: Error in table: all arguments must have the same length
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(ggplot2)
library(plotly)
ui <- dashboardPage(
header = dashboardHeader(title = "My dashboard"),
sidebar = dashboardSidebar(
uiOutput("dbs")
),
body = dashboardBody(
plotlyOutput("fn")
)
)
server <- function(input, output, session) {
sts<-c("Rev","Rev")
sID<-c("123","124")
snID<-c("23","34")
name<-c("s","d")
pe<-data.frame(sts,sID,snID,name)
output$dbs<-renderUI({
pickerInput("DB", "Select Database/s",
choices = c("name","snID"),
multiple = F,options = list(`actions-box` = TRUE),
selected = "name")
})
output$fn<-renderPlotly({
#2.2 MAKING A TABLE for public.exists
tbl<-table(pe[[input$DB]], pe$sts)
ggplotly(
ggplot(as.data.frame(tbl), aes(!!sym(input$DB), Freq, fill = sts))
)
})
}
shinyApp(ui, server)
I suspect your output$fn reactive is executing before input$DB has a value. Therefore, add
req(input$DB)
at the start of the reactive, and you should be OK.
In the absence of any demo input data, it's difficult to be definitive.
I am building an RShiny-app where I am creating a plot based on a data table which I can edit and another data table which I cannot. I eventually want to save all data points on the plot in a data table which I can display and export.
I have seen many ways to do this using ggplot (ie layer_data, ggplot_build), but no efficient ways when just using plot and lines. My plots will be getting quite complicated so it would be really helpful to find an easy way to do this rather than hardcoding everything in.
A very simple example of my code is below (Note: plots will be getting much more complicated than this. They will be line graphs, but I will just need the y values at each x value marked with a number on the x axis):
x <- data.frame('col_1' = c(1,2,3,4,5), 'col_2' = c(4,5,6,7,8))
y <- data.frame('col_1' = c(5,4,3,6,7), 'col_2' = c(1,2,3,4,5))
#import necessary libraries
library(shiny)
library(DT)
library(shinythemes)
library(rhandsontable)
#ui
ui <- fluidPage(theme = shinytheme("flatly"),
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
#display data
rHandsontableOutput('contents'),
#update plot button
actionButton("go", "Plot Update"),
width=4
),
mainPanel(
tabsetPanel(
#plot
tabPanel("Plot", plotOutput("plot_1")) )
))
)
#server
server <- function(input, output, session) {
#data table
output$table_b <- renderTable(x)
indat <- reactiveValues(data=y)
observe({
if(!is.null(input$contents))
indat$data <- hot_to_r(input$contents)
})
output$contents <- renderRHandsontable({
rhandsontable(indat$data)
})
#save updated data
test <- eventReactive(input$go, {
live_data = hot_to_r(input$contents)
return(live_data)
})
#plot
output$plot_1 <- renderPlot({
plot(x[,1],x[,2],col='red',type = 'l')
lines(test()[,1],x[,2], col='black', type='l')
# need a way to grab data from plot a create a table
})
}
shinyApp(ui, server)
I'm trying to upload a shiny app on Shiny.io. The app gets deployed and when the link is tried the app gets crashed by throwing an error Disconnected from Server. When I checked in the Logs of the dashboard, it says Error in the server: could not find function "server".
I was not able to find the solution for this. Documents and articles regarding the same shows that the Packages used could be one of the reasons for the error but I'm not able to find the list of packages that will be compatible or not.
These are the list of packages/libraries that are used in my app,
Shiny
Earth
ggplot2
Plot3D
visreg
rgl
zoo
Hmisc
dplyr
shinyBS
shinycssloaders
Thanks in Advance!!
UPDATE
Below are the reproducible ui.R and server.R scripts.
Upon debugging I found that this part of the code is error while deploying.
ui.R
library(shiny)
library(shinyBS)
library(shinycssloaders)
options(shiny.trace=TRUE)
shinyUI(pageWithSidebar(
fluidRow(
column(width = 4,height = 4,img(src='image.png', align = "left", height =
50, width = 200)),
column(8,titlePanel("Analysis"))
),
sidebarPanel(
br(),
fileInput("file1", label = (" Data "),multiple = F),
fluidRow(
column(12,align ="center", actionButton("button", "Analyze",style =
"background-color : skyblue", icon = icon("stats", lib =
"glyphicon"),width = 250 )))
),
mainPanel(
bsAlert("alert"),
br(),
fluidRow(
tabsetPanel(
tabPanel("Table",icon =
icon("table"),withSpinner(dataTableOutput('table'), type =
getOption("spinner.type", default = 8) ))
)
)
)
))
server.R
library(shiny)
library(shiny)
library(earth)
library(ggplot2)
library(plot3D)
library(visreg)
library(rgl)
library(zoo)
library(Hmisc)
library(dplyr)
library(gridExtra)
options(shiny.maxRequestSize=30*1024^2)
options(shiny.trace=TRUE)
if (interactive()){
shinyServer(function(input, output,session) {
dataframe <- reactive( {
### Create a data frame reading data file to be used by other
functions..
inFile <- input$file1
data1 <- read.csv(inFile$datapath, header = TRUE)
})
table1<- eventReactive(input$button, dataframe())
output$table <- renderDataTable({table1()})
})
}
Thanks!
Finally I was able to debug the code and find a solution for the error.
From Server.R delete the statement if (interactive()) and delete session parameter from the shinyServer(function(input,output,session)).
Hence deployed without any error.
Replace the following server.R script and it should work fine.
library(shiny)
library(shiny)
library(earth)
library(ggplot2)
library(plot3D)
library(visreg)
library(rgl)
library(zoo)
library(Hmisc)
library(dplyr)
library(gridExtra)
options(shiny.maxRequestSize=30*1024^2)
options(shiny.trace=TRUE)
shinyServer(function(input, output) {
dataframe <- reactive( {
### Create a data frame reading data file to be used by other functions..
inFile <- input$file1
data1 <- read.csv(inFile$datapath, header = TRUE)
})
table1<- eventReactive(input$button, dataframe())
output$table <- renderDataTable({table1()})
})
Hi The given code generates a basic table using DT representing list of letters and percentages. I wish to add a slider within the DT tables, such that when I place the slider on specific percentage, I get the rows corresponding to that percentage and below. Thanks and please help.
## app.R ##
library(shiny)
library(shinydashboard)
library(DT)
library(scales)
ui <- fluidPage(
titlePanel("Basic datatable"),
# Create a new row for the table.
fluidRow(
DT::dataTableOutput("table")
)
)
server <- function(input, output) {
# Filter data based on selections
output$table <- DT::renderDataTable(DT::datatable({
a = percent(1:10)
b = c("aa","bbb","cc","dd","ee","ff","gg","ff","gg","hh")
data1 = data.frame(a,b)
data1
}))
}
shinyApp(ui, server)
Here's a way to implement sliderInput and dynamically change the datatable in server. There are other ways to control the datatable dynamically, but I am posting this code to match your exact requirement.
library(shiny)
library(shinydashboard)
library(DT)
a <- percent(1:10)
b <- c("aa","bbb","cc","dd","ee","ff","gg","ff","gg","hh")
data1 <- data.frame(a,b)
a_temp <- as.numeric(gsub("%|,", "", a)) #Removing % and , from the data frame
data1_temp <- data.frame(a_temp,b) #New data frame with integer values to reference row number required later
if(interactive()){
shinyApp(
ui <- fluidPage(
titlePanel("Basic datatable"),
sliderInput("slider1", "Choose Range of Percentage",
min = a_temp[1],
max = a_temp[10],
value = c(a_temp[1], a_temp[10]),
step = 100
),
fluidRow(
DT::dataTableOutput("table")
)
),
server = function(input, output){
minRowVal <- reactive({
which(grepl(input$slider1[[1]], data1_temp$a)) #Retrieve row number that matches selected range on sliderInput
})
maxRowVal <- reactive({
which(grepl(input$slider1[[2]], data1_temp$a)) #Retrieve row number that matches selected range on sliderInput
})
observeEvent(input$slider1, {
output$table <- DT::renderDataTable({
data1[minRowVal():maxRowVal(), ]
})
})
}
)
}
The following code is adapted from here.
library(DT)
DT::datatable(
data.frame(
a = 1:10/100,
b = letters[1:10]
),
filter = "top"
) %>% formatPercentage('a')