As i have written code to control single data table and the code is
under ui:
library(shiny)
fluidPage(
titlePanel(title=h2(" Lucas Tvs",align="center")),
sidebarPanel(
conditionalPanel(condition="input.tabs1=='profitloss'",
selectInput("Operations","Select the desired ProfitLoss statement",choices = profitloss1$Operations)),
conditionalPanel(condition="input.tabs1=='Ratio'",
selectInput("Ratio","Select the desired Ratios",choices=ratios1$Ratios)),
conditionalPanel(condition="input.tabs1=='Balancesheet'",
selectInput("Particulars","Select the desired Balancesheet statement", choices = Balancesheet$Particulars))
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("profitloss",column(5,tableOutput("profitloss")), column(7,plotOutput("plot"))),
tabPanel("Ratio",column(5,tableOutput("Ratio")),column(6,plotOutput("plot2"))),
tabPanel("Balancesheet",column(5,tableOutput("Balancesheet")),column(6,plotOutput("plot1")))
)
)
)
under sever:
library(shiny)
library(ggplot2)
shinyServer(function(input,output){
output$profitloss<-renderTable({
oporationfilter<-profitloss1[profitloss1$Operations==input$Operations,c("Years","Value")]
})
output$Ratio<-renderTable({
ratiofilter<-ratios1[ratios1$Ratios==input$Ratio,c("Years","Value")]
})
output$Balancesheet<-renderTable({
Balancesheetfilter<-Balancesheet[Balancesheet$Particulars==input$Particulars,c("Years","Value")]
})
output$plot<-renderPlot({
options(scipen = 999)
p<-ggplot(data = profitloss1[profitloss1$Operations==input$Operations,]
,aes(x=Years,y=Value))
p+geom_line()+xlab("Years")+ylab("Value in Lakhs")+ggtitle("Profitloss Plot")
})
output$plot2<-renderPlot({
q<-ggplot(data = ratios1[ratios1$Ratios==input$Ratio,]
,aes(x=Years,y=Value))
q+geom_line()+xlab("Years")+ylab("value in lakhs")+ggtitle("Ratios Plot ")
})
output$plot1<-renderPlot({
q<-ggplot(data = Balancesheet[Balancesheet$Particulars==input$Particulars,]
,aes(x=Years,y=Value))
q+geom_line()+xlab("Years")+ylab("value in lakhs")+ggtitle("Balance sheet Plot")
})
})
And now i want to add one more table in a main panel but control will be from a single input.
its mean if i click on operations of profitloss1 or ratios....then that will show me two table with a single click.
Related
I'm a bit of an RShiny and R novice. I'm trying to program an RShiny application. It would initially graphs a scatterplot matrix using the first three variables of the dataset by default. The user could then choose their own variable selections from a complete list of variables. Once variables are chosen, the user would click and action button and the graph would be recomputed using the newly selected variables.
I'm using selectinput rather than checkboxinput to accommodate datasets with many variables. I'm using the iris dataset. The code below produces the initial graph and allows the user to select the variables. I just can't figure out how to make it recompute the matrix plot. How do I do this? Thanks!
library(shiny)
runApp(list(
ui = fluidPage(
cols = colnames(iris),
headerPanel('Grow Clusters'),
tabsetPanel(
tabPanel("Plot",
sidebarPanel(
# uiOutput("varselect"),
selectInput("choose_vars", "Select variables to plot",
choices=colnames(iris), selected=iris[1:3], multiple=T),
actionButton("submitButton", "Produce Matrix Plot!")
),
mainPanel(
plotOutput('pairsplot')
)
),
tabPanel("Summary")
,
tabPanel("Table")
)
),
server = function(input, output) {
selectedData <- reactive({
cols = colnames(iris)
selectInput("choose_vars", "Select variables to plot",
choices=cols, selected=cols[1:3], multiple=T)
})
output$pairsplot <- renderPlot({
pairs(iris[1:3], pch = 21)
})
output$varselect <- renderUI({
iris[input$choose_vars]
plotOutput("pairsplot")
})
}
)
)
I think what you are looking for is quo function as in the Chris Beely blog: https://chrisbeeley.net/?p=1116
If you want users to pass arguments and then turn that character vector into objects r can read you need to use quo(input$choose_vars) and then in the plot you need to add !! before that passing variable. Notice you need to load dplyr.
library(shiny)
library(dplyr)
runApp(list(
ui = fluidPage(
cols = colnames(iris),
headerPanel('Grow Clusters'),
tabsetPanel(
tabPanel("Plot",
sidebarPanel(
# uiOutput("varselect"),
selectInput("choose_vars", "Select variables to plot",
choices=colnames(iris), selected=iris[1:3], multiple=T),
actionButton("submitButton", "Produce Matrix Plot!")
),
mainPanel(
plotOutput('pairsplot')
)
),
tabPanel("Summary")
,
tabPanel("Table")
)
),
server = function(input, output) {
selectedData <- reactive({
cols <- colnames(iris)
selectInput("choose_vars", "Select variables to plot",
choices=cols, selected=cols[1:3], multiple=T)
})
output$pairsplot <- renderPlot({
if(is.null(input$choose_vars) || length(input$choose_vars)<2){
pairs(iris[1:3], pch = 21)
} else {
var <- quo(input$choose_vars)
pairs(iris %>% select(!!var), pch = 21)
}
})
output$varselect <- renderUI({
iris[input$choose_vars]
plotOutput("pairsplot")
})
}
)
)
I am struggling trying to graph two overlaying plots and add checkboxes fro displaying them in my Rshiny app. I am using the following code:
library(shiny)
library(shinyjs)
mpgData <- mtcars
ui <- fluidPage(
# Application title
titlePanel("Test"),
# Sidebar with checkboxes to select plot
sidebarLayout(
sidebarPanel(
helpText("Select type of plot:"),
checkboxGroupInput("checkPlot",
label = ("Plots"),
choices=c("Baseline","Scenario A"),
selected = c("Baseline","Scenario A")
)
),
mainPanel(
textOutput("overview"),
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
#get Check group input (type of plot)
checkedVal <- reactive({
as.vector(input$checkPlot)
})
#plot
output$plot <- renderPlot({
if(("Baseline" %in% checkedVal()) & ("Scenario A" %in% checkedVal()))
# first plot
plot(mpgData$mpg, mpgData$cyl, type='l',col="steelblue",ylim=range(c(mpgData$cyl,mpgData$disp)))
# second plot
par(new = TRUE)
plot(mpgData$mpg, mpgData$disp, type = "l",col="red", ylim=range(c(mpgData$cyl,mpgData$disp)), axes = FALSE, xlab = "", ylab = "")
if ("Baseline" %in% checkedVal())
plot(mpgData$mpg, mpgData$cyl, type='l',col = "steelblue")
if ("Scenario A" %in% checkedVal())
plot(mpgData$mpg, mpgData$disp, type='l',col = "red")
})
}
shinyApp(ui, server)
My checkboxes seem to be working out alright when I just want one graph to be displayed, however, there's definitely an issue when I want to display both on the same axes. Most examples I saw were a little too complex for me to understand and break down, so I tired to infer from previous R knowledge, but clearly I'm off.
any help is much appreciated !
If you were trying to add the baseline on the existing graph, you could use the lines function, as below. Although if for your particular data-set, the base line is really negligible compared to the original plot, you need to use a package other than 'base', like 'ggplot'.
library(shiny)
library(shinyjs)
mpgData <- mtcars
ui <- fluidPage(
# Application title
titlePanel("Test"),
# Sidebar with checkboxes to select plot
sidebarLayout(
sidebarPanel(
helpText("Select type of plot:"),
checkboxGroupInput("checkPlot",
label = ("Plots"),
choices=c("Baseline","Scenario A"),
selected = c("Baseline","Scenario A")
)
),
mainPanel(
textOutput("overview"),
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
#get Check group input (type of plot)
checkedVal <- reactive({
as.vector(input$checkPlot)
})
#plot
# first plot
output$plot <- renderPlot({
if(("Baseline" %in% checkedVal()) & ("Scenario A" %in% checkedVal()))
{ plot(mpgData$mpg, mpgData$cyl, type='l',col="steelblue",ylim=range(c(mpgData$cyl,mpgData$disp)))
lines(mpgData$mpg, mpgData$disp, type = "l",col="red")
}
else if("Baseline" %in% checkedVal())
{
plot(mpgData$mpg, mpgData$cyl, type='l',col = "steelblue")
}
else if("Scenario A" %in% checkedVal())
{
plot(mpgData$mpg, mpgData$disp, type='l',col = "red")
}
})
}
shinyApp(ui, server)
Please let me know if this works for you.
I have a shiny application with the following ui:
library(rhandsontable)
library(shiny)
library(ggplot2)
ui = fluidPage(
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Tabset w/ plot, summary, and table ----
tabsetPanel(type = "tabs",
tabPanel("Summary", rHandsontableOutput('contents'),
actionButton("saveBtn", "Save changes")
),
tabPanel("Tab",
rHandsontableOutput('contentFinal')),
tabPanel("Dashboard",
plotOutput('dashboard1'))
)
)
)
)
And the following server
library(dplyr)
library(rhandsontable)
options(shiny.maxRequestSize = 9*1024^2)
server = function(input, output) {
values <- reactiveValues()
Post <- c("", "")
list2 <- c(12,13)
df <- data.frame(Post, list2)
output$contents <- renderRHandsontable({
rhandsontable(df, width = 550, height = 300) %>%
hot_col(col = "Post", type = "dropdown")
})
saveData <- eventReactive({input$saveBtn},{
finalDF <- hot_to_r(input$contents)
finalDF$Post <- ifelse(finalDF$Post =="",NA,finalDF$Post)
newDF <- finalDF[complete.cases(finalDF),]
return(newDF)
})
output$contentFinal <- renderRHandsontable(
rhandsontable(saveData())
)
output$dashboard1 <- renderPlot(
ggplot(input$contentFinal, aes(x = Post, y = list2 )) +
geom_bar(stat = "identity")
)
observeEvent(input$saveBtn, saveData())
}
shinyApp(ui = ui, server = server)
The flow is like this:
In the first tab, I bring up data with an empty post column
In this tab, I can add a name for the post and save it.
As soon as I save he rows with values for post become visible in the next tab.
Then the next thing I want to do is to have a visual in the dashboard tab that shows the data. Therefore I create:
output$dashboard1 <- renderPlot(
ggplot(input$contentFinal, aes(x = Post, y = List2 )) +
geom_bar(stat = "identity")
)
This however gives me the following ggplot2 errror:
ggplot2 doesn't know how to deal with data of class list
Any thoughts on what goes wrong here?
The problem is because input$contentFinal is handsontable data. We need to convert it to R object using hot_to_r function.
The ggplot should be plotted using the following:
ggplot(hot_to_r(input$contentFinal), aes(x = Post, y = list2 )) +
geom_bar(stat = "identity")
Hope it helps!
**#Ui.code:**
library(shiny)
fluidPage(
titlePanel(title=h2(" Lucas Tvs",align="center")),
sidebarPanel(
conditionalPanel(condition="input.tabs1=='Profit Loss'",
selectInput("Operations","Select the desired Profit Loss statement",choices = profitloss1$Operations)),
br(),
conditionalPanel(condition="input.tabs1=='Profit Loss'",
selectInput("summary1","Select the desired Summary",choices = summary1$OPERATIONS)),
conditionalPanel(condition="input.tabs1=='Ratio'",
selectInput("Ratio","Select the desired Ratios",choices=ratios1$Ratios)),
br(),
conditionalPanel(condition="input.tabs1=='Ratio'",
selectInput("summary","Select the desired Summary",choices = summary$RATIO)),
conditionalPanel(condition="input.tabs1=='Balancesheet'",
selectInput("Particulars","Select the desired Balancesheet statement", choices = Balancesheet$Particulars)),
br(),
conditionalPanel(condition="input.tabs1=='Balancesheet'",
selectInput("summary2","Select the desired Summary",choices = summary2$PARTICULARS))
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("Profit Loss",column(5,tableOutput("profitloss")), column(7,plotOutput("plot")),tableOutput("summary1")),
tabPanel("Ratio",column(5,tableOutput("Ratio")),column(7,plotOutput("plot2")),tableOutput("summary")),
tabPanel("Balancesheet",column(5,tableOutput("Balancesheet")),column(6,plotOutput("plot1")),tableOutput("summary2"))
)
)
)
In the UI part I have created 3 tabs in the main panel and 2 select inputs in the sidebar panel.All those are reacting dynamically but now I want my code to show me that both the select input in the side bar panel are mutually dependent on each other.
#server code:
library(shiny)
library(ggplot2)
shinyServer(function(input,output){
output$profitloss<-renderTable({
oporationfilter<-profitloss1[profitloss1$Operations==input$Operations,c("Years","Value")]
})
output$Ratio<-renderTable({
ratiofilter<-ratios1[ratios1$Ratios==input$Ratio,c("Years","Value")]
})
output$Balancesheet<-renderTable({
Balancesheetfilter<-Balancesheet[Balancesheet$Particulars==input$Particulars,c("Years","Value")]
})
output$summary<-renderTable({
summaryfilter<-summary[summary$RATIO==input$summary,c("Mean","Standard.Deviation","CAGR.1","CAGR.3","CAGR.5")]
})
output$summary1<-renderTable({
summary1filter<-summary1[summary1$OPERATIONS==input$summary1,c("Mean","Standard.Deviation","CAGR.1","CAGR.3","CAGR.5","CAGR.7")]
})
output$summary2<-renderTable({
summary2filter<-summary2[summary2$PARTICULARS==input$summary2,c("Mean","Standard.Deviation","CAGR.1","CAGR.3","CAGR.5")]
})
output$plot<-renderPlot({
options(scipen = 999)
p<-ggplot(data = profitloss1[profitloss1$Operations==input$Operations,]
,aes(x=Years,y=Value))
p+geom_line()+xlab("Years")+ylab("Value in Lakhs")+ggtitle("Profitloss Plot")
})
output$plot2<-renderPlot({
q<-ggplot(data = ratios1[ratios1$Ratios==input$Ratio,]
,aes(x=Years,y=Value))
q+geom_line()+xlab("Years")+ylab("value in lakhs")+ggtitle("Ratios Plot ")
})
output$plot1<-renderPlot({
q<-ggplot(data = Balancesheet[Balancesheet$Particulars==input$Particulars,]
,aes(x=Years,y=Value))
q+geom_line()+xlab("Years")+ylab("value in lakhs")+ggtitle("Balancesheet Plot")
})
})
This is the code for designing of the website now I want my both the select input should be mutually dependent.
for example: If select in XXX in drop down menu I should automatically get the same output in the 2nd select input.
I am trying to create small application using Shiny. Below is the data frame for which I am trying to create.
data<-data.frame(state=c('AZ','VA','CA','AZ','VA','CA'), city=c('Phoenix','Arlington','SantaClara','Mesa','Richmond','SF'),
avg=c(10,15,16,13,14,14), date=c('01/09/2017','01/10/2017','01/11/2017','02/09/2017','02/10/2017','02/10/2017'),stringsAsFactors = FALSE)
So, I am trying to create a graph between date(x-axis) and avg(y-axis). So this graph should change based on the selection from dropdown list of State.For example, for a particular selected state, it should show cities available(in other dropdown) in that state.
Below is my code:
library(shiny)
library(ggplot2)
library(plotly)
statelist<-as.list(data$state)
citylist<-as.list(data$city)
ui <- basicPage(
# plotOutput("plot1", click = "plot_click"),
# verbatimTextOutput("info")
sidebarPanel(
selectInput("plot1", label=h3("Select State"), choices = statelist),
selectInput("plot2", label=h3("Select City"), choices = citylist)
),
plotOutput(outputId="plot")
),
server <- function(input, output, session) {
observe(
{
state <- input$plot1
updateSelectInput(session, "plot2", choices = data$city[data$state == state])
}
),
output$plot<-renderPlot({
ggplot(data[data$city == input$plot2 &
data$state == input$plot1],aes(date,avg))
+geom_line()
})
}
shinyApp(ui, server)
Dropdown is working perfectly but not getting the graph.
Thanks in advance!!
I made some minor modifications to your code:
There were some commas in places where they should not be: after the ui constructor, and after the observe constructor.
There was a comma missing in data[data$city == input$plot2 &
data$state == input$plot1,]
I edited your observe to be an observeEvent
I modified the plot to show that it actually changes, since the sample data is quite limited.
Hope this helps!
library(shiny)
library(ggplot2)
library(plotly)
data<-data.frame(state=c('AZ','VA','CA','AZ','VA','CA'), city=c('Phoenix','Arlington','SantaClara','Mesa','Richmond','SF'),
avg=c(10,15,16,13,14,14), Date=c('01/09/2017','01/10/2017','01/11/2017','02/09/2017','02/10/2017','02/10/2017'),stringsAsFactors = FALSE)
statelist<-unique(data$state)
citylist<-unique(data$city)
ui <- basicPage(
# plotOutput("plot1", click = "plot_click"),
# verbatimTextOutput("info")
sidebarPanel(
selectInput("plot1", label=h3("Select State"), choices = statelist),
selectInput("plot2", label=h3("Select City"), choices = citylist)
),
plotOutput(outputId="plot")
)
server <- function(input, output, session) {
observeEvent(input$plot1,
{
state <- input$plot1
updateSelectInput(session, "plot2", choices = data$city[data$state == state])
}
)
output$plot<-renderPlot({
data = data[data$city == input$plot2 &
data$state == input$plot1,]
ggplot(data,aes(Date,avg)) + geom_point(size=5) + ggtitle(paste0(input$plot1," - ",input$plot2 ))
})
}
shinyApp(ui, server)