I want to create a shiny app that plots a heatmap based on compnay income and stuff and when that heatmap is plotted it should plot another graph depending on the user plot_click.
The complete code
library(shiny)
library(ggplot2)
library(gplots)
library(plotly)
Comp_name <- c("Dum1")
Inc <- c(175.26,175.365,175.65,176.65,176.165,176.1685,175.56)
Exp <- c(175.48,174.53,174.165,173.1651,175.651,174.16541,176.65)
Date <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dates <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dummy1 <- as.data.frame(cbind(Comp_name,Inc,Exp,Date,Dates))
Comp_name1 <- c("Dum2")
Inc1 <- c(151.26,151.59,151.23,152.46,152.49,151.29,150.81)
Exp1 <- c(152.64,152.84,152.64,152.48,152.35,154.26,153.14)
Date1 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dates1 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dummy2 <- as.data.frame(cbind(Comp_name1,Inc1,Exp1,Date1,Dates1))
Comp_name2 <- c("Dum3")
Inc2 <- c(160.45,161.25,163.56,165.25,163.59,160.89,161.26)
Exp2 <- c(160.19,160.78,162.15,164.89,165.24,163.25,162.48)
Date2 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dates2 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dummy3 <- as.data.frame(cbind(Comp_name2,Inc2,Exp2,Date2,Dates2))
Comp_name3 <- c("Dum4")
Inc3 <- c(156.26,155.12,157.12,158.78,154.26,160.12,161.26)
Exp3 <- c(160.19,160.19,155.19,154.26,150.12,157.26,159.12)
Date3 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dates3 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dummy4 <- as.data.frame(cbind(Comp_name3,Inc3,Exp3,Date3,Dates3))
Data <- cbind(Dummy1,Dummy2,Dummy3,Dummy4)
Data <- as.data.frame(Data)
ui <- fluidPage(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
),
titlePanel("Creating a database"),
sidebarLayout(
sidebarPanel(
textInput("name", "Company Name"),
numericInput("income", "Income", value = 1),
numericInput("expenditure", "Expenditure", value = 1),
dateInput("date", h3("Date input"),value = Sys.Date() ,min = "0000-01-01",
max = Sys.Date(), format = "dd/mm/yy"),
actionButton("Action", "Submit"), #Submit Button
actionButton("new", "New")),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Table", tableOutput("table")),
tabPanel("Download",
textInput("filename", "Enter Filename for download"), #filename
helpText(strong("Warning: Append if want to update existing data.")),
downloadButton('downloadData', 'Download'), #Button to save the file
downloadButton('Appenddata', 'Append')),#Button to update a file )
tabPanel("Plot",
actionButton("filechoose", "Choose File"),
br(),
selectInput("toplot", "To Plot", choices =c("Income" = "inc1",
"Expenditure" = "exp1",
"Compare Income And
Expenditure" = "cmp1",
"Gross Profit" = "gprofit1",
"Net Profit" = "nprofit1",
"Profit Lost" = "plost1",
"Profit Percent" = "pp1",
"Profit Trend" = "proftrend1"
)),
actionButton("plotit", "PLOT"),
plotOutput("Plot")),
tabPanel("Heatmap",
actionButton("combine","Combine"),
selectInput("ploth","Heatmap", "Plot Heatmap Of", choices =c("Income" = "inc2",
"Expenditure" = "exp2",
"Gross Profit" = "gprofit2",
"Net Profit" = "nprofit2")),
actionButton("hplotit","Plot Heatmap"),
plotlyOutput("HeatPlot"),
fixedRow(column(3,actionButton("retable","Show Table")),
column(3,actionButton("clear","Clear"))),
tableOutput("click"),
plotOutput("Next")
)
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output){
#Global variable to save the data
Data <- data.frame()
Results <- reactive(data.frame(input$name, input$income, input$expenditure,
as.character(input$date),
as.character(Sys.Date())))
#To append the row and display in the table when the submit button is clicked
observeEvent(input$Action,{
Data <<- rbind(Data,Results()) #Append the row in the dataframe
output$table <- renderTable(Data) #Display the output in the table
})
observeEvent(input$new, {
Data <<- NULL
output$table <- renderTable(Data)
})
observeEvent(input$filechoose, {
Data <<- read.csv(file.choose()) #Choose file to plot
output$table <- renderTable(Data) #Display the choosen file details
})
output$downloadData <- downloadHandler(
filename = function() {
paste(input$filename , ".csv", sep="")}, # Create the download file name
content = function(file) {
write.csv(Data, file,row.names = FALSE) # download data
})
output$Appenddata <- downloadHandler(
filename = function() {
paste(input$filename, ".csv", sep="")},
content = function(file) {
write.table( Data, file=file.choose(),append = T, sep=',',
row.names = FALSE, col.names = FALSE) # Append data in existing
})
observeEvent(input$plotit, {
inc <- c(Data[ ,2])
exp <- c(Data[ ,3])
date <- c(Data[,4])
gprofit <- c(Data[ ,2]- Data[ ,3])
nprofit <- c(gprofit - (gprofit*0.06))
z <- as.numeric(nrow(Data))
plost <- gprofit - nprofit
pp <- (gprofit/inc) * 100
proftrend <- c(gprofit[2:z]-gprofit[1:(z-1)])
slope = c(((proftrend[2:(z-1)]-proftrend[1:(z-2)])/1),0)
y = input$toplot
switch(EXPR = y ,
inc = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= inc))+
geom_bar(stat = "identity",
fill = "blue")+xlab("Dates")+
ylab("Income")+
theme(axis.text.x = element_text(angle = 90))),
exp = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= exp))+
geom_bar(stat = "identity",
fill = "red")+xlab("Dates")+
ylab("Expenditure")+
theme(axis.text.x = element_text(angle = 90))),
cmp = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4]))+
geom_line(aes(y= inc,group = 1, colour = "Income"))
+ geom_line(aes(y= exp,group =1, colour = "Expenditure"))+
xlab("Dates")+ ylab("Income (in lakhs)")+
scale_color_manual("",
breaks = c("Income","Expenditure"),
values = c(
"Income"="green",
"Expenditure"= "red"
))+
theme(axis.text.x = element_text(angle = 90))),
gprofit = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= gprofit))+
geom_bar(stat = "identity",
fill = "blue")+xlab("Dates")+
ylab("Gross Profit (in lakhs)")+
theme(axis.text.x = element_text(angle = 90))),
nprofit = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= nprofit))
+geom_bar(stat = "identity",
fill = "blue")+xlab("Dates")+
ylab("Net Profit (in lakhs)")+
theme(axis.text.x = element_text(angle = 90))),
plost = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= plost))
+geom_bar(stat = "identity",
fill = "blue")+xlab("Dates")+
ylab("Profit Lost (in lakhs)")+
theme(axis.text.x = element_text(angle = 90))),
pp = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= pp))+
geom_bar(stat = "identity",
fill = "blue")+xlab("Dates")+
ylab("Profit Percentage")+
theme(axis.text.x = element_text(angle = 90))),
proftrend = output$Plot <- renderPlot(ggplot()+
geom_line(data = as.data.frame(date[2:z]),
aes(x= Data[c(2:z),4] , y= proftrend,
group = 1, color = slope > 0))+
xlab("Dates")+ ylab("Profit Trend")+
theme(axis.text.x = element_text(angle = 90))
))})
output$table <- renderTable(Data)}) #Display the choosen file details
observeEvent(input$hplotit, {
inc1 <- as.data.frame(cbind(Dummy1 = Data[,2],Dummy2 = Data[,7],
Dummy3 = Data[,12], Dummy4 = Data[,17]))
inc2 <- as.matrix(inc1)
exp1 <- as.data.frame(cbind(Dummy1 = Data[,3],Dummy2 = Data[,8],
Dummy3 = Data[,13], Dummy4 = Data[,18]))
exp2 <- as.matrix(exp1)
gprofit1 <- as.data.frame(cbind(Dummy1 = Data[,3] - Data[,2],
Dummy2 = Data[,8] - Data[,7],
Dummy3 = Data[,13] - Data[,12],
Dummy4 = Data[,18] - Data[,17]))
gprofit2 <- as.matrix(gprofit1)
nprofit1 <- as.data.frame(cbind(Dummy1 = (Data[,3] - Data[,2]) - ((Data[,3] - Data[,2]) * 0.06),
Dummy2 = (Data[,8] - Data[,7]) - ((Data[,8] - Data[,7]) * 0.10),
Dummy3 = (Data[,13] - Data[,12]) - ((Data[,13] - Data[,12]) * 0.18),
Dummy4 = (Data[,18] - Data[,17]) - ((Data[,18] - Data[,17]) * 0.22)))
nprofit2 <- as.matrix(nprofit1)
date <- as.character(Data[,4])
h <- input$ploth
switch(EXPR = h ,
inc2 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(inc2), y = date,
z = inc2, type = "heatmap",
colorscale = "Earth")),
exp2 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(exp2), y = date,
z = exp2, type = "heatmap",
colors = colorRamp(c("red",
"yellow")))),
gprofit2 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(gprofit2),
y = date, z = gprofit2,
type = "heatmap",
colorscale="Greys")),
nprofit2 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(nprofit2),
y = date, z = nprofit2,
type = "heatmap"))
)
})
observeEvent(input$retable, {
inc1 <- as.data.frame(cbind(Dummy1 = Data[,2],Dummy2 = Data[,7],
Dummy3 = Data[,12], Dummy4 = Data[,17]))
inc2 <- as.matrix(inc1)
exp1 <- as.data.frame(cbind(Dummy1 = Data[,3],Dummy2 = Data[,8],
Dummy3 = Data[,13], Dummy4 = Data[,18]))
exp2 <- as.matrix(exp1)
gprofit1 <- as.data.frame(cbind(Dummy1 = round(Data[,3] - Data[,2],2),
Dummy2 = round(Data[,8] - Data[,7],2),
Dummy3 = round(Data[,13] - Data[,12],2),
Dummy4 = round(Data[,18] - Data[,17],2)))
gprofit2 <- as.matrix(gprofit1)
nprofit1 <- as.data.frame(cbind(Dummy1 = round((Data[,3] - Data[,2]) - ((Data[,3] - Data[,2]) * 0.06),2),
Dummy2 = round((Data[,8] - Data[,7]) - ((Data[,8] - Data[,7]) * 0.10),2),
Dummy3 = round((Data[,13] - Data[,12]) - ((Data[,13] - Data[,12]) * 0.18),2),
Dummy4 = round((Data[,18] - Data[,17]) - ((Data[,18] - Data[,17]) * 0.22),2)))
nprofit2 <- as.matrix(nprofit1)
h <- input$ploth
did <- cbind(Date = (as.character(Data[,4])),get(h))
output$click <- renderTable(did)})
observeEvent(input$clear, {
did <<- NULL
output$click <- renderTable(did)
})
output$Next <- renderPlot({
event.data <- event_data(event = "plotly_click")
vars <- event.data[["x"]]
vars <- as.character(vars())
inc1 <- as.data.frame(cbind(Dummy1 = Data[,2],Dummy2 = Data[,7],
Dummy3 = Data[,12], Dummy4 = Data[,17]))
inc2 <- as.matrix(inc1)
exp1 <- as.data.frame(cbind(Dummy1 = Data[,3],Dummy2 = Data[,8],
Dummy3 = Data[,13], Dummy4 = Data[,18]))
exp2 <- as.matrix(exp1)
gprofit1 <- as.data.frame(cbind(Dummy1 = round(Data[,3] - Data[,2],2),
Dummy2 = round(Data[,8] - Data[,7],2),
Dummy3 = round(Data[,13] - Data[,12],2),
Dummy4 = round(Data[,18] - Data[,17],2)))
gprofit2 <- as.matrix(gprofit1)
nprofit1 <- as.data.frame(cbind(Dummy1 = round((Data[,3] - Data[,2]) - ((Data[,3] - Data[,2]) * 0.06),2),
Dummy2 = round((Data[,8] - Data[,7]) - ((Data[,8] - Data[,7]) * 0.10),2),
Dummy3 = round((Data[,13] - Data[,12]) - ((Data[,13] - Data[,12]) * 0.18),2),
Dummy4 = round((Data[,18] - Data[,17]) - ((Data[,18] - Data[,17]) * 0.22),2)))
nprofit2 <- as.matrix(nprofit1)
h <- input$ploth
did <- cbind(Date = (as.character(Data[,4])),get(h))
if(is.null(event.data)) NULL else plot(x = as.character.Date(Data[,4]) ,y = did$vars)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Important Parts
Shiny.ui
tabPanel("Heatmap",
actionButton("combine","Combine"),
selectInput("ploth","Heatmap", "Plot Heatmap Of", choices =c("Income" = "inc2",
"Expenditure" = "exp2",
"Gross Profit" = "gprofit2",
"Net Profit" = "nprofit2")),
actionButton("hplotit","Plot Heatmap"),
plotlyOutput("HeatPlot"),
fixedRow(column(3,actionButton("retable","Show Table")),
column(3,actionButton("clear","Clear"))),
tableOutput("click"),
plotOutput("Next")
Shiny.server
output$Next <- renderPlot({
event.data <- event_data(event = "plotly_click")
vars <- event.data[["x"]]
vars <- as.character(vars())
inc1 <- as.data.frame(cbind(Dummy1 = Data[,2],Dummy2 = Data[,7],
Dummy3 = Data[,12], Dummy4 = Data[,17]))
inc2 <- as.matrix(inc1)
exp1 <- as.data.frame(cbind(Dummy1 = Data[,3],Dummy2 = Data[,8],
Dummy3 = Data[,13], Dummy4 = Data[,18]))
exp2 <- as.matrix(exp1)
gprofit1 <- as.data.frame(cbind(Dummy1 = round(Data[,3] - Data[,2],2),
Dummy2 = round(Data[,8] - Data[,7],2),
Dummy3 = round(Data[,13] - Data[,12],2),
Dummy4 = round(Data[,18] - Data[,17],2)))
gprofit2 <- as.matrix(gprofit1)
nprofit1 <- as.data.frame(cbind(Dummy1 = round((Data[,3] - Data[,2]) - ((Data[,3] - Data[,2]) * 0.06),2),
Dummy2 = round((Data[,8] - Data[,7]) - ((Data[,8] - Data[,7]) * 0.10),2),
Dummy3 = round((Data[,13] - Data[,12]) - ((Data[,13] - Data[,12]) * 0.18),2),
Dummy4 = round((Data[,18] - Data[,17]) - ((Data[,18] - Data[,17]) * 0.22),2)))
nprofit2 <- as.matrix(nprofit1)
h <- input$ploth
did <- cbind(Date = (as.character(Data[,4])),get(h))
if(is.null(event.data)) NULL else plot(x = as.character.Date(Data[,4]) ,y = did$vars, type = "o")
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have an app ready and it works but the final step of plotting the next graph after the click is not working because of
Warning: Error in : $ operator is invalid for atomic vectors
I know the error is in
event.data <- event_data(event = "plotly_click")
vars <- event.data[["x"]]
Because i cant use the even_data input to call the columns. Please help in what i should do to convert it so that i can call the "vars" in the "did" data frame so that the final graph can be plotted. Please also tell if there is some other problem also. Thank You.
Some sample data
Comp_name <- c("Dum1")
Inc <- c(175.26,175.365,175.65,176.65,176.165,176.1685,175.56)
Exp <- c(175.48,174.53,174.165,173.1651,175.651,174.16541,176.65)
Date <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dates <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dummy1 <- as.data.frame(cbind(Comp_name,Inc,Exp,Date,Dates))
Comp_name1 <- c("Dum2")
Inc1 <- c(151.26,151.59,151.23,152.46,152.49,151.29,150.81)
Exp1 <- c(152.64,152.84,152.64,152.48,152.35,154.26,153.14)
Date1 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dates1 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dummy2 <- as.data.frame(cbind(Comp_name1,Inc1,Exp1,Date1,Dates1))
Comp_name2 <- c("Dum3")
Inc2 <- c(160.45,161.25,163.56,165.25,163.59,160.89,161.26)
Exp2 <- c(160.19,160.78,162.15,164.89,165.24,163.25,162.48)
Date2 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dates2 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dummy3 <- as.data.frame(cbind(Comp_name2,Inc2,Exp2,Date2,Dates2))
Comp_name3 <- c("Dum4")
Inc3 <- c(156.26,155.12,157.12,158.78,154.26,160.12,161.26)
Exp3 <- c(160.19,160.19,155.19,154.26,150.12,157.26,159.12)
Date3 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dates3 <- c(2018-06-01,2018-06-02,2018-06-03,2018-06-04,2018-06-05,2018-06-06,2018-06-07)
Dummy4 <- as.data.frame(cbind(Comp_name3,Inc3,Exp3,Date3,Dates3))
Data <- cbind(Dummy1,Dummy2,Dummy3,Dummy4)
Data <- as.data.frame(Data)
