I have Shinydashboard which basically take input file from user and displays 2 plots at top and datatable at the bottom of the dashboard. Next, I added infobox at the top of the Box1 so that when users clicks on infobox, the plot2 gets updated after user clicks on infobox with new plot, otherwise dashboard displays default plot. Below is reproducible example. I am following gogol comment/code here . However, I am not sure how to proceed with infobox coding for server side as the question was related to Valuebox ?
Overall, ask is If user clicks on "Infobox" then plot 2 (Box2 in this case) will get updated with other plot (ex. hp vs weight) otherwise the plot2 will be default. In this case, it will be Pressure vs temperature plot. Also, If the plot2 is updated then when user clicks on plot2 the updated plot should get displayed in Modal dialog otherwise the default plot should get displayed in modal dialog.
Thanks in advance for your time and efforts!
library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(shinyBS)
library(DT)
ui<-dashboardPage(
dashboardHeader(title="Missing",titleWidth = 230),
dashboardSidebar(
fileInput("file1", "Upload CSV File below",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
)),
dashboardBody(
fluidRow(
tags$head(tags$style(HTML('.info-box {min-height: 45px;} .info-box-icon {height: 45px; line-height: 45px;} .info-box-content {padding-top: 0px; padding-bottom: 0px;}'))),
infoBox(" ", fill = TRUE,width = 7,value = tags$p("Infobox", style = "font-size: 100%;")),
infoBoxOutput("Infobox"),
div(id="popme1", box(plotOutput("Plot1"),collapsible = TRUE,title="Plot 1",solidHeader = TRUE,status = "primary")),
bsModal("modalExample1", "Plot1", "popme1", size = "large", plotOutput("Plot11")),
div(id="popme2", box(plotOutput("Plot2"),collapsible=TRUE,title="Plot 2",solidHeader = TRUE,status = "primary")),
bsModal("modalExample2", "Plot2", "popme2", size = "large", plotOutput("Plot22")),
div(id="popme3", fluidRow(column(width=8,box(DTOutput("Missing_datatable"), width = NULL,collapsible = TRUE)) )),
bsModal("modalExample3", "Data Table", "popme3", size = "large", DTOutput("Missing_datatable2"))
)
)
)
server<- function(input, output,session) {
output$Plot1 <- renderPlot({
plot(cars)
})
output$Plot11 <- renderPlot({
plot(cars)
})
output$Plot22 <- renderPlot({ plot(pressure)})
output$Plot2 <- renderPlot({ plot(pressure) })
output$Missing_datatable <- renderDT({iris[1:7,]})
output$Missing_datatable2 <- renderDT({iris[1:7,]})
}
# Run the application
shinyApp(ui = ui, server = server)
We can use actionLink and wrap it around infoBox. This will generate an input in the example below named input$info_clk which starts at 0 and gos up with each click. To turn this into an control-flow we use the remainder of the devision with 2 in an if statement if(input$info_clk %% 2):
library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(shinyBS)
library(DT)
ui<-dashboardPage(
dashboardHeader(title="Missing",titleWidth = 230),
dashboardSidebar(
fileInput("file1", "Upload CSV File below",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
)),
dashboardBody(
fluidRow(
tags$head(
tags$style(HTML('.info-box {min-height: 45px;} .info-box-icon {height: 45px; line-height: 45px;} .info-box-content {padding-top: 0px; padding-bottom: 0px;}')
)
),
actionLink("info_clk",
infoBox(" ", fill = TRUE, width = 7, value = tags$p("Infobox", style = "font-size: 100%;"))
),
# infoBoxOutput("Infobox"),
div(id="popme1", box(plotOutput("Plot1"),collapsible = TRUE,title="Plot 1",solidHeader = TRUE,status = "primary")),
bsModal("modalExample1", "Plot1", "popme1", size = "large", plotOutput("Plot11")),
div(id="popme2", box(plotOutput("Plot2"),collapsible=TRUE,title="Plot 2",solidHeader = TRUE,status = "primary")),
bsModal("modalExample2", "Plot2", "popme2", size = "large", plotOutput("Plot22")),
div(id="popme3", fluidRow(column(width=8,box(DTOutput("Missing_datatable"), width = NULL,collapsible = TRUE)) )),
bsModal("modalExample3", "Data Table", "popme3", size = "large", DTOutput("Missing_datatable2"))
)
)
)
server<- function(input, output,session) {
output$Plot1 <- output$Plot11 <- renderPlot({
plot(cars)
})
output$Plot2 <- output$Plot22 <- renderPlot({
if (input$info_clk %% 2L) {
plot(mtcars$wt, mtcars$hp)
} else {
plot(pressure)
}
})
output$Missing_datatable <- renderDT({iris[1:7,]})
output$Missing_datatable2 <- renderDT({iris[1:7,]})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
I want to build an app with the checkbox asking whether to show additional text comments under the figures.
I would like to display set of plots with or without an explanation - this shall be left to the user, whether they need more info or not.
Here are some dummy comments:
#info for box1:
"This is the red histogram"
#info for box2:
"This is the blue histogram"
Here is a dummy app:
library(shiny)
library(shinydashboard)
data <- rnorm(10000, mean=8, sd=1.3)
variable <- "This is the blue histogram"
shinyApp(
ui = dashboardPage(
skin = "black",
dashboardHeader(
title = "Example app",
titleWidth = 300
),
dashboardSidebar(
checkboxInput("show_comment",
label = "Show comment?",
value = FALSE)
),
dashboardBody(
box(title = "First histogram",
status= "warning",
plotOutput("plot1", height=300)
),
box(title = "Second histogram",
status= "warning",
plotOutput("plot2", height=300),
hidden(
div(id='text_div',
verbatimTextOutput("text")))
)
)
),
server = function(input, output) {
output$plot1 <- renderPlot({
hist(data, breaks=40, col="red", xlim=c(2,14), ylim=c(0,800))
})
output$plot2 <- renderPlot({
hist(data, breaks=20, col="blue", xlim=c(2,34), ylim=c(0,1000))
})
observeEvent(input$show_comment, {
toggle('text_div')
output$text <- renderText({ paste0(variable)})
})
}
)
The above code does not work properly - it displays comment no matter if the checkbox is clicked or not. I'd like to make it work, therefore seek for advice here.
I was trying to do it on my own using following hints, to no avail:
How to use shiny actionButton to show & hide text output?
This syntax is too complex for me as I am a beginner with shiny, so I was not able to troubleshoot my problem with hints from this thread:
Show and hide text in modularized shiny app based on actionButton() and shinyJS()
I also tried ths:
Hide/show outputs Shiny R
And here is the attempt of using above hint:
library(shiny)
library(shinydashboard)
data <- rnorm(10000, mean=8, sd=1.3)
variable <- "This is the blue histogram"
shinyApp(
ui = dashboardPage(
skin = "black",
dashboardHeader(
title = "Example app",
titleWidth = 300
),
dashboardSidebar(
checkboxInput("show_comment",
label = "Show comment?",
value = FALSE)
),
dashboardBody(
box(title = "First histogram",
status= "warning",
plotOutput("plot1", height=300)
),
box(title = "Second histogram",
status= "warning",
plotOutput("plot2", height=300),
renderText("text", span(variable))
)
)
),
server = function(input, output) {
output$plot1 <- renderPlot({
hist(data, breaks=40, col="red", xlim=c(2,14), ylim=c(0,800))
})
output$plot2 <- renderPlot({
hist(data, breaks=20, col="blue", xlim=c(2,34), ylim=c(0,1000))
})
observeEvent(input$show_comment, {
# every time the button is pressed, alternate between hiding and showing the plot
toggle("text")
})
}
)
I want to put the comments inside the same box, along with the plot - this is why I am trying to enclose it with the box command. However, if it is impossible - I would be glad of any other solution.
First time I use shinyjs so there might be a better approach. But as I understand it from the docs you first have to add useShinyjs() in your UI code
in order for all other shinyjs functions to work.
Second, there is no need to wrap the div for your comment in hidden(). Third, instead of using observeEvent I followed the example in ?toggle and use an observe where I add the state of your checkbox as the condition to trigger the toggle.
library(shiny)
library(shinydashboard)
library(shinyjs)
data <- rnorm(10000, mean = 8, sd = 1.3)
variable <- "This is the blue histogram"
shinyApp(
ui = dashboardPage(
skin = "black",
dashboardHeader(
title = "Example app",
titleWidth = 300
),
dashboardSidebar(
checkboxInput("show_comment",
label = "Show comment?",
value = FALSE
)
),
dashboardBody(
box(
title = "First histogram",
status = "warning",
plotOutput("plot1", height = 300)
),
box(
title = "Second histogram",
status = "warning",
plotOutput("plot2", height = 300),
div(id = "text_div",
verbatimTextOutput("text")
)
)
),
useShinyjs()
),
server = function(input, output) {
output$plot1 <- renderPlot({
hist(data, breaks = 40, col = "red", xlim = c(2, 14), ylim = c(0, 800))
})
output$plot2 <- renderPlot({
hist(data, breaks = 20, col = "blue", xlim = c(2, 34), ylim = c(0, 1000))
})
observe({
toggle(id = "text_div", condition = input$show_comment)
output$text <- renderText({
paste0(variable)
})
})
}
)
#>
#> Listening on http://127.0.0.1:7437
I am creating ShinyDashboard which reads the csv file inputted by user and displays 2 plots at the top and datatable at the bottom of dashboards. For this I used box to built my Dashboard. Next, I would like create popup for each boxes so the box output displays bigger in size to the enduser. For this I am following the post mentioned here. However, whenever I use ModalDialog under ui code as suggested by Pork Chop. The table output doesn't return anything. Not sure if I am using ModalDialog correctly ? Below is my ui and server code.
Thank in advance for help and effort!
ui
library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(shinyBS)
library(DT)
ui<-dashboardPage(
dashboardHeader(title="Missing",titleWidth = 230),
dashboardSidebar(
fileInput("file1", "Upload CSV File below",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
)),
dashboardBody(
fluidRow(
box(plotOutput("Plot1"),collapsible = TRUE,title="Columns ",solidHeader = TRUE,status = "primary"),
box(plotOutput("Plot2"),collapsible=TRUE,title="Columns data Type",solidHeader = TRUE,status = "primary"),
fluidRow(column(width=12,box( bsModal("modalExample", "Data Table", "My_datatable", size = "large",dataTableOutput("My_datatable")),width = NULL,collapsible = TRUE))
)
)
)
)
Server:
server<- function(input, output,session) {
output$Plot1 <- renderPlot({
plot(cars)
})
output$Plot2 <- renderPlot({ plot(pressure)})
output$My_datatable <- renderDT({iris[1:7,]})
}
# Run the application
shinyApp(ui = ui, server = server)
As shown in the answer you need to wrap each item you want to popout in a div() and give an id. Then use that id to popout and display what you wish. Try this
library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(shinyBS)
library(DT)
#library(visdat)
ui<-dashboardPage(
dashboardHeader(title="Missing",titleWidth = 230),
dashboardSidebar(
fileInput("file1", "Upload CSV File below",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
)),
dashboardBody(
fluidRow(
div(id="popme1", box(plotOutput("Plot1"),collapsible = TRUE,title="Columns with null",solidHeader = TRUE,status = "primary")),
bsModal("modalExample1", "Plot1", "popme1", size = "large", plotOutput("Plot11")),
div(id="popme2", box(plotOutput("Plot2"),collapsible=TRUE,title="Data Types of columns",solidHeader = TRUE,status = "primary")),
bsModal("modalExample2", "Plot2", "popme2", size = "large", plotOutput("Plot22")),
div(id="popme3", fluidRow(column(width=8,box(DTOutput("Missing_datatable"), width = NULL,collapsible = TRUE)) )),
bsModal("modalExample3", "Data Table", "popme3", size = "large", DTOutput("Missing_datatable2"))
)
)
)
server<- function(input, output,session) {
output$Plot1 <- renderPlot({
plot(cars)
})
output$Plot11 <- renderPlot({
plot(cars)
})
output$Plot22 <- renderPlot({ plot(pressure)})
output$Plot2 <- renderPlot({ plot(pressure) })
output$Missing_datatable <- renderDT({iris[1:7,]})
output$Missing_datatable2 <- renderDT({iris[1:7,]})
}
# Run the application
shinyApp(ui = ui, server = server)
I want to translate parts of my UI in a modularized shiny app. As I summarized my simplified code,
in the first module I have no problem with i18n as it is enters to the module 1 with argument i18n and
translation works well in registerUI(based on recommendation here). But my problem is with the UI of module 2 (M2UI) which this function
itself called within the server of module 1 (register) to return a modal dialogue. But i18n not detected and translation not works on displayed new modal. Any suggestions why this happens? thanks in advance...
I edited my example and it is now completely reproducible. Translation csv files are available here. Just copy them in "translations" forlder. And, the modules should be copied to "modules" folder.
## CSV translation files are available at : https://github.com/Appsilon/shiny.i18n/tree/master/examples/data
# Copy "translation_it.csv" and "translation_pl.csv" files to "translations" folder
###### make modules and copy them into folder "modules"
source("modules/register.R")
source("modules/M2.R")
#####
library(shiny)
library(shiny.i18n)
library(shinydashboard)
i18n <- Translator$new(translation_csvs_path = "translations")
i18n$set_translation_language("en")
shiny.i18n::usei18n(i18n)
############################ UI
header <- dashboardHeader(title = i18n$t('Hello Shiny!'), titleWidth = 400 ,
tags$li( fluidRow(
shiny.i18n::usei18n(i18n),
div(style="display: inline-block;vertical-align:top; font-size: 10px; height=30px;width: 150px;",selectInput(
inputId='selected_language',
label=i18n$t('Change language'),
choices = i18n$get_languages(),
selected = i18n$get_key_translation()
))
),
class = "dropdown")
)
# Sidebar Menu ------------------------------------------------------------
sidebar <- dashboardSidebar(width = 220,
sidebarMenu(
menuItem( i18n$t("Hello Shiny!"), tabName = "diary", icon = icon("align-justify")),
menuItem("Help", tabName = "help", icon = icon("table")),
#menuItem("Data analysis", tabName = "descriptive", icon = icon("chart-bar")),
menuItem("About", tabName = "about", icon = icon("info-circle"))
)
)
body <- dashboardBody(
tabItems(
tabItem("diary",
# includeMarkdown("Introduction.Rmd"),
# includeMarkdown("Contact.Rmd")
titlePanel(i18n$t("Hello Shiny!")),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
i18n$t("Number of bins:"),
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("distPlot"),
actionButton("test","test"),
p(i18n$t("This is description of the plot."))
)
),
tags$style(type = "text/css", ".recalculating {opacity: 1.0;}"), # Prevents gray screen during Sys.sleep()
),
tabItem("help",
),
tabItem("about",
)
)
)
ui <- dashboardPage(title = 'Coronavirus', header, sidebar, body, skin='blue')
#################################### SERVER
server <- function(input, output,session) {
observeEvent(input$selected_language, {
update_lang(session, input$selected_language)
})
shiny::observeEvent(input$test, {
registerUI(id = "REG",reg_title=i18n$t("Hello Shiny!"),i18n=i18n ) #This ID should be mached with ID in server
})
callModule(register,id = "REG", title= i18n$t("Hello Shiny!"), i18n=i18n )
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins,
col = "darkgray", border = "white",
main = i18n$t("Histogram of x"), ylab = i18n$t("Frequency"))
})
}
shinyApp(ui = ui, server = server)
registerUI <- function(id, reg_title=NULL ,i18n) {
ns <- shiny::NS(id)
shiny.i18n::usei18n(i18n)
showModal(tags$div( modalDialog(title = "" ,size="s",
shiny::div(id =ns("regpanel"),
shiny::wellPanel(
shiny::tags$h2(reg_title, class = "text-center", style = "padding-top: 0;"),
shinyjs::disabled(shiny::textInput(ns("user_name1"), value= "", shiny::tagList(shiny::icon("user"), "suggested user name"))) ,#
shiny::actionButton(ns("regSubmit"), i18n$t("Submit") , class = "btn-primary", style = "color: white;")
)
)
),
easyClose = TRUE, footer = NULL ))
}
###### Module 1
register <- function(input, output, session ,title,i18n) {
ns <- session$ns
shiny::observeEvent(input$regSubmit, {
shiny.i18n::usei18n(i18n)
removeModal()
M2UI(id = ns("M2") ,reg_title=i18n$t("Hello Shiny!" ),i18n=i18n )
})
callModule(M2,id = "M2" , title= i18n$t("Hello Shiny!"),i18n=i18n)
}
###### Module 2
M2UI <- function(id, reg_title=NULL,i18n ) {
ns <- shiny::NS(id)
shiny.i18n::usei18n(i18n)
showModal(modalDialog(title = reg_title ,size="s",
shiny::wellPanel(
shiny::actionButton(ns("Finish"), i18n$t("Hello Shiny!" ) )
)
, easyClose = TRUE, footer = NULL ) )
}
M2 <- function(input, output, session ,title,i18n) {
ns <- session$ns
shiny::observeEvent(input$Finish, {
removeModal()
})
}
Did you try the latest dev version? You have to update it through the dev package. I am pretty sure it was fixed there. The problem regarded a missing callback through shiny session.
Your exampe works on my setup.
Problem: In belows Shiny app the user can add information presented in valueboxes depending on the select input. If the user selects all possible choices then the UI looks as in the screenshot.
Question: Is it possible that the plot (which is in the same row as the valueboxes) adjusts in height (so the bottom of the plot is aligned with the bottom of the last valuebox)?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectizeInput(
inputId = "select",
label = "Select country:",
choices = c("CH", "JP", "GER", "AT", "CA", "HK"),
multiple = TRUE)
),
dashboardBody(
fluidRow(column(2, uiOutput("ui1")),
column(10, plotOutput("some_plot"))))#,
# column(4, uiOutput("ui2")),
# column(4, uiOutput("ui3")))
)
server <- function(input, output) {
output$ui1 <- renderUI({
req(input$select)
lapply(seq_along(input$select), function(i) {
fluidRow(
valueBox(value = input$select[i],
subtitle = "Box 1",
width = 12)
)
})
})
output$some_plot <- renderPlot(
plot(iris)
)
}
shinyApp(ui = ui, server = server)
You can adjust the height in the renderPlot. I have set the minimum to 3 value box height. So, it starts increasing the height after you add 3 value boxes. You can modify it, as necessary. Try the code below.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectizeInput(
inputId = "select",
label = "Select country:",
choices = c("CH", "JP", "GER", "AT", "CA", "HK"),
multiple = TRUE)
),
dashboardBody(
fluidRow(column(2, uiOutput("ui1")),
column(10, plotOutput("some_plot"))))#,
# column(4, uiOutput("ui2")),
# column(4, uiOutput("ui3")))
)
server <- function(input, output) {
plotht <- reactiveVal(360)
observe({
req(input$select)
nvbox <- length(input$select)
if (nvbox > 3) {
plotheight <- 360 + (nvbox-3)*120
}else plotheight <- 360
plotht(plotheight)
})
output$ui1 <- renderUI({
req(input$select)
lapply(seq_along(input$select), function(i) {
fluidRow(
valueBox(value = input$select[i],
subtitle = "Box 1",
width = 12)
)
})
})
observe({
output$some_plot <- renderPlot({
plot(iris)
}, height=plotht())
})
}
shinyApp(ui = ui, server = server)
Here's my attempt, based on this answer. This uses the window size listeners to dynamically adjust the size of a plot (possible by using inline = TRUE in the plotOutput call). The width of the outer container is fixed, so can be referenced directly, but the height is dynamic, so my workaround is to use the window height and subtract 50 pixels. This seems to work as long as there is a single plot element, and the sidebar hasn't been adjusted to be on top of the plot, rather than beside it.
The window resizes are debounced to only resize after there's been no change for half a second, so that the server isn't taxed too much in redraw calls. The code also doesn't plot anything if the dimensions are not yet determined, so that there's no initial plot flicker.
library(shiny)
ui <- fluidPage(
## Add a listener for the window height and plot container width
tags$head(tags$script('
var winDims = [0, 0];
var plotElt = document;
$(document).on("shiny:connected", function(e) {
plotElt = document.getElementById("plotContainer");
winDims[0] = plotElt.clientWidth;
winDims[1] = window.innerHeight;
Shiny.onInputChange("winDims", winDims);
});
$(window).resize(function(e) {
winDims[0] = plotElt.clientWidth;
winDims[1] = window.innerHeight;
Shiny.onInputChange("winDims", winDims);
});
')),
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
sliderInput("height", label="Height",
min=100, max=900, value = 600)
),
mainPanel(
tags$div(id="plotContainer", ## Add outer container to make JS constant
## Use an "inline" plot, so that width and height can be set server-side
plotOutput("distPlot", inline = TRUE))
)
)
)
server <- function(input, output) {
## reduce the amount of redraws on window resize
winDims_d <- reactive(input$winDims) %>% debounce(500)
## fetch the changed window dimensions
getWinX <- function(){
print(input$winDims);
if(is.null(winDims_d())) { 400 } else {
return(winDims_d()[1])
}
}
getWinY <- function(){
if(is.null(winDims_d())) { 600 } else {
return(winDims_d()[2] - 50)
}
}
output$distPlot <- renderPlot({
if(is.null(winDims_d())){
## Don't plot anything if we don't yet know the size
return(NULL);
}
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
}, width = getWinX, height=getWinY)
}
shinyApp(ui = ui, server = server)
I am developing a Shiny app with a plot (plot1 in the code) that is reactive to a data table (rhandsontable) and it displays the item selected on the table.
The table is very large so you have to scroll down to see everything. But I want the plot to be always visible, so to be fixed in the layout while you scroll down the table.
There is anyway to do it? I have done a lot of research but any answer that can help me.
My UI code is that:
ui <- dashboardPage(
dashboardHeader(title = "IG Suppliers: Tim"),
dashboardSidebar(
sidebarMenu(
menuItem("Data Cleansing", tabName = "DataCleansing", icon = icon("dashboard")),
selectInput("supplier","Supplier:", choices = unique(dt_revision_tool$Supplier)),
#selectInput("supplier","Supplier:", choices = 'Phillips'),
selectInput("segment","Segment:", choices = unique(dt_revision_tool$Segment_Name), multiple = TRUE, selected = unique(dt_revision_tool$Segment_Name)[1]),
#selectInput("segment","Segment:", choices = sgm),
selectInput("alert","Alert", choices = unique(dt_revision_tool$Alert),selected = "Yes"),
#selectInput("alert","Alert", choices = c('Yes','No'),selected = "Yes"),
selectInput("dfu","DFU", choices = c("NULL",unique(dt_revision_tool$DFU)),selected = "NULL"),
tags$hr()
# h5("Save table",align="center"),
#
# div(class="col-sm-6",style="display:inline-block",
# actionButton("save", "Save"),style="float:center")
)
),
dashboardBody(
shinyjs::useShinyjs(),
#First Tab
tabItems(
tabItem(tabName= "DataCleansing",
fluidPage(theme="bootstrap.css",
fluidRow(
plotOutput('plot1')
),
fluidRow(
verbatimTextOutput('selected'),
rHandsontableOutput("hot")
)
)
)
# #Second Tab
# tabItem(tabName = "Forecast",
# h2('TBA')
# )
)
)
)
The server code is that:
server <- shinyServer(function(input, output) {
if (file.exists("DF.RData")==TRUE){
load("DF.RData")
}else{
load("DF1.RData")
}
rv <- reactiveValues(x=dt_revision_tool)
dt <- reactiveValues(y = DF)
observe({
output$hot <- renderRHandsontable({
view = data.table(update_view(rv$x,input$alert,input$segment,input$supplier,dt$y,input$dfu))
if (nrow(view)>0){
rhandsontable(view,
readOnly = FALSE, selectCallback = TRUE, contextMenu = FALSE) %>%
hot_col(c(1:12,14),type="autocomplete", readOnly = TRUE)
}
})
})
observe({
if (!is.null(input$hot)) {
aux = hot_to_r(input$hot)
aux = subset(aux, !is.na(Cleansing_Suggestion) | Accept_Cleansing,select=c('DFU','Week','Cleansing_Suggestion',
'Accept_Cleansing'))
names(aux) = c('DFU','Week','Cleansing_Suggestion_new','Accept_Cleansing_new')
dt$y = update_validations(dt$y,aux)
DF = dt$y
save(DF, file = 'DF.RData')
}
})
output$plot1 <- renderPlot({
view = data.table(update_view(rv$x,input$alert,input$segment,input$supplier,dt$y,input$dfu))
if (nrow(view)>0){
if (!is.null(( data.table(update_view(rv$x,input$alert,input$segment,input$supplier,dt$y,input$dfu)))[input$hot_select$select$r]$DFU)) {
s = make_plot2(rv$x,(data.table(update_view(rv$x,input$alert,input$segment,input$supplier,dt$y,input$dfu)))[input$hot_select$select$r]$DFU,(data.table(update_view(rv$x,input$alert,input$segment,input$supplier,dt$y,input$dfu)))[input$hot_select$select$r]$Article_Name)
print(s)
}
}
})
})
Any help or idea will be welcome!
Thanks!
Aida
Here is an example of using CSS position: fixed to do this. You can adjust the position top and margin-top according to your requirement.
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
tags$div(p("Example of fixed plot position"))
),
mainPanel(
plotOutput("plot"),
tableOutput("table"),
tags$head(tags$style(HTML("
#plot {
position: fixed;
top: 0px;
}
#table {
margin-top: 400px;
}
")))
)
)
))
server <- shinyServer(function(input, output, session) {
output$plot <- renderPlot({
plot(iris$Sepal.Length, iris$Sepal.Width)
})
output$table <- renderTable({
iris
})
})
shinyApp(ui = ui, server = server)