I am trying to adapt the RMarkdown file with *.rmd extension into Shiny application. My file has elements of Shiny but works with flexdashboard. Below you can see the code.
---
title: "Test"
author: " "
output:
flexdashboard::flex_dashboard:
orientation: columns
social: menu
source_code: embed
runtime: shiny
editor_options:
markdown:
wrap: 72
---
# Module 1
```{r global, include=FALSE}
library(biclust)
data(BicatYeast)
set.seed(1)
res <- biclust(BicatYeast, method=BCPlaid(), verbose=FALSE)
```
## Inputs {.sidebar}
```{r}
selectInput("clusterNum", label = h3("Cluster number"),
choices = list("1" = 1, "2" = 2),
selected = 1)
```
## Row {.tabset}
### Parallel Coordinates
```{r}
num <- reactive(as.integer(input$clusterNum))
renderPlot(
parallelCoordinates(BicatYeast, res, number=num()))
```
### Data for Selected Cluster
```{r}
renderTable(
BicatYeast[which(res#RowxNumber[, num()]), which(res#NumberxCol[num(), ])]
)
```
The shiny app usually has two main parts first is ui and second is server, so can anybody help how to solve this problem and run this file as a Shiny app.
library(shiny)
library(biclust)
ui <- fluidPage(
selectInput("clusterNum",
label = h3("Cluster number"),
choices = list("1" = 1, "2" = 2),
selected = 1
),
plotOutput("plot"),
tableOutput("table")
)
server <- function(input, output, session) {
set.seed(1)
data(BicatYeast)
res <- biclust(BicatYeast, method = BCPlaid(), verbose = FALSE)
num <- reactive(as.integer(input$clusterNum))
output$plot <-
renderPlot(
parallelCoordinates(BicatYeast, res, number = num())
)
output$table <-
renderTable(
BicatYeast[which(res#RowxNumber[, num()]), which(res#NumberxCol[num(), ])]
)
}
shinyApp(ui, server)
Related
I am fairly new to R markdown. I have built an app that requires the user to provide multiple inputs to generate a table, which can then be saved locally.
I have been now asked to implement a sort of report to list all the variables inserted by the user (in a sort of formatted document), so that before generating the table one can review all the settings and change them in case of errors.
To avoid major UI restructure, I thought about using a r markdown document and visualize it inside a modal. My problem is that rmarkdown::render renders to an output, while bs_modal takes for the argument body a character (HTML) variable.
Is there a way to make this work? Or are there better way to accomplish this?
A minimal example:
my .Rmd
---
title: "Dynamic report"
output:
html_document: default
pdf_document: default
params:
n : NA
---
A plot of `r params$n` random points.
```{r, echo=FALSE}
plot(rnorm(params$n), rnorm(params$n))
```
My App.R
library(shiny)
library(bsplus)
library(rmarkdown)
shinyApp(
ui = fluidPage(
selectInput(
inputId = "numb",
label = "Label with modal help",
choices = 50:100
),
actionButton(inputId = "mysheet",
label = "Open modal") %>% bs_attach_modal(id_modal = "modal1"),
textOutput("result")
),
server = function(input, output) {
observeEvent(input$mysheet, {
params <- input$numb
md_out <-
rmarkdown::render(
"report.Rmd",
params = params,
envir = new.env(parent = globalenv())
)
bs_modal(
id = "modal1",
title = "Equations",
body = md_out,
size = "medium"
)
})
output$result <- renderText({
paste("You chose:", input$numb)
})
}
)
bs_modal does not work like this, it must be in the UI. Below is a solution using the classical Shiny modal, no bsplus or other package.
library(shiny)
shinyApp(
ui = fluidPage(
selectInput(
inputId = "numb",
label = "Label with modal help",
choices = 50:100
),
actionButton(inputId = "mysheet",
label = "Open modal"),
textOutput("result")
),
server = function(input, output) {
observeEvent(input$mysheet, {
params <- list(n = input$numb)
md_out <-
rmarkdown::render(
"report.Rmd",
params = params,
envir = new.env(parent = globalenv())
)
showModal(modalDialog(
includeHTML(md_out),
title = "Equations",
size = "m"
))
})
output$result <- renderText({
paste("You chose:", input$numb)
})
}
)
Use html_fragment as the Rmd output:
---
title: "Dynamic report"
output:
html_fragment
params:
n : NA
---
A plot of `r params$n` random points.
```{r, echo=FALSE}
plot(rnorm(params$n), rnorm(params$n))
```
I am trying to make a shinyapp using flexdashboard. The app takes as input a string of text, and then it outputs a website using that input text. I have an example of the app working in standard shiny. My problem is "translating" it to an app using flexdashboard.
Here is my app in standard shiny:
library(shiny)
ui <- fluidPage(titlePanel("Testing"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(9, selectInput("Color", label=h5("Choose a color"),choices=c('red', 'blue'))
))),
mainPanel(fluidRow(
htmlOutput("frame")
)
)
))
server <- function(input, output) {
observe({
query <- input$Color
test <<- paste0("https://en.wikipedia.org/wiki/",query)
})
output$frame <- renderUI({
input$Color
my_test <- tags$iframe(src=test, height=600, width=535, frameborder = "no")
print(my_test)
my_test
})
}
shinyApp(ui, server)
Here is my attempt trying to get it to work using flexdashboards. I am having problem trying to get the input as a reactive expression to make my output dynamic. I am trying 2 different ways to get the output, but none work.
---
title: "Testing Colors"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(knitr)
lookup <- structure(c("r", "b"), .Names = c("Red", "Blue"))
Column {.sidebar}
-----------------------------------------------------------------------
```{r}
selectInput('Color', label = 'Select a color', choices = lookup, selected = "r")
Column {data-width=600}
-----------------------------------------------------------------------
### Color Web Page
```{r}
observeEvent(input$Color,{
output$url <-renderUI(a(href=paste0("https://en.wikipedia.org/wiki/", input$Color)))
})
Column {data-width=400}
-----------------------------------------------------------------------
### Another webpage
```{r}
selectedColor<- reactive({
color <- input$Color
})
webpage <- renderUI({
include_url(paste0("https://www.wikipedia.org/",selectedColor))
})
webpage
I would certainly appreciate any comments or ideas.
Thanks!
This code gave me a flexdashboard back with the selectInput, I think the alignment of spaces made for errors
---
title: "Testing Colors"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(knitr)
lookup <- structure(c("r", "b"), .Names = c("Red", "Blue"))
```
```{r,}
selectInput('Color', label = 'Select a color', choices = lookup, selected = "r")
```
Column {data-width=600}
-----------------------------------------------------------------------
### Color Web Page
```{r}
observeEvent(input$Color,{
output$url <-renderUI(a(href=paste0("https://en.wikipedia.org/wiki/", input$Color)))
})
```
Column {data-width=400}
-----------------------------------------------------------------------
### Another webpage
```{r}
selectedColor<- reactive({
color <- input$Color
})
webpage <- renderUI({
include_url(paste0("https://www.wikipedia.org/",selectedColor))
})
webpage
I am trying to use function read_chunk along with a shiny widget in Rmarkdown report. The output is an HTML document and runtime: shiny.
When I run the chunks individually it works perfectly fine. But when I use
read_chunk() in my script and then run_chunk t run only one chunk of the source chunk, it throws an error. What I feel is there is a way to interact shiny widget and read chunks. Please help how do I do this.
Error:
Warning: Error in parse: :2:0: unexpected end of input 1:
read_chunk(paste0(params$code_path,"chunk_name.R")
the chunk that I am using is saved at '/loaction/chunk_v1.R'
## #knitr iris_sub
#######################################################################################################################################
#######################################################################################################################################
iris_subset <- subset(iris, Species=='setosa')
#
---
params:
code_chunk: '/location/'
title: "Untitled"
output: html_document
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
## R Markdown
```{r iris_sub}
read_chunk(paste0(params$code_chunk,"chunk_v1.R"))
```
```{r iris_plot, echo=FALSE}
sample_his <- function(dataset_name){
library(shiny)
shinyApp(
ui=fluidPage(
titlePanel("Iris Dataset"),
sidebarLayout(
sidebarPanel(
radioButtons("p", "Select column of iris dataset:",
list("Sepal.Length"='a', "Sepal.Width"='b', "Petal.Length"='c', "Petal.Width"='d')),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("distPlot")
)
)
),
server = function(input, output, session) {
output$distPlot <- renderPlot({
if(input$p=='a'){
i<-1
}
if(input$p=='b'){
i<-2
}
if(input$p=='c'){
i<-3
}
if(input$p=='d'){
i<-4
}
x <- dataset_name[, i]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
)}
```
## Including Plots
```{r pressure, echo=FALSE}
sample_his(iris)
```
I´m a newby with flex-dashboards...
How can I separate in two different tabs the input information and output results? here is a simple example, I am trying to render only the barplot in the second tab "Output"
---
title: "Dashboard"
output:
flexdashboard::flex_dashboard:
runtime: shiny
---
```{r global, include=FALSE}
# load data in 'global' chunk so it can be shared by all users of the dashboard
library(datasets)
data(WorldPhones)
```
Inputs
=======================================================================
```{r, include=FALSE}
# Shiny module definition (would typically be defined in a separate R script)
# UI function
worldPhonesUI <- function(id) {
ns <- NS(id)
fillCol(height = 600, flex = c(2, 1),
inputPanel(
selectInput(ns("region"), "Region1:", choices = colnames(WorldPhones))
)
)
}
# Server function
worldPhones <- function(input, output, session) {
output$phonePlot <- renderPlot({
barplot(WorldPhones[,input$region]*1000,
ylab = "Number of Telephones", xlab = "Year")
})
}
```
```{r, eval=TRUE}
# Include the module
worldPhonesUI("phones")
callModule(worldPhones, "phones")
```
Results
=======================================================================
```{r}
worldPhonesUI <- function(id) {
ns <- NS(id)
fillCol(height = 600, flex = c(NA, 1),
plotOutput(ns("phonePlot"), height = "80%")
)
}
```
you forget everything about ui and server functions and put directly objects in chucks like this:
---
title: "Dashboard"
output:
flexdashboard::flex_dashboard:
runtime: shiny
---
```{r global, include=FALSE}
# load data in 'global' chunk so it can be shared by all users of the dashboard
library(datasets)
data(WorldPhones)
```
Inputs
=======================================================================
```{r}
selectInput("region", "Region1:", choices = colnames(WorldPhones))
```
Results
=======================================================================
```{r}
renderPlot({
barplot(WorldPhones[,input$region]*1000,
ylab = "Number of Telephones", xlab = "Year")
})
```
I am trying to use tabs in an Rmarkdown document together with plots. But I can't seem to get the plot in the second tab to display. See the attached sample code for an example. If I remove {.tabset}, then everything would display fine.
I think if i can force a refresh within the shinyApp when switching tabs, that probably would do the trick, but I can't figure out how to do that.
---
title: "Test"
output:
html_document:
toc: true
theme: united
runtime: shiny
---
# Main Page {.tabset}
## Page 1
```{r, echo=FALSE}
require(plotly)
require(dplyr)
shinyApp(
ui = fluidPage(
titlePanel("Page 1"),
mainPanel(fluidRow(plotlyOutput("plot"))
)),
server = function(input, output) {
output$plot = renderPlotly({
data.frame(x=seq(1,10)) %>% mutate(y=2*x) %>% plot_ly(x=x, y=y, mode="markers+lines")
})
},
options=list(height=500)
)
```
## Page 2
```{r, echo=FALSE}
shinyApp(
ui = fluidPage(
titlePanel("Page 2"),
mainPanel(fluidRow(plotlyOutput("plot"))
)),
server = function(input, output) {
output$plot = renderPlotly({
data.frame(x=seq(1,5)) %>% mutate(y=3*x-2) %>% plot_ly(x=x, y=y, mode="markers+lines")
})
},
options=list(height=500)
)
```