I am working on flexdashboard. I have used the below code for one of the plots. Well, when I try to use click or brush under plotlyOutput it is throwing an error like I have used in the second below. Is there a way to use Click under plotlyOutput? Is there a way?......................................
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: scroll
runtime: shiny
source_code: embed
theme: cosmo
---
```{r setup, include=FALSE}
library(flexdashboard)
library(readxl)
library(tidyverse)
library(lubridate)
library(ggplot2)
library(reshape)
library(shiny)
library(plotly)
```
```{r}
df <- read_excel("E:/Analytics/Freelancing projects/New
folder/df.xlsx")
```
Summary
=================
Inputs {.sidebar}
-----------------------------------------------------------------------
```{r}
selectInput("p1",h5("Select"),choices = c("","Plot"))
selectInput("f1",h5("Components"),choices =
c("ALL",levels(factor(Copy_of_mill_para1$variable))),selected = "ALL")
```
Column {data-width=350}
-----------------------------------------------------------------------
### Chart A
```{r}
plotlyOutput("g1")
output$g1 <- renderPlotly({
if (input$p1 == "Plot") {
s_data <- df
}
if (input$p1 == "Plot" && input$f1 != "ALL") {
s_data <- s_data %>% filter(variable %in% input$f1)
}
p1 <- ggplot(s_data,aes(x=Date,y=value,color=variable))+geom_line(size =
.2)+theme(axis.text.y=element_text(angle=0,hjust=1,size=0.1))+theme(axis.title.y=element_blank(),axis.title.x=element_blank())+theme(ax
is.text.x=element_blank())+theme(legend.title = element_blank())+
theme(legend.text=element_text(size=7.5))+theme(legend.position = "none")
print(ggplotly(p1))
})
```
### Table
```{r}
verbatimTextOutput("click")
output$click <- renderPrint({
d <- event_data("plotly_click")
if (is.null(d)) "Click events appear here (double-click to clear)"
})
```
Related
In my flexdashboard I have a column with a note, then a table, and I would like to add one more note below the table. But I am struggling to get the second note to show up. I can make a new header there but I really just want another sentence that shows up without a new header. Here is some simple code to illustrate. Thanks!
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: scroll
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(dplyr)
library(shiny)
library(rhandsontable)
df <- tibble(
`Col 1` = seq(1,24,1), `Col 2` = " ")
```
Column {data-width=650}
-----------------------------------------------------------------------
### Table
I can write a note here
```{r}
output$table_exer <- renderRHandsontable({
rhandsontable(df, rowHeaders = NULL)
})
rHandsontableOutput("table_exer")
```
But I also want a note here
Column {data-width=350}
-----------------------------------------------------------------------
### Chart B
```{r}
```
### Chart C
```{r}
```
very simple, wrap your table inside fluidRow, like this:
```{r}
output$table_exer <- renderRHandsontable({
rhandsontable(df, rowHeaders = NULL)
})
fluidRow(rHandsontableOutput("table_exer"))
```
To make the margin and spacing look nicer, we can also do following:
```{r}
output$table_exer <- renderRHandsontable({
rhandsontable(df, rowHeaders = NULL)
})
column(12, fluidRow(rHandsontableOutput("table_exer")))
br()
```
My goal is to get a value box to update using some inputs I have.
Here is my code
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
graphics: yes
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(ggplot2)
library(plotly)
library(DT)
library(htmltools)
library(readr)
library(shiny)
library(knitr)
```
Inputs {.sidebar data-width=300}
=====================================
```{r}
selectInput("input_type","Select Cylinder Size: ", c("All", mtcars$cyl))
selectInput("input_type2", "Select # of Gears: ", c("All", mtcars$gear))
mtcars2 <- reactive({
d <- mtcars
if(input$input_type !="All")
d <- subset(d, cyl == input$input_type)
if(input$input_type2 !="All")
d <- subset(d, gear == input$input_type2)
d
})
```
# Page 1
Column {data-width=600}
-----------------------------------------------------------------------
### Table
```{r echo=FALSE}
renderDataTable(
datatable(mtcars2())
)
```
Column {data-width=300}
-----------------------------------------------------------------------
### Value Box
```{r}
valueBox(0)
```
My goal is to get a value box where I can get the sum of hp depending on the remaining data that is filtered.
For example in this screenshot I filtered to only see cars that are 6 cyl and have 3 gears.
My goal would be to see the sum of hp populate on the value box.
Additional Code
renderValueBox({
valueBox(
mtcars2() %>% summarise(Sum=sum(hp)) %>% pull(Sum) ,
paste("Total HP:", input$input2)
)
})
Add
library(dplyr)
to your YAML header and then replace
valueBox(0)
with
renderValueBox({
valueBox(
"Total HP",
mtcars2() %>% summarise(Sum=sum(hp)) %>% pull(Sum)
)
})
or similar.
I'm trying to make a simple shiny app where I can select an input of cylinders(4,6, or 8) and then generate a table with the cars who are either 4,6, or 8 cylinders.
This is my code
---
title: "Test Dash"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
Inputs {.sidebar data-width=300}
=====================================
$$\\[.01in]$$
```{r pressure, echo=FALSE, out.width = '100%'}
library(readr)
library(shiny)
library(DT)
```
```{r}
cylinder <- mtcars$cyl
selectInput("my_dropdown", label = "Select Cylinders:", choices = cylinder)
```
# Overview
Column {data-width=750}
-----------------------------------------------------------------------
### Table
```{r}
renderDataTable(
datatable(mtcars[input$my_dropdown,]
)
)
```
i'm able to generate the input and an empty table but the table does not update when I choose a cylinder.
Here is a screenshot.
Any idea how I can fix this?
mtcars2 <- reactive({
mtcars[mtcars$cyl == input$my_dropdown,]
})
renderDataTable(
datatable(mtcars2())
)
)
I have a dataframe, please help me in executing this. The moment I check "HoltWinters" and press "Execute" button, dataframe "HW" should appear. I have tried half way. But need anyone help here please................................
---
title: "Untitled"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
---
library(flexdashboard)
library(readxl)
library(tidyverse)
library(shiny)
library(rhandsontable)
library(dplyr)
library(forecast)
library(fpp)
library("TTR")
x <- c(1:123)
x <- ts(x, start = c(2017, 23), end = c(2019, 39), frequency = 53)
x.hw <- HoltWinters(x)
HW <- forecast(x.hw, h = 6)
HW <- as.data.frame(HW)
Model Execution
Inputs {.sidebar}
radioButtons("r",h5("Models"),choices = list("Regression", "Arima","HoltWinters","Model4","Model5"),selected = "No", inline = F)
actionButton("a","Execute",icon = NULL)
Row {.tabset .tabset-fade}
HoltWinters
output$table1 <- renderRHandsontable({
eventReactive(input$a,{
rhandsontable(HW)
})
})
rHandsontableOutput("table1")
You should not use eventReactive but observeEvent instead (check here). Also, this condition should be outside of the output part: "if I observe this event, then I will display this table" (and not "I will display this table and then fill it according to which button is ticked").
Here's the solution to your problem (you should customize it so that just selecting HoltWinters displays the table but at least you have a working basis here):
---
title: "Untitled"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
library(readxl)
library(tidyverse)
library(shiny)
library(rhandsontable)
library(dplyr)
library(forecast)
library(fpp)
library(TTR)
```
```{r}
x <- c(1:123)
x <- ts(x, start = c(2017, 23), end = c(2019, 39), frequency = 53)
x.hw <- HoltWinters(x)
HW <- forecast(x.hw, h = 6)
HW <- as.data.frame(HW)
```
Model Execution
=================
Inputs {.sidebar}
-----------------------------------------------------------------------
```{r}
radioButtons("r",h5("Models"),choices = list("Regression", "Arima","HoltWinters","Model4","Model5"),selected = "No", inline = F)
actionButton("a","Execute",icon = NULL)
```
Row {.tabset .tabset-fade}
-------------------------------------
### HoltWinters
```{r}
observeEvent(input$a,{
output$table1 <- renderRHandsontable({
rhandsontable(HW)
})
})
rHandsontableOutput("table1")
```
Edit: you can add a condition within the observeEvent so that the table is displayed only if HoltWinters is ticked:
observeEvent(input$a,{
if (input$r == "HoltWinters") {
output$table1 <- renderRHandsontable({
rhandsontable(HW)
})
}
else {
output$table1 <- renderRHandsontable({
})
}
})
rHandsontableOutput("table1")
Is there a way to have plots with mouse interactions using flexdashboard?
In shiny this is not difficult. I want to save mouse clicks, and in shiny UI I would use:
mainPanel(plotOutput("scatterplot", click = "plot_click"))
And in the server you would have:
df <- reactiveValues(Clicksdf = data.frame(clickx = numeric(), clicky = numeric()))
Can I do this in flexdashboard?
Write the code chunk as if it were both the Shiny UI and server:
---
title: "Untitled"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
library(shiny)
```
Column {data-width=650}
-----------------------------------------------------------------------
### Chart A
```{r}
plotOutput("plot1", click = "wt")
output$plot1 <- renderPlot({
plot(mtcars$mpg ~ mtcars$wt)
})
```
Column {data-width=350}
-----------------------------------------------------------------------
### Chart B
```{r}
renderText({
unlist(input$wt$x)
})
```