I have created several likert scales with R package "likert" and would like to plot each one of them in shiny when the radio button of that one is selected.
The sample scales is:
a <- sample(rep((1:5),5))
b <- sample(rep((1:5),5))
c <- data.frame(sapply(data.frame(a), factor))
d <- data.frame(sapply(data.frame(b), factor))
scaledc <- likert(c)
scaledd <- likert(d)
The shiny codes are:
ui <- fluidPage(
titlePanel("Survey"),
sidebarLayout(
sidebarPanel(
selectInput("type",
"Plot Type",
choices = c("Likert"="bar",
"Density"="density",
"Heatmap"="heat"), selected="Likert"),
radioButtons("qtype",
"Question type:",
c("Agreement"="scaledc", "Helpfulness"="scaledd"),
selected="scaledc")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("Yearly Data", plotOutput("distPlot1"))
)
)
)
)
#server
server <- function(input, output) {
output$distPlot1 <- renderPlot({plot(input$qtype, type=input$type)+
ggtitle("How agree are you with following statements?")}, height = 1000)
}
The shiny returned error "need finite 'ylim' values." I think it's becaue the input$qtype doesn't pass the correct information to the plot command, but I don't know how to fix it. Thank you for advance!
I've just solved the problem.
The missing codes in server are:
scale <- reactive({
get(input$qtype)
})
output$dat <- renderPrint({
scale()
})
And then do plot with scale() will show selected plot.
Related
I have a Shiny app with produces the following output. I would like the height of the graph to scale to fill the row which contains the sidebar, (down to some minimum dimension). This sidebar height changes depending on the data being examined.
The ui code I'm currently using is:
sidebarLayout(
sidebarPanel(
uiOutput("ridgeDates")
),
mainPanel(
plotOutput("ridgesPlot")
)
)
with the plot being rendered by renderPlot(...) This seems to adjust the /width/ automatically as I change the browser window width.
I've spent a while searching but can't find anything that does this. Is this possible?
We can use jQuery to track the height of the sidebar and set the height of the plot in css before creating the plotOutput. To do that, we need to use uiOutput in the UI, then render the plot dynamically.
So in the UI, the mainPanel will now have:
uiOutput("ridgePlot")
Then the plot is rendered in the server like so:
output$ridgePlot <- renderUI({
# plot data
output$ridges <- renderPlot({
# plot()
})
plotOutput("ridges")
})
Now we use shinyjs() to write a simple javascript function that sets the height value of the plot to the height of the sidebar. The sidebar is of class well, so we first get the height of the well, save it to a variable then set the ridges plot to the height of the variable, in javascript like this:
var newHeight = $('.well').outerHeight(); $('#ridges').height(newHeight)
I have used .outerHeight() because the well has extra padding that effectively gives it extra height than the height specified in the css rules for the well.
We can use this function in shiny using runjs() from shinyjs package. Since we need to get the height from the well after it has been rendered, we use observe and use it before the plotOutput inside the renderPlot, which is also inside the renderUI.
observe({
session$onFlushed(function() {
shinyjs::runjs("var newHeight = $('.well').outerHeight(); $('#ridges').height(newHeight)")
}, once=TRUE)
})
Putting it together in one Shiny app:
library(shiny)
library(shinyjs)
library(ggplot2)
ui = fluidPage(
useShinyjs(),
titlePanel("This is just a test!"),
sidebarLayout(
sidebarPanel(
uiOutput("ridgeDates")
),
mainPanel(
uiOutput("ridgePlot")
))
)
server = function(input, output, session) {
output$ridgeDates <- renderUI({
rng <- round(runif(1, 15, 21))
radioButtons("choose", "A changing list", choices = 1:rng)
})
output$ridgePlot <- renderUI({
datax <- matrix(c(1,2,3,4,5,6),6,1)
datay <- matrix(c(1,7,6,4,5,3),6,1)
titleplot<-"title"
summary <- "testing text"
output$ridges <- renderPlot({
# pl <- plot(datax, datay, main = titleplot, xlab = "input$axis1", ylab = "input$axis2", pch=18, col="blue")
ggplot(NULL, aes(datax, datay))+
geom_point(colour = "#1e90ff")
})
observe({
session$onFlushed(function() {
shinyjs::runjs("var newHeight = $('.well').outerHeight(); $('#ridges').height(newHeight)")
}, once=TRUE)
})
plotOutput("ridges")
})
}
# Run the application
shinyApp(ui = ui, server = server)
My example:
I confess, I did post this question over on RStudio three days ago but it has not had enough love yet, so I'm trying again here. I hope that's okay. The original question is here (the text is the same in both, I'm just being transparent). https://community.rstudio.com/t/selecting-rows-from-a-dt-table-using-crosstalk-in-shiny/4079
So I would like to brush across points in D3Scatter and use it to filter the rows of a datatable produced using the DT package with crosstalk.
Just like this, which totally works outside of shiny:
library(crosstalk)
library(d3scatter)
library(DT)
shared_iris <- SharedData$new(iris)
bscols(d3scatter(shared_iris, ~Petal.Length, ~Petal.Width, ~Species, width = "100%",
x_lim = range(iris$Petal.Length), y_lim = range(iris$Petal.Width)),
datatable(shared_iris))
But when I put it in Shiny, I can select points on the scatter from the table, but not vice versa:
library(shiny)
library(crosstalk)
library(d3scatter)
library(DT)
ui <- fluidPage(
fluidRow(
column(6, d3scatterOutput("scatter1")),
column(6, DT::dataTableOutput("scatter2"))
)
)
server <- function(input, output, session) {
jittered_iris <- reactive({
iris
})
shared_iris <- SharedData$new(jittered_iris)
output$scatter1 <- renderD3scatter({
d3scatter(shared_iris, ~Petal.Length, ~Petal.Width, ~Species, width = "100%",
x_lim = range(iris$Petal.Length), y_lim = range(iris$Petal.Width))
})
output$scatter2 <- DT::renderDataTable({
datatable(shared_iris)
})
}
shinyApp(ui, server)
They’ve got it working here: https://rstudio-pubs-static.s3.amazonaws.com/215948_95c1ab86ad334d2f82856d9e5ebc16af.html
I’m at a loss. I feel like I’ve tried everything. Any clues anyone?
Thanks,
Crosstalk integration in DT only works with client-side processing . Try DT::renderDataTable with server = FALSE
library(shiny)
library(crosstalk)
library(d3scatter)
library(DT)
ui <- fluidPage(
fluidRow(
column(6, d3scatterOutput("scatter1")),
column(6, DT::dataTableOutput("scatter2"))
)
)
server <- function(input, output, session) {
jittered_iris <- reactive({
iris
})
shared_iris <- SharedData$new(jittered_iris)
output$scatter1 <- renderD3scatter({
d3scatter(shared_iris, ~Petal.Length, ~Petal.Width, ~Species, width = "100%",
x_lim = range(iris$Petal.Length), y_lim = range(iris$Petal.Width))
})
output$scatter2 <- DT::renderDataTable({
datatable(shared_iris)
}, server = FALSE)
}
shinyApp(ui, server)
DT should throw an error when using Crosstalk with server-side processing
Error in widgetFunc: Crosstalk only works with DT client mode: DT::renderDataTable({...}, server=FALSE)
but I think that broke here: https://github.com/rstudio/DT/commit/893708ca10def9cfe0733598019b62a8230fc52b
Guess I can file an issue on this if no one else has.
I have made four Plots in four boxes on a Shiny Dashboard Page. I wish to represent all the four plots dynamically in one box based on an input from Slider ranging from 1 to 4. All the plots are different and are not related. I wish to know the basic Syntax to do that. Thank you
As #Pork Chop commented you should check out the website which is going to help you in asking the question on stackoverflow.
As you are new in this community i am going give you a hint how to update shiny plots with input from slider.
Here is the code:
library(shiny)
library(shinydashboard)
library(ggplot2)
data <- data.frame(x=c(1,2,3,4),y=c(10,11,12,13))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(sliderInput("slider","Slider", min=1, max=4, step =1, value=1)),
dashboardBody(
fluidRow(column(6,plotOutput('plot1'),plotOutput('plot2')),
column(6,plotOutput('plot3'),plotOutput('plot4'))
)))
server <- function(input, output, session) {
output$plot1 <- renderPlot({
ggplot(data,aes_string(x=input$slider, y="y"))+geom_point(size=5)
})
output$plot2 <- renderPlot({
ggplot(data,aes_string(y=input$slider, x="y"))+geom_point(size=5)
})
output$plot3 <- renderPlot({
ggplot(data,aes_string(y=input$slider, x="y"))+geom_line(size=5)
})
output$plot4 <- renderPlot({
ggplot(data,aes_string(x=input$slider, y="y"))+geom_line(size=5)
})
}
shinyApp(ui, server)
Next time do not forget to create some sample code and sample data!
I have a drop down menu which is a selectizeInput - using which I need to subset my dataframe for analysis further.
Consider the following,
d - dataframe (has a column named 'test')
menu - the selectizeInput drop down
d[d$test %in% input$menu, ]
This doesn't do what I actually need to. Any thoughts?
It should work.
ui
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput("in", "in", choices = as.list(letters[1:10]), multiple = TRUE)
),
mainPanel(
verbatimTextOutput("view")
)
)
))
server
library(shiny)
d <- data.frame(test = letters[1:10], value = 1:10)
shinyServer(function(input, output) {
view <- reactive({d[d$test %in% input$"in", ]})
output$view <- renderPrint(view())
})
I am new to Shiny and am trying to add a chord diagram to a shiny server. When I hit the runApp button in RStudio I get the application to run and it generates the UI, but then closes down immediately and I get the following error in the RConsole window: Error in (structure(function (input, output) :
could not find function "renderplot".
Unfortunately, I cannot attach the data as it is proprietary, but I am just creating an adjacency matrix in order to generate the chord plot. The Chord plot works fine outside Shiny. Thanks in advance!
My UI and Server code is below:
library(shiny)
# Starting line
shinyUI(fluidPage(
# Application title
titlePanel("Chord Chart"),
# Sidebar
sidebarLayout(
sidebarPanel(
#Data selection for Chord Chart
selectInput("data","Select a Dataset:",
c("Marine"))),
#The plot created in server.R is displayed
mainPanel(
plotOutput("plot")
)))
)
library(circlize)
library(dplyr)
library(reshape2)
library(manipulate)
library(shiny)
# read marine summaries
marine <- readfile("C:/Personal/R/MarineDataSummary.csv")
# group and summarize by O-D
marine.sum <- marine %>%group_by(Handling_Port, OD_Port_Country) %>%
summarise(tons <-sum(tonnes)) # prepare pivot table
marine.sum1 <- acast(marine.sum, Handling_Port~OD_Port_Country, value.tons="z") # reshape matrix
marine.sum1[is.na(marine.sum1)] <- 0 # set NA to zero
#initialization of server.R
shinyServer(function(input, output) {
output$plot <- renderplot({
c <- chordDiagram(marine.sum1,annotationTrack="grid",preAllocateTracks=list(track.height = 0.3))
##change axis
c <- c + circos.trackPlotRegion(track.index=1, panel.fun=function(x,y) {
xlim = get.cell.meta.data("xlim")
ylim = get.cell.meta.data("ylim")
sector.name=get.cell.meta.data("sector.index")
circos.text(mean(xlim), ylim[1], sector.name,facing="clockwise",
niceFacing=TRUE,adj=c(0,0.4), cex = 0.4)},bg.border=NA)
print(c)
})
})