Recently, I built a small simple shiny website which just has a visualization function.
The aim is to visualize scatter data and adjust different parameters.
But I met a problem that the X and Y axises label size but also the legend title of the figure didn't update when I tried to use different parameters after the data uploaded.
The other parameters work well, such as point size, point shape and so on.
I referred to many methods but all of them doesn't work.
So here I need your help on my problem.
1. Why the X and Y axises label size of the figure doesn't update when I change them.
2. How to change the legend title.
By the way, here I use iris.xlsx as the sample data.
Thanks in advance !
Here is my Shiny script:
library(shiny)
library(shinydashboard)
library(pheatmap)
library(openxlsx)
library(viridis)
library(plotly)
library(DESeq2)
library(limma)
library(edgeR)
library(ggplot2)
library(ggrepel)
library(dplyr)
library(statmod)
library(VennDiagram)
library(rsconnect)
#install.packages("colourpicker")
library(shinyWidgets)
library(colourpicker)
#install.packages("shinyjs")
library(shinyjs)
# install.packages("RColorBrewer")
library(RColorBrewer)
require(shinysky)
#install.packages("devtools")
#devtools::install_github("AnalytixWare/ShinySky")
#BiocManager::install("shinysky")
#install.packages("plotly")
#
ui <- dashboardPage(
dashboardHeader(title = "Shiny grocery"),
dashboardSidebar(
sidebarMenu(id = "sidebarMenuID",
#menuItem("Home", tabName = "home", icon = icon("home")),
menuItem("Basic data visualization", tabName = "data_visualization", icon = icon("image"),
menuSubItem("Scatter plot", tabName = "scatter_plot", icon = icon("braille"))
)
)
),
dashboardBody(
useShinyjs(), #
tags$head(
tags$style(HTML("
.shiny-notification {
left: 20px !important;
bottom: 20px !important;
right: auto !important;
top: auto !important;
background-color: #E74C3C;
color: black; /* text color */
}
.custom-margin {
margin-right: 20px;
}
")),
tags$style(HTML("
.custom-column-padding {
padding-right: 5px !important;
padding-left: 5px !important;
}
"))
),
######################################## # scatter_plot
tabItem(tabName = "scatter_plot",
fluidRow(
column(width = 4,
#style = "background-color: black; padding: 20px;",
#style = "height: 200px;", #
fluidRow(
box(title = "Settings", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
width = 12,
fileInput("scatter_data", "Choose a data file", accept = c(".csv", ".txt", ".xlsx")),
actionButton("scatter_button", "Generate Scatter Plot"),
downloadButton("download_scatter", "Download Scatter Plot")
)
),
fluidRow(
box(title = "Scatter Plot Parameters", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
width = 12,
column(width = 4,
selectInput("x_col", "X-axis Column", choices = NULL),
selectInput("y_col", "Y-axis Column", choices = NULL),
selectInput("group_col", "Grouping Column", choices = NULL),
sliderInput("x_label_size", "X Label Size", min = 8, max = 24, value = 12),
sliderInput("y_label_size", "Y Label Size", min = 8, max = 24, value = 12)
),
column(width = 4,
sliderInput("plot_width", "Plot Width", min = 100, max = 900, value = 800),
sliderInput("plot_height", "Plot Height", min = 100, max = 750, value = 600),
#jscolorInput("point_color", "Point Color", value = "#56B4E9"),
colourpicker::colourInput("point_color", "Point Color", value = "#56B4E9"),
selectInput("point_shape", "Point Shape", choices = 0:25, selected = 20),
sliderInput("point_size", "Point Size", min = 1, max = 10, value = 2),
sliderInput("point_alpha", "Point Alpha", min = 0, max = 1, value = 1, step = 0.1)
)
)
)
),
#plotOutput("scatter_plot_output")
column(width = 8,
#plotOutput("scatter_plot_output",width = "100%", height = "500px") #
box(title = "Scatter Plot", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
width = 12,
plotOutput("scatter_plot_output",width = "100%",height = "750px") #
)
)
)
)
)
)
server <- function(input, output, session) {
########################################### Basic data visualization
scatterPlotObj <- reactiveVal()
data <- reactiveVal(NULL)
buttonClicked <- reactiveVal(FALSE)
observe({
req(input$scatter_data) #
df<-read.xlsx(input$scatter_data$datapath)
data(df)
#
col_names <- colnames(data())
#
updateSelectInput(session, "x_col", "X-axis Column", choices = col_names)
updateSelectInput(session, "y_col", "Y-axis Column", choices = col_names)
#
group_cols <- col_names[sapply(data(), function(col) is.factor(col) || is.character(col))]
# 如果存在分组信息，则添加到选择器，否则添加"None"
if(length(group_cols) > 0) {
updateSelectInput(session, "group_col", "Grouping Column", choices = c(group_cols,"None"))
} else {
updateSelectInput(session, "group_col", "Grouping Column", choices = "None", selected = "None")
}
})
#
###########
observeEvent(input$scatter_button, {
df <- data() #
req(df, input$x_col, input$y_col)
#data<-read.xlsx(input$scatter_data$datapath)
#req(input$scatter_data, input$x_col, input$y_col)
#
if(input$group_col != "None" && !is.null(df[[input$group_col]])) {
unique_groups <- length(unique(df[[input$group_col]]))
color_values <- brewer.pal(min(unique_groups, 12), "Set3")
scatterPlotObj(ggplot(df, aes(x = df[,input$x_col], y = df[,input$y_col],color = df[,input$group_col])) +
geom_point(shape = as.numeric(input$point_shape),
size = input$point_size,
alpha = input$point_alpha
#color = data[,input$group_col]
) +
#facet_wrap(~ data[,input$group_col])
scale_color_manual(values = color_values) +
#labs(x = input$x_col, y = input$y_col) +
labs(x = "Weight", y = "Miles/(US) gallon") +
theme(axis.title.x = element_text(size = input$label_size),
axis.title.y = element_text(size = input$label_size))+
theme_classic())
} else {
# "None"
scatterPlotObj(ggplot(df, aes(x = df[,input$x_col], y = df[,input$y_col],color = input$point_color)) +
geom_point(shape = as.numeric(input$point_shape),
size = input$point_size,
alpha = input$point_alpha) +
#labs(x = input$x_col, y = input$y_col,color="Type") +
labs(x = "Weight", y = "Miles/(US) gallon") +
theme(axis.title.x = element_text(size = input$label_size),
axis.title.y = element_text(size = input$label_size))+
theme_classic())
}
buttonClicked(TRUE) #
})
output$scatter_plot_output <- renderPlot({
#
scatterPlotObj()
}, width = function() {
#paste(input$plot_width, "px", sep = "")
input$plot_width
}, height = function() {
input$plot_height
#paste(input$plot_height, "px", sep = "")
})
#
observe({
#data<-read.xlsx(input$scatter_data$datapath)
req(data(),
input$x_col, input$y_col, input$group_col,input$x_label_size,input$y_label_size,
input$plot_width,input$plot_height, input$point_color,
input$point_shape,input$point_size,input$point_alpha,input$point_stroke)
#df <- data()
#
if(buttonClicked()) {
if(input$group_col != "None" && !is.null( data()[[input$group_col]])) {
unique_groups <- length(unique( data()[[input$group_col]]))
color_values <- brewer.pal(min(unique_groups, 12), "Set3")
scatterPlotObj(ggplot( data(), aes(x = data()[,input$x_col], y = data()[,input$y_col],color = data()[,input$group_col])) +
geom_point(shape = as.numeric(input$point_shape),
size = input$point_size,
alpha = input$point_alpha
#color = data[,input$group_col]
) +
#facet_wrap(~ data[,input$group_col])
scale_color_manual(values = color_values) +
#labs(x = input$x_col, y = input$y_col) +
#guides(fill = guide_legend(title = 'Type'))+
labs(x = "Weight", y = "Miles/(US) gallon") +
theme(axis.title.x = element_text(size = input$label_size),
axis.title.y = element_text(size = input$label_size))+
theme_classic())
} else {
# "None"
scatterPlotObj(ggplot(data(), aes(x = data()[,input$x_col], y = data()[,input$y_col],color = data()[,input$group_col])) +
geom_point(shape = as.numeric(input$point_shape),
size = input$point_size,
alpha = input$point_alpha) +
#labs(x = input$x_col, y = input$y_col) +
#guides(fill = guide_legend(title = 'Type'))+
labs(x = "Weight", y = "Miles/(US) gallon") +
theme(axis.title.x = element_text(size = input$label_size),
axis.title.y = element_text(size = input$label_size))+
theme_classic())
}
}
#print(paste("X label size:", input$x_label_size))
#print(paste("Y label size:", input$y_label_size))
})
}
#
shinyApp(ui = ui, server = server)
To change the label size, you can call theme_classic() before changing the label size. Next, legend title can be change with name in scale_color_manual. Please consider posting a MRE in the future. There is no need to include all the libraries you mentioned to show your error. Try this
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Shiny grocery"),
dashboardSidebar(
sidebarMenu(id = "sidebarMenuID",
#menuItem("Home", tabName = "home", icon = icon("home")),
menuItem("Basic data visualization", tabName = "data_visualization", icon = icon("image"),
menuSubItem("Scatter plot", tabName = "scatter_plot", icon = icon("braille"))
)
)
),
dashboardBody(
useShinyjs(), #
tags$head(
tags$style(HTML("
.shiny-notification {
left: 20px !important;
bottom: 20px !important;
right: auto !important;
top: auto !important;
background-color: #E74C3C;
color: black; /* text color */
}
.custom-margin {
margin-right: 20px;
}
")),
tags$style(HTML("
.custom-column-padding {
padding-right: 5px !important;
padding-left: 5px !important;
}
"))
),
######################################## # scatter_plot
tabItem(tabName = "scatter_plot",
fluidRow(
column(width = 4,
#style = "background-color: black; padding: 20px;",
#style = "height: 200px;", #
fluidRow(
box(title = "Settings", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
width = 12,
# fileInput("scatter_data", "Choose a data file", accept = c(".csv", ".txt", ".xlsx")),
actionButton("scatter_button", "Generate Scatter Plot"),
downloadButton("download_scatter", "Download Scatter Plot")
)
),
fluidRow(
box(title = "Scatter Plot Parameters", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
width = 12,
column(width = 4,
selectInput("x_col", "X-axis Column", choices = NULL),
selectInput("y_col", "Y-axis Column", choices = NULL),
selectInput("group_col", "Grouping Column", choices = NULL),
sliderInput("x_label_size", "X Label Size", min = 8, max = 24, value = 12),
sliderInput("y_label_size", "Y Label Size", min = 8, max = 24, value = 12)
),
column(width = 4,
sliderInput("plot_width", "Plot Width", min = 100, max = 900, value = 800),
sliderInput("plot_height", "Plot Height", min = 100, max = 750, value = 600),
#jscolorInput("point_color", "Point Color", value = "#56B4E9"),
colourpicker::colourInput("point_color", "Point Color", value = "#56B4E9"),
selectInput("point_shape", "Point Shape", choices = 0:25, selected = 20),
sliderInput("point_size", "Point Size", min = 1, max = 10, value = 2),
sliderInput("point_alpha", "Point Alpha", min = 0, max = 1, value = 1, step = 0.1)
)
)
)
),
#plotOutput("scatter_plot_output")
column(width = 8,
#plotOutput("scatter_plot_output",width = "100%", height = "500px") #
box(title = "Scatter Plot", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
width = 12,
plotOutput("scatter_plot_output",width = "100%",height = "750px") #
)
)
)
)
)
)
server <- function(input, output, session) {
########################################### Basic data visualization
scatterPlotObj <- reactiveVal()
data <- reactiveVal(NULL)
buttonClicked <- reactiveVal(FALSE)
observe({
# req(input$scatter_data) #
# df<-read.xlsx(input$scatter_data$datapath)
df <- mtcars
data(df)
#
col_names <- colnames(data())
#
updateSelectInput(session, "x_col", "X-axis Column", choices = col_names[2:length(colnames)])
updateSelectInput(session, "y_col", "Y-axis Column", choices = col_names[1])
#
group_cols <- col_names[sapply(data(), function(col) is.factor(col) || is.character(col))]
# 如果存在分组信息，则添加到选择器，否则添加"None"
if(length(group_cols) > 0) {
updateSelectInput(session, "group_col", "Grouping Column", choices = c(group_cols,"None"))
} else {
updateSelectInput(session, "group_col", "Grouping Column", choices = "None", selected = "None")
}
})
#
###########
observeEvent(input$scatter_button, {
df <- data() #
req(df, input$x_col, input$y_col)
#data<-read.xlsx(input$scatter_data$datapath)
#req(input$scatter_data, input$x_col, input$y_col)
#
if(input$group_col != "None" && !is.null(df[[input$group_col]])) {
unique_groups <- length(unique(df[[input$group_col]]))
color_values <- brewer.pal(min(unique_groups, 12), "Set3")
scatterPlotObj(ggplot(df, aes(x = df[,input$x_col], y = df[,input$y_col],color = df[,input$group_col])) +
geom_point(shape = as.numeric(input$point_shape),
size = input$point_size,
alpha = input$point_alpha
#color = data[,input$group_col]
) +
#facet_wrap(~ data[,input$group_col])
scale_color_manual(values = color_values, name = "My Name") +
#labs(x = input$x_col, y = input$y_col) +
labs(x = "Weight", y = "Miles/(US) gallon") +
theme_classic() +
theme(axis.title.x = element_text(size = input$x_label_size),
axis.title.y = element_text(size = input$y_label_size))
)
} else {
# "None"
scatterPlotObj(ggplot(df, aes(x = df[,input$x_col], y = df[,input$y_col],color = input$point_color)) +
geom_point(shape = as.numeric(input$point_shape),
size = input$point_size,
alpha = input$point_alpha) +
#labs(x = input$x_col, y = input$y_col,color="Type") +
scale_color_manual(values = input$point_color, name = "My name") + ### <-----------
labs(x = "Weight", y = "Miles/(US) gallon") +
theme_classic() + ### choose theme and then change label size
theme(axis.title.x = element_text(size = input$x_label_size), ### <-------
axis.title.y = element_text(size = input$y_label_size)) ### <-------
)
}
buttonClicked(TRUE) #
})
output$scatter_plot_output <- renderPlot({
#
scatterPlotObj()
}, width = function() {
#paste(input$plot_width, "px", sep = "")
input$plot_width
}, height = function() {
input$plot_height
#paste(input$plot_height, "px", sep = "")
})
#
# observe({
# #data<-read.xlsx(input$scatter_data$datapath)
# # req(data(),
# # input$x_col, input$y_col, input$group_col,input$x_label_size,input$y_label_size,
# # input$plot_width,input$plot_height, input$point_color,
# # input$point_shape,input$point_size,input$point_alpha,input$point_stroke)
# #df <- data()
# #
# if(buttonClicked()) {
# if(input$group_col != "None" && !is.null( data()[[input$group_col]])) {
# unique_groups <- length(unique( data()[[input$group_col]]))
# color_values <- brewer.pal(min(unique_groups, 12), "Set3")
# scatterPlotObj(ggplot(data(), aes(x = .data[[input$x_col]], y = .data[[input$y_col]],color = .data[[input$group_col]])) +
# # scatterPlotObj(ggplot( data(), aes(x = data()[,input$x_col], y = data()[,input$y_col],color = data()[,input$group_col])) +
# geom_point(shape = as.numeric(input$point_shape),
# size = input$point_size,
# alpha = input$point_alpha
# #color = data[,input$group_col]
# ) +
# #facet_wrap(~ data[,input$group_col])
# scale_color_manual(values = color_values) +
# #labs(x = input$x_col, y = input$y_col) +
# #guides(fill = guide_legend(title = 'Type'))+
# labs(x = "Weight", y = "Miles/(US) gallon") +
# theme(axis.title.x = element_text(size = input$x_label_size),
# axis.title.y = element_text(size = input$y_label_size))+
# theme_classic())
# } else {
# # "None"
# scatterPlotObj(ggplot(data(), aes(x = .data[[input$x_col]], y = .data[[input$y_col]],color = input$point_color)) +
# geom_point(shape = as.numeric(input$point_shape),
# size = input$point_size,
# alpha = input$point_alpha) +
# scale_color_manual(values = input$point_color) +
# #labs(x = input$x_col, y = input$y_col) +
# #guides(fill = guide_legend(title = 'Type'))+
# labs(x = "Weight", y = "Miles/(US) gallon") +
# theme(axis.title.x = element_text(size = input$x_label_size),
# axis.title.y = element_text(size = input$y_label_size))+
# theme_classic())
# }
# }
# print(paste("X label size:", input$x_label_size))
# #print(paste("Y label size:", input$y_label_size))
# })
}
#
shinyApp(ui = ui, server = server)