I want to ceate a shiny app that gives heatmap of different aspects of data and when i click in the heatmap it gives one more graph that tells more about a particular company. I have created one but after the heatmap has been plotted when i click on the heatmap at a particular point the next graph is not plot nor is some error shown.
library(shiny)
library(ggplot2)
library(gplots)
ui <- fluidPage(
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", "Plot Heatmap Of", choices =c("Income" = "inc1",
"Expenditure" = "exp1",
"Gross Profit" = "gprofit1",
"Net Profit" = "nprofit1")),
actionButton("hplotit","Plot Heatmap"),
plotlyOutput("HeatPlot"),
textOutput("HAha"),
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))
))})
observeEvent(input$combine, {
Data <<- cbind(read.csv(file.choose()),read.csv(file.choose()),read.csv(file.choose()),read.csv(file.choose()))
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]))
inc1 <- as.matrix(inc1)
exp1 <- as.data.frame(cbind(Dummy1 = Data[,3],Dummy2 = Data[,8],Dummy3 = Data[,13], Dummy4 = Data[,18]))
exp1 <- 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]))
gprofit1 <- 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)))
nprofit1 <- as.matrix(nprofit1)
date <- as.character(Data[,4])
h = input$ploth
switch(EXPR = h ,
inc1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(inc1), y = date, z = inc1, type = "heatmap", colorscale = "Earth")),
exp1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(exp1), y = date, z = exp1, type = "heatmap", colors = colorRamp(c("red", "yellow")))),
gprofit1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(gprofit1), y = date, z = gprofit1, type = "heatmap", colorscale="Greys")),
nprofit1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(nprofit1), y = date, z = nprofit1, type = "heatmap"))
)
})
output$HAha <- renderText({
event_data(event = "plotly_click", source = "heatplot")
})
output$Next <- renderPlot({
d <- event_data(event = "plotly_click", source = "heatplot")
vars <- c(d[["x"]])
if(is.null(d))return(NULL)
else
switch(EXPR = vars,
Dummy1 = plot(x = Data[,4], y = inc1$vars),
Dummy2 = plot(x = Data[,4], y = exp1$vars),
Dummy3 = plot(x = Data[,4], y = gprofit1$vars),
Dummy4 = plot(x = Data[,4], y = nprofit1$vars)
)})
}
# Run the application
shinyApp(ui = ui, server = server)
What i want is that after a heatmap like
has been plotted when i click on any one cell, a further line chart is plotted depending on values from that particular selected column.
What is it that i am missing? PLease Help. Data is a set of 4 csv files so cannot be put over here. Sorry.
The main code parts that matter are
ui.server
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", "Plot Heatmap Of", choices =c("Income" = "inc1",
"Expenditure" = "exp1",
"Gross Profit" = "gprofit1",
"Net Profit" = "nprofit1")),
actionButton("hplotit","Plot Heatmap"),
plotlyOutput("HeatPlot"),
plotlyOutput("Next")
shiny.server
observeEvent(input$hplotit, {
inc1 <- as.data.frame(cbind(Dummy1 = Data[,2],Dummy2 = Data[,7],Dummy3 = Data[,12], Dummy4 = Data[,17]))
inc1 <- as.matrix(inc1)
exp1 <- as.data.frame(cbind(Dummy1 = Data[,3],Dummy2 = Data[,8],Dummy3 = Data[,13], Dummy4 = Data[,18]))
exp1 <- 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]))
gprofit1 <- 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)))
nprofit1 <- as.matrix(nprofit1)
date <- as.character(Data[,4])
h = input$ploth
switch(EXPR = h ,
inc1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(inc1), y = date, z = inc1, type = "heatmap", colorscale = "Earth")),
exp1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(exp1), y = date, z = exp1, type = "heatmap", colors = colorRamp(c("red", "yellow")))),
gprofit1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(gprofit1), y = date, z = gprofit1, type = "heatmap", colorscale="Greys")),
nprofit1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(nprofit1), y = date, z = nprofit1, type = "heatmap"))
)
})
output$HAha <- renderText({
event_data(event = "plotly_click", source = "heatplot")
})
output$Next <- renderPlot({
d <- event_data(event = "plotly_click", source = "heatplot")
vars <- c(d[["x"]])
if(is.null(d))return(NULL)
else
switch(EXPR = vars,
Dummy1 = plot(x = Data[,4], y = inc1$vars),
Dummy2 = plot(x = Data[,4], y = exp1$vars),
Dummy3 = plot(x = Data[,4], y = gprofit1$vars),
Dummy4 = plot(x = Data[,4], y = nprofit1$vars)
)})
}
})
The ploth is in both places so that the computer knows if dummyy1 is selected then it has to plot income only. Dont have to give two selected inputs for both.
Related
I created a shinyapp and there are three vital buttons.
The three buttons works well
And the click3 can output a plot and a table togather.
Now in my app they just refresh each other but only the table still stay each time.
My question is now I want to modify some parts, I hope:
plot1 and plot2 will not refresh click3(plot3 and table) and click3 will not refresh plot1 or plot2.
######### EDIT:2021-04-22 21:09:43
Sorry about that I didn't clarify my question.
Now p1(),p2(), myPlot can refresh each other.
But I hope myPlot and myTable can keep stay until new click3 refresh themself. p1() and p2() can refresh each other but will not affect myPlot and myTable
So that p1() or p2() could stay togather with myPlot and myTable in mainparnel.
My reproducible code and data here:
library(shiny)
library(ggplot2)
## load("04.21_3.RData")
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
############
ui <- fluidPage(
sidebarPanel(
selectizeInput(
"selectGeneSymbol",
"Select:",
choices = NULL,
multiple =F,
width = 400,
selected = NULL,
options = list(placeholder = 'e.g. gene here',create = F)
),
actionButton("plot1", "click1"),
actionButton("plot2", "click2"),
actionButton("dataTable", "click3")
),
mainPanel(
uiOutput("all"),
# plotOutput("myPlot"),
tableOutput("myTable")
)
)
server <- function(input, output, session) {
updateSelectizeInput(session, "selectGeneSymbol", choices = colnames(mean_data[,-1]), server = TRUE)
global <- reactiveValues(out = NULL,
p1 = NULL,
p2 = NULL)
plotdata <- eventReactive(input$plot1,{
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
output$all <- renderUI({ ##
global$out
})
observeEvent(input$plot1, {
global$out <- plotOutput("plot1")
})
##
observeEvent(input$plot2, {
global$out <- plotOutput("plot2")
myData(NULL)
})
observeEvent(input$dataTable, {
global$out <- plotOutput("myPlot")
myData(NULL)
})
####
myPlot = reactiveVal()
myData = reactiveVal()
observeEvent(input$dataTable, {
data_cor<-mean_data[,-1]
tm <- corr.test(data_cor[,input$selectGeneSymbol,drop=FALSE],
y = data_cor, use = "pairwise", "spearman", adjust="none",
alpha=0.05, ci=F, minlength=5)
res <-setNames(as.data.frame(t(do.call(rbind, tm[c("r", "p")]))), c("Correlation", "P_value"))
res<-res[-which(rownames(res)== input$selectGeneSymbol),]
res<-data.frame(Gene=rownames(res),res)
res
##############
data_correlation=t(mean_data[, -1])
data_subset=data_correlation[c(input$selectGeneSymbol, as.vector(head(res$Gene, 10))), ]
myPlot(
pheatmap(log2(data_subset+1), show_colnames = F,fontsize_row =12,
cluster_rows = F, cluster_cols = F, gaps_row = 1)
)
myData(res)
})
output$myPlot = renderPlot({
myPlot()
})
output$myTable = renderTable({
myData()
})
####
p1 <- eventReactive(input$plot1,
{
ggplot(data =plotdata(), aes(x = Name, y = .data[[as.name(input$selectGeneSymbol)]])) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
theme(legend.position = "none") +
labs(title = paste(input$selectGeneSymbol), x = NULL, y = "666666") })
p2 <- eventReactive(input$plot2,
{
ggplot(data = plotdata(), aes(x = Name, y = .data[[as.name(input$selectGeneSymbol)]], fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
theme(legend.position = "none") +
labs(title = paste(input$selectGeneSymbol), x = NULL, y = "777777") })
output$plot1 <- renderPlot({
p1()})
output$plot2 <- renderPlot({
p2()})
}
shinyApp(ui, server)
Perhaps this is your expectation
library(shiny)
library(ggplot2)
## load("04.21_3.RData")
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
############
ui <- fluidPage(
sidebarPanel(
selectizeInput(
"selectGeneSymbol",
"Select:",
choices = NULL,
multiple =F,
width = 400,
selected = NULL,
options = list(placeholder = 'e.g. gene here',create = F)
),
actionButton("plot1", "click1"),
actionButton("plot2", "click2"),
actionButton("dataTable", "click3")
),
mainPanel(
uiOutput("all"),
plotOutput("myPlot"),
tableOutput("myTable")
)
)
server <- function(input, output, session) {
updateSelectizeInput(session, "selectGeneSymbol", choices = colnames(mean_data[,-1]), server = TRUE)
global <- reactiveValues(out = NULL,
p1 = NULL,
p2 = NULL)
plotdata <- eventReactive(input$plot1,{
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
output$all <- renderUI({ ##
global$out
})
observeEvent(input$plot1, {
global$out <- plotOutput("plot1")
#myData(NULL)
})
##
observeEvent(input$plot2, {
global$out <- plotOutput("plot2")
#myData(NULL)
})
# observeEvent(input$dataTable, {
# global$out <- plotOutput("myPlot")
#
# })
####
myPlot = reactiveVal()
myData = reactiveVal()
observeEvent(input$dataTable, {
# data_cor<-mean_data[,-1]
# tm <- corr.test(data_cor[,input$selectGeneSymbol,drop=FALSE],
# y = data_cor, use = "pairwise", "spearman", adjust="none",
# alpha=0.05, ci=F, minlength=5)
# res <-setNames(as.data.frame(t(do.call(rbind, tm[c("r", "p")]))), c("Correlation", "P_value"))
# res<-res[-which(rownames(res)== input$selectGeneSymbol),]
# res<-data.frame(Gene=rownames(res),res)
# res
# ##############
# data_correlation=t(mean_data[, -1])
# data_subset=data_correlation[c(input$selectGeneSymbol, as.vector(head(res$Gene, 10))), ]
# myPlot(
# pheatmap(log2(data_subset+1), show_colnames = F,fontsize_row =12,
# cluster_rows = F, cluster_cols = F, gaps_row = 1)
# )
# myData(res)
myData(mtcars)
})
p3 <- eventReactive(input$dataTable, {
hist(runif(500))
})
output$myPlot = renderPlot({
p3()
#myPlot()
})
output$myTable = renderTable({
myData()
})
####
p1 <- eventReactive(input$plot1,
{
ggplot(data =plotdata(), aes(x = Name, y = .data[[as.name(input$selectGeneSymbol)]])) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
theme(legend.position = "none") +
labs(title = paste(input$selectGeneSymbol), x = NULL, y = "666666") })
p2 <- eventReactive(input$plot2,
{
ggplot(data = plotdata(), aes(x = Name, y = .data[[as.name(input$selectGeneSymbol)]], fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
theme(legend.position = "none") +
labs(title = paste(input$selectGeneSymbol), x = NULL, y = "777777") })
output$plot1 <- renderPlot({
p1()})
output$plot2 <- renderPlot({
p2()})
}
shinyApp(ui, server)
In my first panel, I have plot where I enter data by clicking or double clinking depending on the situation. If it's one click it categorized as a shot and if it's a double click it is categorized as a goal.
Simultaneously, on another Tab, I am creating a heat map of all of those shots. However, in my heat map (produced in my code in output$chart) I would like to have two different colours on the same heat map. One colour representing the shots and the other one representing the goal.
Thank you for your help
library(shiny)
library(ggplot2)
ui <- fluidPage(
titlePanel("Hockey"),
tags$img(height = 100, width = 100,
src = "Logo.png"),
sidebarPanel(
textInput(inputId = "date",
label = "Date",
value = "yyyy/mm/dd"),
textInput(inputId = "team",
label = "Team Name",
value = "Team Name"),
selectInput("shot", "shot type:",
list(`Shot Type` = list("wrist shot", "slap shot", "snap shot", "backhand", "tap in", "deflection", "one timer", "wrap around"))),
actionButton("reset", "Clear")),
mainPanel(tabsetPanel(
tabPanel("Track", plotOutput(outputId = "hockeyplot", click = "plot_click", dblclick = "plot_dblclick")),
tabPanel("Chart", plotOutput(outputId = "chart")),
server <- function(input, output){
rv <- reactiveValues(
df = data.frame(
x = numeric(),
y = numeric(),
Date = as.Date(character()),
Team = character(),
ShotType = character(),
Type = factor()
)
)
output$hockeyplot = renderPlot({
ggplot(rv$df,
aes(x = x, y = y)) + coord_flip() + lims(x = c(0, 100), y = c(42.5, -42.5)) + geom_blank + geom_point( aes(colour = factor(Type)), size = 5 ) + theme(legend.position = "none")})
observeEvent(input$plot_click, {
rv$df <- rbind(rv$df, data.frame(
x = input$plot_click$y,
y = input$plot_click$x,
Date = input$date,
Team = input$team,
ShotType = input$shot,
Type = "Shot"))
})
observeEvent(input$plot_dblclick, {
rv$df <- rbind(rv$df, data.frame(
x = input$plot_dblclick$y,
y = input$plot_dblclick$x,
Date = input$date,
Team = input$team,
ShotType = input$shot,
Type = "Goal"))
})
observeEvent(input$reset,{
rv$df <- rv$df[-nrow(rv$df),]
})
output$chart = renderPlot({
ggplot(rv$df, aes(x = x, y = y)) +
coord_flip()+
lims(x = c(0, 100), y = c(42.5, -42.5)) +
geom_blank+
theme(legend.position = "none") +
stat_density_2d(aes(fill = "shot"), geom = 'polygon', alpha = 0.4)
})
Here is a working example.
I created a vector my_colors to assign colors to "Shot" and "Goal" so they are consistent across figures, and will not change if Type factor has different number of levels.
I also included factor when adding rows to your rv$df. That way, you also won't have a change in color as the number of levels change for Type. When I tried running the app initially, the colors would change after a second Type was added ("Shot" or "Goal").
In stat_2_density, you can change fill to Type. Again, you can specify scale_fill_manual to assign the same colors.
Please let me know if this is what you had in mind.
library(shiny)
library(ggplot2)
my_colours = c("Shot" = "blue", "Goal" = "green")
ui <- fluidPage(
titlePanel("Hockey"),
tags$img(height = 100, width = 100, src = "Logo.png"),
sidebarPanel(
textInput(inputId = "date",
label = "Date",
value = "yyyy/mm/dd"),
textInput(inputId = "team",
label = "Team Name",
value = "Team Name"),
selectInput("shot", "shot type:",
list(`Shot Type` = list("wrist shot", "slap shot", "snap shot", "backhand", "tap in", "deflection", "one timer", "wrap around"))),
actionButton("reset", "Clear")),
mainPanel(tabsetPanel(
tabPanel("Track", plotOutput(outputId = "hockeyplot", click = "plot_click", dblclick = "plot_dblclick")),
tabPanel("Chart", plotOutput(outputId = "chart"))
))
)
server <- function(input, output){
rv <- reactiveValues(
df = data.frame(
x = numeric(),
y = numeric(),
Date = as.Date(character()),
Team = character(),
ShotType = character(),
Type = factor(levels = c("Shot", "Goal"))
)
)
output$hockeyplot = renderPlot({
ggplot(rv$df, aes(x = x, y = y)) +
coord_flip() +
lims(x = c(0, 100), y = c(42.5, -42.5)) +
geom_blank() +
geom_point(aes(color = Type), size = 5 ) +
theme(legend.position = "none") +
scale_color_manual(values = my_colours)
})
observeEvent(input$plot_click, {
rv$df <- rbind(rv$df, data.frame(
x = input$plot_click$y,
y = input$plot_click$x,
Date = input$date,
Team = input$team,
ShotType = input$shot,
Type = factor("Shot", levels = c("Shot", "Goal"))))
})
observeEvent(input$plot_dblclick, {
rv$df <- rbind(rv$df, data.frame(
x = input$plot_dblclick$y,
y = input$plot_dblclick$x,
Date = input$date,
Team = input$team,
ShotType = input$shot,
Type = factor("Goal", levels = c("Shot", "Goal"))))
})
observeEvent(input$reset,{
rv$df <- rv$df[-nrow(rv$df),]
})
output$chart = renderPlot({
ggplot(rv$df, aes(x = x, y = y)) +
coord_flip()+
lims(x = c(0, 100), y = c(42.5, -42.5)) +
geom_blank()+
theme(legend.position = "none") +
stat_density_2d(aes(fill = Type), geom = 'polygon', alpha = .4) +
scale_fill_manual(values = my_colours)
})
}
shinyApp(ui, server)
I am trying to insert an action button that would delete the last input/row of data (enterer by clicking), but I want to be able to keep entering data by clicking afterward. I summary I have a dataframe which is accumulating data every time I click on the plot, I want an action button that remove the last click and data that goes with it in the dataframe, but I want to be able to keep going afterward. I try a simple solution because I feel it should be simple, but I cannot get it. Thank you very much for your help.
library(shiny)
library(ggplot2)
ui <- fluidPage(
titlePanel("team"),
sidebarPanel(
textInput(inputId = "date",
label = "Date",
value = "yyyy/mm/dd"),
textInput(inputId = "team",
label = "Team Name",
value = "Team Name"),
textInput(inputId = "pnumber",
label = "Player Number",
value = "#"),
selectInput("shot", "shot type:",
list(`Shot Type` = list("wrist shot", "slap shot", "snap shot"))),
selectInput("situation", "scoring opportunity:",
list(`Green` = list("Double cross", "dot line pass"),
`Red` = list("clear", "wrap"))),
actionButton("reset", "Clear")),
mainPanel(tabsetPanel(
tabPanel("Track", plotOutput(outputId = "hockeyplot", click = "plot_click", dblclick = "plot_dblclick")),
tabPanel("Data", tableOutput(outputId = "table"), downloadLink("downloadData", "Download")),
tabPanel("Chart", plotOutput(outputId = "chart")))))
server <- function(input, output){
rv <- reactiveValues(
df = data.frame(
x = numeric(),
y = numeric(),
Date = as.Date(character()),
Team = character(),
Player = character(),
ShotType = character(),
Situation = character(),
Type = factor()
)
)
output$hockeyplot = renderPlot({
ggplot(rv$df,
aes(x = x, y = y)) + coord_flip() + lims(x = c(0, 100), y = c(42.5, -42.5))+ geom_point( aes(colour = factor(Type)), size = 5 ) + theme(legend.position = "none")})
observeEvent(input$plot_click, {
rv$df <- rbind(rv$df, data.frame(
x = input$plot_click$y,
y = input$plot_click$x,
Date = input$date,
Team = input$team,
Player = input$pnumber,
ShotType = input$shot,
Situation = input$situation,
Type = "Shot"))
})
observeEvent(input$plot_dblclick, {
rv$df <- rbind(rv$df, data.frame(
x = input$plot_dblclick$y,
y = input$plot_dblclick$x,
Date = input$date,
Team = input$team,
Player = input$pnumber,
ShotType = input$shot,
Situation = input$situation,
Type = "Goal"))
})
observeEvent(input$reset,{
rv$df( rv$df()[-nrow(rv$df()),])
})
output$table<-renderTable({
rv$df
})
output$downloadData <- downloadHandler(
filename = function() {
paste("MHdata-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(rv$df, file)
}
)
}
shinyApp(ui = ui, server = server)
You mixed up some brackets when using reactiveValues. Basically, you can call and assign them without (.
library(shiny)
library(ggplot2)
ui <- fluidPage(
titlePanel("team"),
sidebarPanel(
textInput(inputId = "date",
label = "Date",
value = "yyyy/mm/dd"),
textInput(inputId = "team",
label = "Team Name",
value = "Team Name"),
textInput(inputId = "pnumber",
label = "Player Number",
value = "#"),
selectInput("shot", "shot type:",
list(`Shot Type` = list("wrist shot", "slap shot", "snap shot"))),
selectInput("situation", "scoring opportunity:",
list(`Green` = list("Double cross", "dot line pass"),
`Red` = list("clear", "wrap"))),
actionButton("reset", "Clear")),
mainPanel(tabsetPanel(
tabPanel("Track", plotOutput(outputId = "hockeyplot", click = "plot_click", dblclick = "plot_dblclick")),
tabPanel("Data", tableOutput(outputId = "table"), downloadLink("downloadData", "Download")),
tabPanel("Chart", plotOutput(outputId = "chart")))))
server <- function(input, output){
rv <- reactiveValues(
df = data.frame(
x = numeric(),
y = numeric(),
Date = as.Date(character()),
Team = character(),
Player = character(),
ShotType = character(),
Situation = character(),
Type = factor()
)
)
output$hockeyplot = renderPlot({
ggplot(rv$df,
aes(x = x, y = y)) + coord_flip() + lims(x = c(0, 100), y = c(42.5, -42.5))+ geom_point( aes(colour = factor(Type)), size = 5 ) + theme(legend.position = "none")})
observeEvent(input$plot_click, {
rv$df <- rbind(rv$df, data.frame(
x = input$plot_click$y,
y = input$plot_click$x,
Date = input$date,
Team = input$team,
Player = input$pnumber,
ShotType = input$shot,
Situation = input$situation,
Type = "Shot"))
})
observeEvent(input$plot_dblclick, {
rv$df <- rbind(rv$df, data.frame(
x = input$plot_dblclick$y,
y = input$plot_dblclick$x,
Date = input$date,
Team = input$team,
Player = input$pnumber,
ShotType = input$shot,
Situation = input$situation,
Type = "Goal"))
})
# NO BRACKETS NEEDED
observeEvent(input$reset,{
rv$df <- rv$df[-nrow(rv$df),]
})
output$table<-renderTable({
rv$df
})
output$downloadData <- downloadHandler(
filename = function() {
paste("MHdata-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(rv$df, file)
}
)
}
shinyApp(ui = ui, server = server)
I have a shiny app to plot a heatmap of the income and other aspects.
library(shiny)
library(ggplot2)
library(gplots)
ui <- fluidPage(
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", "Plot Heatmap Of", choices =c("Income" = "inc1",
"Expenditure" = "exp1",
"Gross Profit" = "gprofit1",
"Net Profit" = "nprofit1")),
actionButton("hplotit","Plot Heatmap"),
plotlyOutput("HeatPlot"),
plotlyOutput("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))
))})
observeEvent(input$combine, {
Data <<- cbind(read.csv(file.choose()),read.csv(file.choose()),read.csv(file.choose()),read.csv(file.choose()))
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]))
inc1 <- as.matrix(inc1)
exp1 <- as.data.frame(cbind(Dummy1 = Data[,3],Dummy2 = Data[,8],Dummy3 = Data[,13], Dummy4 = Data[,18]))
exp1 <- 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]))
gprofit1 <- 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)))
nprofit1 <- as.matrix(nprofit1)
date <- as.character(Data[,4])
h = input$ploth
switch(EXPR = h ,
inc1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(inc1), y = date, z = inc1, type = "heatmap", colorscale = "Earth")),
exp1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(exp1), y = date, z = exp1, type = "heatmap", colors = colorRamp(c("red", "yellow")))),
gprofit1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(gprofit1), y = date, z = gprofit1, type = "heatmap", colorscale="Greys")),
nprofit1 = output$HeatPlot <- renderPlotly( plot_ly(x = colnames(nprofit1), y = date, z = nprofit1, type = "heatmap"))
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
With the ui being like
Now when i open the app and try to plot the income the following error is shown
Error in getExportedValue: cannot open file '~/R/x86_64-pc-linux-gnu-library/3.4/viridisLite/data/Rdata.rdb': No such file or directory
But when i try to plot the next item(expenditure) in the selectinput the heatmap appears witout any problem and it is pitch perfect of what is exactly needed.
Moreover when i check the file in the location it appears that the file is present
/home/mrshekar/R/x86_64-pc-linux-gnu-library/3.4/viridisLite/data
What is it that i am missing? Any particular package to extract that folder? Or is that file is supposed to be present somewhere else? Please help.
Delete the viridisLite folder from there and then install the package once more. This seems to work just fine. I had a similar problem. If the problem still persists then also delete the normal viridis package and install that also. This will solve your problem. Also update your packages. That also sometimes gives problems.
Could anyone suggest me the way to extract shiny checkboxgroupoinput options of different ggplots such as geom_bar(), geom_line() as a list. I tried the following simplified code, it prints only the last plot: Thanks for your help.
library(shiny)
library(ggplot2)
library(easyGgplot2)
patient <- cbind.data.frame(seq(1:14),matrix(sample(1:100, 84), ncol=6))
colnames(patient) <- c('DAYS', 'PHYSICAL_ACTIVITY', 'SMOKING','ALCOHOL_INTAKE', 'HYDRATION', 'SLEEP', 'Total_score')
ui <- fluidPage(
titlePanel("Data Plot"),
sidebarLayout(
sidebarPanel(
fluidRow(column(6,
checkboxGroupInput("checkGroup",
("Parameters"),
list("PHYSICAL ACTIVITY" = 1,
"SLEEP" = 2,
"ALCOHOL INTAKE" = 3,
"SELECT ALL" = 4
)))
),
fluidRow(column(10, actionButton("goButton", label = "Analysis Report"))
)
), #Sidebarpanel
mainPanel(
plotOutput("plot1", height='800px')
)#Mainpanel
) #Sidebar layout
)#fluidpage
server <- function(input, output) {
output$plot1 <- renderPlot({
input$goButton
p1 <- reactive({
if(!(1 %in% input$checkGroup)) return(NULL)
ggplot(data=patient, aes(x=DAYS, y=PHYSICAL_ACTIVITY))+geom_bar(stat="identity", aes(fill=PHYSICAL_ACTIVITY<=median(PHYSICAL_ACTIVITY)), show.legend=F)+scale_fill_manual(values = c('steelblue', 'red') )+labs(title = 'PHYSICAL ACTIVITY (STEPS)', x = NULL, y = NULL)+theme_minimal()
})
# Second plot
p2 <- reactive ({
if(!(2 %in% input$checkGroup )) return(NULL)
p2 <- ggplot(data=patient, aes(x=DAYS,y=SLEEP))+geom_line(colour='black', size=1)+geom_point(size=3, aes(colour=cut(SLEEP,c(-Inf,summary(SLEEP)[[2]],summary(SLEEP)[[5]],Inf))), show.legend=F)+scale_color_manual(values = c("red", "orange","green"))+labs(title = 'SLEEP (hrs)', x = NULL, y = NULL) +theme_minimal()
})
ptlist <- list(p1(),p2())
ggplot2.multiplot(ptlist, cols=1)
})
}
shinyApp(ui, server)
Example with reading csv.
library(shiny)
library(ggplot2)
library(easyGgplot2)
patient <- cbind.data.frame(
seq(1:14),
matrix(
sample(1:100, 84),
ncol = 6
)
)
colnames(patient) <- c(
'DAYS',
'PHYSICAL_ACTIVITY',
'SMOKING',
'ALCOHOL_INTAKE',
'HYDRATION',
'SLEEP',
'Total_score'
)
write.csv(patient, file="patient.csv")
ui <- fluidPage(
titlePanel("Data Plot"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(6,
checkboxGroupInput(
"checkGroup",
"Parameters",
list(
"PHYSICAL ACTIVITY",
"SLEEP"),
selected = "PHYSICAL ACTIVITY")
)
),
fluidRow(
fileInput("file1", "Choose Data sheet",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv"))
)
),
mainPanel(
plotOutput("plots")
)
)
)
server <- function(input, output) {
patient <- reactive({
req(input$file1)
read.csv(input$file1$datapath,
header = T
)
})
plot_one <- function(patient.data) {
ggplot(patient.data, aes(x = DAYS, y = PHYSICAL_ACTIVITY)) +
geom_bar(
stat = "identity",
aes(fill = PHYSICAL_ACTIVITY <= median(PHYSICAL_ACTIVITY)),
show.legend = F) +
scale_fill_manual(
values = c('steelblue', 'red')) +
labs(title = 'PHYSICAL ACTIVITY (STEPS)',
x = NULL,
y = NULL) +
theme_minimal()
}
plot_two <- function(patient.data){
ggplot(patient.data, aes(x = DAYS, y = SLEEP)) +
geom_line(colour = 'black', size = 1) +
geom_point(size = 3,
aes(colour = cut(SLEEP,
c(-Inf,
summary(SLEEP)[[2]],
summary(SLEEP)[[5]],
Inf)
)
),
show.legend = F) +
scale_color_manual(values = c("red", "orange", "green")) +
labs(title = 'SLEEP (hrs)',
x = NULL,
y = NULL) +
theme_minimal()
}
output$plots <- renderPlot({
list.of.plots <- list(
`PHYSICAL ACTIVITY` = plot_one(patient()),
`SLEEP` = plot_two(patient())
)
do.call(ggplot2.multiplot, c(list.of.plots[input$checkGroup], cols=1))
})
}
shinyApp(ui, server)
It will work if replace ggplot2.multiplot(ptlist, cols=1) by do.call(ggplot2.multiplot, c(ptlist, cols=1))
But may be to do this with ggplot function in reactive is not a good way to achieve your goal.
You could to try something like this
library(shiny)
library(ggplot2)
library(easyGgplot2)
patient <- cbind.data.frame(
seq(1:14),
matrix(
sample(1:100, 84),
ncol = 6
)
)
colnames(patient) <- c(
'DAYS',
'PHYSICAL_ACTIVITY',
'SMOKING',
'ALCOHOL_INTAKE',
'HYDRATION',
'SLEEP',
'Total_score'
)
ui <- fluidPage(
titlePanel("Data Plot"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(6,
checkboxGroupInput(
"checkGroup",
"Parameters",
list(
"PHYSICAL ACTIVITY",
"SLEEP"),
selected = "PHYSICAL ACTIVITY")
)
)
),
mainPanel(
plotOutput("plots")
)
)
)
server <- function(input, output) {
plot_one <- ggplot(data = patient, aes(x = DAYS, y = PHYSICAL_ACTIVITY)) +
geom_bar(
stat = "identity",
aes(fill = PHYSICAL_ACTIVITY <= median(PHYSICAL_ACTIVITY)),
show.legend = F) +
scale_fill_manual(
values = c('steelblue', 'red')) +
labs(title = 'PHYSICAL ACTIVITY (STEPS)',
x = NULL,
y = NULL) +
theme_minimal()
plot_two <- ggplot(data = patient, aes(x = DAYS, y = SLEEP)) +
geom_line(colour = 'black', size = 1) +
geom_point(size = 3,
aes(colour = cut(SLEEP,
c(-Inf,
summary(SLEEP)[[2]],
summary(SLEEP)[[5]],
Inf)
)
),
show.legend = F) +
scale_color_manual(values = c("red", "orange", "green")) +
labs(title = 'SLEEP (hrs)',
x = NULL,
y = NULL) +
theme_minimal()
list.of.plots <- list(
`PHYSICAL ACTIVITY` = plot_one,
`SLEEP` = plot_two
)
output$plots <- renderPlot(
do.call(ggplot2.multiplot, c(list.of.plots[input$checkGroup], cols=1))
)
}
shinyApp(ui, server)
library(shiny)
library(ggplot2)
library(easyGgplot2)
patient <- cbind.data.frame(
seq(1:14),
matrix(
sample(1:100, 84),
ncol = 6
)
)
colnames(patient) <- c(
'DAYS',
'PHYSICAL_ACTIVITY',
'SMOKING',
'ALCOHOL_INTAKE',
'HYDRATION',
'SLEEP',
'Total_score'
)
write.csv(patient, file="patient.csv")
ui <- fluidPage(
titlePanel("Data Plot"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(6,
checkboxGroupInput(
"checkGroup",
"Parameters",
list(
"PHYSICAL ACTIVITY",
"SLEEP"),
selected = "PHYSICAL ACTIVITY")
)
),
fluidRow(
fileInput("file1", "Choose Data sheet",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv"))
)
),
mainPanel(
plotOutput("plots")
)
)
)
server <- function(input, output) {
patient <- reactive({
req(input$file1)
read.csv(input$file1$datapath,
header = T
)
})
plot_one <- ggplot(data = patient(), aes(x = DAYS, y = PHYSICAL_ACTIVITY)) +
geom_bar(
stat = "identity",
aes(fill = PHYSICAL_ACTIVITY <= median(PHYSICAL_ACTIVITY)),
show.legend = F) +
scale_fill_manual(
values = c('steelblue', 'red')) +
labs(title = 'PHYSICAL ACTIVITY (STEPS)',
x = NULL,
y = NULL) +
theme_minimal()
plot_two <- ggplot(data = patient(), aes(x = DAYS, y = SLEEP)) +
geom_line(colour = 'black', size = 1) +
geom_point(size = 3,
aes(colour = cut(SLEEP,
c(-Inf,
summary(SLEEP)[[2]],
summary(SLEEP)[[5]],
Inf)
)
),
show.legend = F) +
scale_color_manual(values = c("red", "orange", "green")) +
labs(title = 'SLEEP (hrs)',
x = NULL,
y = NULL) +
theme_minimal()
list.of.plots <- list(
`PHYSICAL ACTIVITY` = plot_one,
`SLEEP` = plot_two
)
output$plots <- renderPlot(
do.call(ggplot2.multiplot, c(list.of.plots[input$checkGroup], cols=1))
)
}
shinyApp(ui, server)