Could you please point out where is the bug in this code:
library(shiny)
library(shinyWidgets)
library(shinyjs)
library(plotly)
library(ggplot2)
library(ggiraph)
library(thematic)
library(ragg)
library(showtext)
library(extrafont)
library(dplyr)
library(lubridate)
library(grDevices)
#Simulate Data for Reproducible Code
# Set the number of observations
{n <- 512
# Define channel names
channels <- c("Channel_A", "Channel_B", "Channel_C", "Channel_D")
# Define months and days of the week
months <- c("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
days <- c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")
# Create a data frame to store the data
df <- data.frame()
# Generate data for each channel
for (channel in channels) {
# Generate data for each year
for (year in 2017:2024) {
# Generate data for each month
for (month in months) {
# Sample durations for each day of the month
for (day in 1:30) { # Assuming 30 days per month
# Sample duration for the specific channel, year, month, and day
viewCount <- round(runif(n = 1, min = 0, max = 20*1e6))
commentCount <- round(runif(n = 1, min = 0, max = 16*1e3))
likeCount <- round(runif(n = 1, min = 0, max = .6*1e6))
durations <- round(runif(n = 1, min = 4.59, max = 30.7), 1)
# Sample a random day of the week
day_of_week <- sample(days, 1)
# Append the data to the data frame
df <- rbind(df, data.frame(channel = channel, Year = year, month = month, day = day, publishedDayName = day_of_week, viewCount = viewCount, commentCount = commentCount, likeCount = likeCount, durationMins = durations))
}
}
}
}
}
thematic_shiny(font = "Pacifico")
# Plotly plotting ####
ui <- fluidPage(
# Select theme
theme = shinythemes::shinytheme('journal'),
#Style for fonts
tags$style(HTML("
body {
font-family: 'Pacifico', 15px; /*Set up fonts for the page*/
}
")),
# Fix widgets
tags$head(
tags$script(HTML('
$(document).ready(function() {
// Get the position of the sidebar
var sidebarPosition = $(".sidebar").offset().top;
// Function to fix or unfix the sidebar based on scrolling
function fixSidebar() {
var scrollTop = $(window).scrollTop();
if (scrollTop > sidebarPosition) {
$(".sidebar").addClass("fixed-sidebar");
} else {
$(".sidebar").removeClass("fixed-sidebar");
}
}
// Attach the function to the scroll event
$(window).scroll(fixSidebar);
// Call the function once to set the initial state
fixSidebar();
})
'))
),
# Application title
titlePanel("Youtube Data science Channels Analytics"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderTextInput(
inputId = "year_slider",
label = "Select Year",
choices = as.character(2017:2024),
selected = "2023",
width = "300px"
),
# Select variable for x-axis
selectInput(
inputId = "x",
label = "X-axis:",
choices = c('viewCount', 'commentCount', 'likeCount'),
selected = 'commentCount'
),
# Select variable for y-axis
selectInput(
inputId = "y",
label = "Y-axis:",
choices = c('viewCount', 'commentCount', 'likeCount'),
selected = 'viewCount'
),
h3('Chosen points'),
verbatimTextOutput('brushed_data'),
h3('Model coeffcients'),
verbatimTextOutput('model'),
actionButton("clear_pipeline", "Clear Pipeline")
),
# Show a plot of the generated distribution
mainPanel(
#Scatter block
fluidRow(
column(12,
plotOutput('scatter_Plot',
brushOpts(id = 'brush')))
)
)
)
)
server <- function(input, output) {
df$channel <- as.factor(df$channel)
# View_comments_likes
views_comments_likes_pipeline <- reactive({
df %>%
filter(Year == input$year_slider) %>%
group_by(channel, month, viewCount) %>%
summarise(viewCount = mean(viewCount),
commentCount = mean(commentCount),
likeCount = mean(likeCount))
})
# View grabbed data sample
output$brush_data <- renderPrint({
brushed_data <- brushedPoints(views_comments_likes_pipeline(), input$brush,
xvar = input$x, yvar = input$y)
print(brushed_data)
})
# Create Brushed data
model <- reactive({
#Brushed data
brushed_data <- brushedPoints(views_comments_likes_pipeline(), input$brush,
xvar = input$x, yvar = input$y)
if(nrow(brushed_data) < 2) {
return(NULL)
}
model.formula <- as.formula(paste0(input$y, '~ 1 +', input$x))
lm_model <-
lm(data = brushed_data, model.formula) #%>%
summary()
lm_model$coefficients
lm_model
})
# Scatter Plot
output$scatter_Plot <- renderPlot({
par(bg = 'gray', family = 'sans', cex = 1.5)
# model_data <- model()
# if (is.null(model_data)) {
# return(NULL)
# }
# Create a custom palette to add alpha transparency to colors
# Color palette
spectral <- c("#FF000060", "#FFA50060", "#FFFF0060", "#00FF0060")
# Assign colors with transparency to each channel
Color <- with(views_comments_likes_pipeline(), {
unique_channels <- unique(channel)
color_mapping <- setNames(spectral[1:length(unique_channels)], unique_channels)
color_mapping[channel]
})
p <- plot(x = views_comments_likes_pipeline()[[input$x]],
y = views_comments_likes_pipeline()[[input$y]],
col = Color, pch = 19, bg = 'gray',
main = 'Relationships between views, comments and likes',
xlab = input$x,
ylab = input$y)
p + grid(col = 'white', lty = 'solid') #+
# abline(intercept = model()[['coefficients']][1], slope = model()[['coefficients']][2], color = 'blue', size = .3, alpha = .6, lty = 'dashed')
})
# Model coefficients
output$model <- renderPrint({
model()
})
}
shinyApp(ui, server)
I want to get brushed data sample from brushedPoints function to calculate linear regression and plot prediction in abline. Although I got an error warning: "Error in is.null(x) || is.na(x) : 'length = 9' in coercion to 'logical(1)'". Can you correct my logic somewhere and point out the bug.