Related
I'm new in programming language especially R.
I have data frame and want to show top 3 of my data and sort from the biggest value using bar chart. I have tried some codes but failed to create proper chart. Here is my latest code :
library(shiny)
library(plotly)
my_data <- data.frame(x1 = c("a","b", "c","d","e","f","g","h"),
x2 = c(200, 200, 100,200,200,100,200,100),
x3 = c(100,400,500,50,100,300,100,50))
df1 <- my_data[order(my_data$x3),] #order by x3 value, to create rank
ui <- tabPanel("Test",
sidebarLayout(
sidebarPanel(
selectInput(inputId = "why",
label = "1. Select",
choices = df1$x2),
),
mainPanel(plotlyOutput("test"))
))
server <- function(input, output, session) {
output$test <- renderPlotly({
df2 <- df1 %>%
filter(x2 ==input$why) #filter by x2
p <-ggplot(df2,
aes(x = x1, y=x3)) +
geom_bar(stat = "identity")
fig <- ggplotly(p)
fig
})}
shinyApp(ui = ui, server = server)
the bar chart I created was not ordered correctly (based on x3 values), and I also only want to show top 3 of my data
To filter for the top 3 rows you could use dplyr::slice_max and to reorder your bars use e.g. reorder. Simply reordering the dataset will not work.
library(shiny)
library(dplyr)
library(plotly)
ui <- tabPanel(
"Test",
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "why",
label = "1. Select",
choices = unique(df1$x2),
selected = 200
),
),
mainPanel(plotlyOutput("test"))
)
)
server <- function(input, output, session) {
output$test <- renderPlotly({
df2 <- df1 %>%
filter(x2 == input$why) %>%
slice_max(x3, n = 3, with_ties = FALSE)
p <- ggplot(
df2,
aes(x = reorder(x1, -x3), y = x3)
) +
geom_bar(stat = "identity")
fig <- ggplotly(p)
fig
})
}
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:8022
I know the question is already answered, but I encourage you to keep your server function as small as possible and try to wrap long series of code into functions.
Here is an example of what I mean
library(tidyverse)
library(shiny)
library(plotly)
my_data <- data.frame(x1 = c("a","b", "c","d","e","f","g","h"),
x2 = c(200, 200, 100,200,200,100,200,100),
x3 = c(100,400,500,50,100,300,100,50))
df1 <- my_data[order(my_data$x3),] #order by x3 value, to create rank
myPlot <- function(data, input) {
df <- data |>
filter(x2 == input) #filter by x2
p <-ggplot(df, aes(x = reorder(x1, -x3), y=x3)) +
geom_bar(stat = "identity")
return(ggplotly(p))
}
ui <- tabPanel("Test",
sidebarLayout(
sidebarPanel(
selectInput(inputId = "why",
label = "1. Select",
choices = df1$x2),
),
mainPanel(plotlyOutput("test"))
))
server <- function(input, output, session) {
output$test <- renderPlotly({
myPlot(df1, input$why)
})
}
shinyApp(ui = ui, server = server)
Using R Shiny and plotly I created a interactive scatter plot.
How can I modify my code to interactively label only the points which were selected by the user?
Example plot
Thank you so much for your help!
All the best,
Christian
library(plotly)
library(shiny)
library(dplyr)
data <- data.frame(matrix(runif(500,0,1000), ncol = 2, nrow = 100)) %>%
mutate(ID = row_number())
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("hover"),
verbatimTextOutput("click"),
verbatimTextOutput("brush"),
verbatimTextOutput("zoom"))
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- ggplot(data, aes(x = X1, y = X2, key = ID)) +
geom_point()
ggplotly(p) %>% layout(dragmode = "select")
})
}
shinyApp(ui, server)
Below is a possible solution. I use a reactive function to "label" selected points. I wasn't sure how exactly you want to display the IDs for selected points. The code adds the ID as text when a point is selected. Also, I add some jitter to move the IDs away from the points.
library(plotly)
library(shiny)
library(dplyr)
data <- data.frame(matrix(runif(500,0,1000), ncol = 2, nrow = 100)) %>%
mutate(ID = row_number())
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("hover"),
verbatimTextOutput("click"),
verbatimTextOutput("brush"),
verbatimTextOutput("zoom"))
server <- function(input, output, session) {
output$plot <- renderPlotly({
data <- get_data()
p <- ggplot(data, aes(x = X1, y = X2, key = ID)) +
geom_point() + geom_text(data=subset(data, show_id),aes(X1,X2,label=ID), position = position_jitter(width = 20,height = 20))
ggplotly(p, source = "subset") %>% layout(dragmode = "select")
})
get_data <- reactive({
event.data <- event_data("plotly_selected", source = "subset")
data <- data %>% mutate(show_id = FALSE)
if (!is.null(event.data)) {
data$show_id[event.data$pointNumber + 1] <- TRUE
}
data
})
}
shinyApp(ui, server)
I used shiny and created a app.R file to hope to build a bar chart with ggplot. I also used checkboxGroupInput to create a 2 check boxes to control the condition. While the total number of bars should be 28 after all boxes are checked, but the maximum seemed to allow only 17 bars for some reason. So some bars (row of data) are missing. The missing bars don't seems to have a pattern. Can someone please help ?
dataset:https://drive.google.com/open?id=1fUQk_vMJWPwWnIMbXvyd5ro_HBk-DBfc
my code:
midterm <- read.csv('midterm-results.csv')
library(dplyr)
library(tidyr)
# get column number for response time
k <- c(33:88)
v <- c()
for (i in k){
if (i%%2 == 1){
v <- c(v,i)
}
}
#average response time by question
time <- midterm[ , v]
new.col.name <- gsub('_.*', "", colnames(time))
colnames(time) <- new.col.name
avg.time <- data.frame(apply(time, 2, mean))
avg.time$question <- rownames(avg.time)
colnames(avg.time) <- c('response_time', 'question')
rownames(avg.time) <- NULL
avg.time$question <- factor(avg.time$question,
levels = c('Q1','Q2','Q3','Q4','Q5','Q6','Q7','Q8.9',
'Q10','Q11','Q12.13','Q14','Q15','Q16','Q17',
'Q18','Q19','Q20','Q21','Q22','Q23','Q24','Q25',
'Q26','Q27','Q28','Q29','Q30'))
avg.time$question_type <- c(1,0,1,0,1,0,1,1,1,1,1,0,1,1,1,1,0,1,1,1,0,0,0,0,1,1,0,0)
# I did this manually because the there when data was imported into the midterm.csv,
# q8 & 9, q12 &13 were accidentally merged (28 v.s 30 question)
avg.time$question_type <- ifelse(avg.time$question_type == 1,
'googleable', 'not googleable')
avg.time$question_type <- factor(avg.time$question_type,
levels = c('googleable', 'not googleable'))
library(shiny)
library(ggplot2)
ui <- fluidPage(
checkboxGroupInput(inputId = "type",
label = "select question type",
choices = levels(avg.time$question_type),
selected = TRUE),
plotOutput('bar')
)
server <- function(input, output) {
output$bar <- renderPlot({
ggplot(avg.time[avg.time$question_type==input$type, ],
aes(x=question, response_time)) +
geom_bar(aes(fill = question_type), stat='identity', width = 0.5)
}, height =500, width = 1000)
}
shinyApp(ui = ui, server = server)
library(shiny)
library(ggplot2)
ui <- fluidPage(
checkboxGroupInput(inputId = "type", label = "select question type",
choices = levels(avg.time$question_type), selected = TRUE),
plotOutput('bar')
)
server <- function(input, output) {
data <- reactive(avg.time[avg.time$question_type %in% input$type, ])
output$bar <- renderPlot({
ggplot(data(),
aes(x=question, response_time)) + geom_bar(stat='identity', width = 0.5,
aes(fill = question_type))
}, height =500, width = 1000)
}
shinyApp(ui = ui, server = server)
of course you can use avg.time[avg.time$question_type %in% input$type, ] inside ggplot2 but reactivity is better.
I tried to fetch streaming data from mosquito test server for creating a real time line chart. I checked some examples of real time chart, but I couldn't seem to achieve the same objective. The chart is updated real time but it always refreshes.
Here is the script I edited from one example:
library(shiny)
library(magrittr)
library(mqtt)
library(jsonlite)
ui <- shinyServer(fluidPage(
plotOutput("plot")
))
server <- shinyServer(function(input, output, session){
myData <- data.frame()
# Function to get new observations
get_new_data <- function(){
d <- character()
mqtt::topic_subscribe(host = "test.mosquitto.org", port = 1883L, client_id = "dcR", topic = "IoTDemoData",
message_callback =
function(id, topic, payload, qos, retain) {
if (topic == "IoTDemoData") {
d <<- readBin(payload, "character")
# print(received_payload)
# received_payload <- fromJSON(received_payload)
# print(d)
return("quit")
}
}
)
d <- fromJSON(d)
d <- as.data.frame(d)
return(d)
# data <- rnorm(5) %>% rbind %>% data.frame
# return(data)
}
# Initialize my_data
myData <- get_new_data()
# Function to update my_data
update_data <- function(){
myData <<- rbind(get_new_data(), myData)
}
# Plot the 30 most recent values
output$plot <- renderPlot({
invalidateLater(1000, session)
update_data()
print(myData)
plot(temperature ~ 1, data=myData[1:30,], ylim=c(-20, -10), las=1, type="l")
})
})
shinyApp(ui=ui,server=server)
I have been struggling with creating real time chart for days. If anyone can point out the problem why the line chart is always refreshed and the solution, it will be highly appreciated!
Below are the revised working script based on Florian's answer:
library(shiny)
library(mqtt)
library(jsonlite)
library(ggplot2)
ui <- shinyServer(fluidPage(
plotOutput("mqttData")
))
server <- shinyServer(function(input, output, session){
myData <- reactiveVal()
get_new_data <- function(){
d <- character()
mqtt::topic_subscribe(host = "localhost", port = 1883L, client_id = "dcR", topic = "IoTDemoData",
message_callback =
function(id, topic, payload, qos, retain) {
if (topic == "IoTDemoData") {
d <<- readBin(payload, "character")
return("quit")
}
}
)
d <- fromJSON(d)
d <- as.data.frame(d)
return(d)
}
observe({
invalidateLater(1000, session)
isolate({
# fetch the new data
new_data <- get_new_data()
# If myData is empty, we initialize it with just the new data.
if(is.null(myData()))
myData(new_data)
else # row bind the new data to the existing data, and set that as the new value.
myData(rbind(myData(),new_data))
})
})
output$mqttData <- renderPlot({
ggplot(mapping = aes(x = c(1:nrow(myData())), y = myData()$temperature)) +
geom_line() +
labs(x = "Second", y = "Celsius")
})
})
shinyApp(ui=ui,server=server)
However, after adding a second plot, the flickering began. When I commented out one of the plots, the plot works great without the need to refresh.
library(shiny)
library(mqtt)
library(jsonlite)
library(ggplot2)
ui <- shinyServer(fluidPage(
plotOutput("mqttData"),
plotOutput("mqttData_RH")
))
server <- shinyServer(function(input, output, session){
myData <- reactiveVal()
get_new_data <- function(){
d <- character()
mqtt::topic_subscribe(host = "test.mosquitto.org", port = 1883L, client_id = "dcR", topic = "IoTDemoData",
# mqtt::topic_subscribe(host = "localhost", port = 1883L, client_id = "dcR", topic = "IoTDemoData",
message_callback =
function(id, topic, payload, qos, retain) {
if (topic == "IoTDemoData") {
d <<- readBin(payload, "character")
return("quit")
}
}
)
d <- fromJSON(d)
d <- as.data.frame(d)
d$RH <- as.numeric(as.character( d$RH))
return(d)
}
observe({
invalidateLater(10000, session)
isolate({
# fetch the new data
new_data <- get_new_data()
# If myData is empty, we initialize it with just the new data.
if(is.null(myData()))
myData(new_data)
else # row bind the new data to the existing data, and set that as the new value.
myData(rbind(myData(),new_data))
})
})
output$mqttData <- renderPlot({
ggplot(mapping = aes(x = c(1:nrow(myData())), y = myData()$temperature)) +
geom_line() +
labs(x = "Second", y = "Celsius")
})
output$mqttData_RH <- renderPlot({
ggplot(mapping = aes(x = c(1:nrow(myData())), y = myData()$RH)) +
geom_line() +
labs(x = "Second", y = "RH %")
})
})
shinyApp(ui=ui,server=server)
One solution I found plot the charts in one renderPlot object. The flickering reduces.
output$mqttData <- renderPlot({
myData() %>%
gather('Var', 'Val', c(temperature, RH)) %>%
ggplot(aes(timestamp,Val, group = 1))+geom_line()+facet_grid(Var ~ ., scales="free_y")
})
However, I wonder if there is way to plot the charts separately without flickering / refreshing.
I found one github example put data to ggplot2 using pipe %>% (https://github.com/mokjpn/R_IoT) and modified it to plot separated charts.
library(shiny)
library(ggplot2)
library(tidyr)
# Dashboard-like layout
ui <- shinyServer(fluidPage(
fluidRow(
column(
6,
plotOutput("streaming_data_1")
),
column(
6,
plotOutput("streaming_data_2")
)
),
fluidRow(
column(
6,
plotOutput("streaming_data_3")
),
column(
6,
plotOutput("streaming_data_4")
)
)
))
server <- shinyServer(function(input, output, session){
myData <- reactiveVal()
# show the first and last timestamp in the streaming charts
realtime_graph_x_labels <- reactiveValues(first = "",last ="")
get_new_data <- function(){
epochTimeStamp <- as.character(as.integer(Sys.time()))
sensor_1 <- -runif(1,min = 10, max = 30)
sensor_2 <- runif(1,min = 0,max = 100)
sensor_3 <- runif(1,min = 0,max = 100000)
sensor_4 <- runif(1,min = 0,max = 10)
newData <- data.frame(ts = epochTimeStamp, val_1 = sensor_1, val_2 = sensor_2, val_3 = sensor_3, val_4 = sensor_4)
return(newData)
}
observe({
invalidateLater(1000, session)
isolate({
# fetch the new data
new_data <- get_new_data()
# If myData is empty, we initialize it with just the new data.
if(is.null(myData()))
{
myData(new_data)
realtime_graph_x_labels$first <- as.character(head(myData()$ts,1))
}
else # row bind the new data to the existing data, and set that as the new value.
myData(rbind(myData(),new_data))
realtime_graph_x_labels$last <- as.character(tail(myData()$ts,1))
})
})
# When displaying two charts, there is no flickering / refreshing, which is desired
output$streaming_data_1 <- renderPlot({
myData() %>%
ggplot(aes(ts,val_1, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 1") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
output$streaming_data_2<- renderPlot({
myData() %>%
ggplot(aes(ts,val_2, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 2") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
# When adding the 3rd chart, every charts start to flicker / refresh when ploting new value
output$streaming_data_3<- renderPlot({
myData() %>%
ggplot(aes(ts,val_3, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 3") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
output$streaming_data_4<- renderPlot({
myData() %>%
ggplot(aes(ts,val_4, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 4") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
})
shinyApp(ui=ui,server=server)
The solution works when there are only two charts and starts flickering / refreshing when adding the 3rd.
One possible cause may be that 1000ms is too short for the data to finish processing. Try invalidateLater(10000, session) for example, and see what happens.
I was unable to install mqtt with my R version, so I am unable to reproduce your behavior. However, I looked at your code and I think there is something you could do different to improve your code: Writing data to the global environment with <<- is usually not a good idea. What might be better suited is a reactiveVal, in which you can store data, and on which other functions take a dependency. So in the example below, I have created a reactiveVal and a corresponding observer that updates the reactiveVal every 1000ms.
Below is a working example, where I replaced the contents of your function with a simple one-liner for illustration purposes.
Hope this helps!
set.seed(1)
library(shiny)
ui <- fluidPage(
plotOutput("plotx")
)
server <- function(input, output, session){
# A reactiveVal that holds our data
myData <- reactiveVal()
# Our function to get new data
get_new_data <- function(){
data.frame(a=sample(seq(20),1),b=sample(seq(20),1))
}
# Observer that updates the data every 1000ms.
observe({
# invalidate every 1000ms
invalidateLater(1000, session)
isolate({
# fetch the new data
new_data <- get_new_data()
# If myData is empty, we initialize it with just the new data.
if(is.null(myData()))
myData(new_data)
else # row bind the new data to the existing data, and set that as the new value.
myData(rbind(myData(),new_data))
})
})
# Plot a histrogram
output$plotx <- renderPlot({
hist(myData()$a)
})
}
shinyApp(ui=ui,server=server)
EDIT based on new reproducible example. Seems like it just takes some time to create all the plots. You can add
tags$style(type="text/css", ".recalculating {opacity: 1.0;}")
to your app to prevent them from flickering. Working example:
library(shiny)
library(ggplot2)
library(tidyr)
# Dashboard-like layout
ui <- shinyServer(fluidPage(
tags$style(type="text/css", ".recalculating {opacity: 1.0;}"),
fluidRow(
column(
6,
plotOutput("streaming_data_1")
),
column(
6,
plotOutput("streaming_data_2")
)
),
fluidRow(
column(
6,
plotOutput("streaming_data_3")
),
column(
6,
plotOutput("streaming_data_4")
)
)
))
server <- shinyServer(function(input, output, session){
myData <- reactiveVal()
# show the first and last timestamp in the streaming charts
realtime_graph_x_labels <- reactiveValues(first = "",last ="")
get_new_data <- function(){
epochTimeStamp <- as.character(as.integer(Sys.time()))
sensor_1 <- -runif(1,min = 10, max = 30)
sensor_2 <- runif(1,min = 0,max = 100)
sensor_3 <- runif(1,min = 0,max = 100000)
sensor_4 <- runif(1,min = 0,max = 10)
newData <- data.frame(ts = epochTimeStamp, val_1 = sensor_1, val_2 = sensor_2, val_3 = sensor_3, val_4 = sensor_4)
return(newData)
}
observe({
invalidateLater(1000, session)
isolate({
# fetch the new data
new_data <- get_new_data()
# If myData is empty, we initialize it with just the new data.
if(is.null(myData()))
{
myData(new_data)
realtime_graph_x_labels$first <- as.character(head(myData()$ts,1))
}
else # row bind the new data to the existing data, and set that as the new value.
myData(rbind(myData(),new_data))
realtime_graph_x_labels$last <- as.character(tail(myData()$ts,1))
})
})
# When displaying two charts, there is no flickering / refreshing, which is desired
output$streaming_data_1 <- renderPlot({
myData() %>%
ggplot(aes(ts,val_1, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 1") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
output$streaming_data_2<- renderPlot({
myData() %>%
ggplot(aes(ts,val_2, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 2") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
# When adding the 3rd chart, every charts start to flicker / refresh when ploting new value
output$streaming_data_3<- renderPlot({
myData() %>%
ggplot(aes(ts,val_3, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 3") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
output$streaming_data_4<- renderPlot({
myData() %>%
ggplot(aes(ts,val_4, group = 1))+geom_line() +
scale_x_discrete(breaks = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last), labels = c(realtime_graph_x_labels$first, realtime_graph_x_labels$last)) +
labs(title ="Sensor 4") +
theme(plot.margin = unit(c(1,4,1,1),"lines"))
})
})
shinyApp(ui=ui,server=server)
I am new to R and Shiny package. I have a csv file with 4 col and 600 rows and I am trying to plot some graphs using ggplot2.
My ui and server codes are like:
dt<-read.csv('file.csv')
server <- function(input, output) {
output$aPlot <- renderPlot({
ggplot(data = dt, aes(x = Col1, y = Col2, group = 'Col3', color = 'Col4')) + geom_point()
})
}
ui <- fluidPage(sidebarLayout(
sidebarPanel(
sliderInput("Obs", "Log FC", min = 1, max = 600, value = 100)
),
mainPanel(plotOutput("aPlot")) ))
Here, I can get the ggplot output but I don't know how to use this slider input to control the number of rows to be read i.e., I want this "Obs" input to define the size of Col1 to be used in the graph.
Try something like this, example here is with mtcars dataset:
library(shiny)
library(ggplot2)
dt <- mtcars[,1:4]
ui <- fluidPage(
sidebarPanel(
sliderInput("Obs", "Log FC", min = 1, max = nrow(dt), value = nrow(dt)-10)
),
mainPanel(plotOutput("aPlot"))
)
server <- function(input, output) {
mydata <- reactive({
dt[1:as.numeric(input$Obs),]
})
output$aPlot <- renderPlot({
test <- mydata()
ggplot(data = test, aes(x = test[,1], y = test[,2], group = names(test)[3], color = names(test)[4])) + geom_point()
})
}
shinyApp(ui = ui, server = server)
Change your server to:
server <- function(input, output) {
observe({
dt_plot <- dt[1:input$Obs,]
output$aPlot <- renderPlot({
ggplot(data = dt_plot, aes(x = Col1, y = Col2, group = 'Col3', color = 'Col4')) + geom_point()
})
})
}