How to change the legend text using mschart for R? - r

I used mschart to generate a chart in R. However:
(1) I can't find how to change the legend text. Now the legend text is "a" and "b". I hope to change to other string, such as "legend text 1" and "legend text 2".
(2) If I change "a" and "b" to chinese characters, such "中国" and "北京" I got an error. The new word file can't be opened. If I changed back to English characters, it works again!
library(officer)
library(magrittr)
library(mschart)
doc <- read_docx()
newdata <- data.frame(
Name = c("a","a","a","a","b","b","b","b"),
wave_id = c(
"2017Q1", "2017Q2", "2017Q3", "2017Q4", "2017Q1", "2017Q2", "2017Q3", "2017Q4"
),
pct = c(0.68,0.71,0.70,0.72,0.57,0.57,0.57,0.58)
)
my_barchart <- ms_barchart(data = newdata, x = "wave_id", y = "pct", group = "Name")
my_barchart <- chart_settings(
x = my_barchart, dir="horizontal", grouping = "stacked", overlap = 100
)
my_barchart <- chart_labels(
my_barchart, title = NULL, xlab = NULL, ylab = NULL
)
my_barchart <- chart_data_labels(
my_barchart, position = "ctr", show_val = TRUE,
separator = ",", show_cat_name = FALSE
)
fp_text_settings <- list(a = fp_text(font.size = 7), b = fp_text(font.size = 7))
my_barchart <- chart_labels_text(my_barchart, fp_text_settings)
mytheme <- mschart_theme(
axis_title_x = fp_text(color = "red", font.size = 24, bold = TRUE),
axis_title_y = fp_text(color = "green", font.size = 12, italic = TRUE),
grid_major_line_x = fp_border(width = 0, color = "orange"),
axis_ticks_y = fp_border(width = 1, color = "orange"))
my_barchart <- set_theme(my_barchart, mytheme)
doc %>% body_add_chart(my_barchart)
print(doc, target = "new.docx")

Related

R: Deduplicating Legends in Plotly

I am working with the R programming language. I have the following data:
myFun <- function(n = 5000) {
a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE))
paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE))
}
var1 <- c("a", "b", "c", "d", "e")
var1 <- sample(var1, 100, replace=TRUE, prob=c(0.2, 0.2, 0.2, 0.2, 0.2))
var2 = rnorm(100, 100,100)
var3 = rnorm(100,100,100)
var4 = rnorm(100, 100,100)
label1 = myFun(100)
label2 = myFun(100)
label3 = myFun(100)
label4 = myFun(100)
my_data =data.frame(var1, var2, var3, var4, label1, label2, label3, label4)
I am trying to make a Bubble Plot using the Plotly library. Here is the code I am using:
library(plotly)
p = plot_ly(my_data, x = ~ var2, y = ~ var3, color = ~ var1, type = "scatter", mode = "markers", size = ~var4, marker = list(symbol = 'circle', sizemode = 'diameter', line = list(width = 2, color = '#FFFFFF'), opacity =0.4, autosize = T))
p = p %>% layout ( axis = list(title = 'Title 1'), yaxis = list(title = 'title 2'), legend = list(title = list(text = '<b> var1 </b>')))
p = p %>% layout(title = paste0('Main Title', '<br>', 'sup', 'Subtitle' ))
annotation_row = my_data[1,]
annotation = list( x = my_data$var2, y = my_data$var3, text = my_data$var1, xref = "x", yref = "y", showarrow = TRUE, arrowhead = 7, ax = 20, ay = -40)
p = p %>% add_trace (text = paste("Var 1:", my_data$var1, "<br> Var 2: ", my_data$var2, "<br> Var 3: ", my_data$var3 ), hoverinfo = "text" )
p = p %>% layout(annotations = annotation)
htmltools::save_html(html = p, file = "file.html")
The plot runs fine, but I am noticing two problems:
The values in the legend are appearing twice (e.g. a,b,c,d,e,a,b,c,d,e)
(Even though the plot in this example appears fine) When I run this code on my real data, the plot is appearing "horizontally stretched" (e.g.https://stackoverflow.com/questions/73552382/r-forcing-plotly-to-save-full-sized-plots). I tried different options to fix this "horizontal stretching"
For example (instead of "autosize", I tried to manually specify the height and width) :
p = plot_ly(my_data, x = ~ var2, y = ~ var3, color = ~ var1, type = "scatter", mode = "markers", size = ~var4, marker = list(symbol = 'circle', sizemode = 'diameter', line = list(width = 2, color = '#FFFFFF'), opacity =0.4, height = 1000, width = 1000))
Can someone please show me how to fix this problem?
Is it possible to undo this "legend duplication" and re-write the plotly code in such a way that the "horizontal stretching" problem is fixed?
Thanks!

Add a color beside the heatmap

I've built a heatmap but I can't seem to set up groups next to the rows and columns. Please I want something like this heatmap.
#Design of the data as an example
Data <- data.frame(replicate(6,sample(0:1,6,rep=TRUE)))
row.names(Data) <- c('Gene1','Gene2','Gene3','Gene4','Gene5','Gene6')
colnames(Data) <- c("Strain1", "Strain2", "Strain3", "Strain4", "Strain5", "Strain6")
pheatmap(Data, color=colorRampPalette(c("#FFE4B5","#708090"))(2),
legend_breaks = c(1, 0),
legend_labels = c("Presence", "Absence"),
border_color = "black", display_numbers = FALSE,
number_color = "black",
fontsize_number = 8)
#Now I want to create Groups (Row) ##To designate that they are
part of the same antibiotic resistance family##
#Groupe1 "Gene3 and Gene6" Color1
#Groupe2 "Gene1 and Gene5" Color2
#Groupe3 "Gene2 and Gene4" Color3
#How can I do this?
#Same question if I want to create Groupes for column ##To
designate that they are part of the same bacterial genus#
#Band1 "Strain1" and "Strain3" Color4
#Band2 "Strain4" and "Strain5" Color5
#Band3 "Strain2" and "Strain6" Color6
You need to create little data frames for your annotations and pass them to annotation_row and annotation_col. The actual colours are passed as a named list of two named vectors to annotation_colors:
row_df <- data.frame(Group = paste("Groupe", rep(1:3, each = 2)),
row.names = paste0("Gene", 1:6))
col_df <- data.frame(Genus = c("GenusA", "GenusC", "GenusA",
"GenusB", "GenusB", "GenusC"),
row.names = paste0("Strain", 1:6))
pheatmap(Data,
color = colorRampPalette(c("#FFE4B5","#708090"))(2),
legend_breaks = c(1, 0),
legend_labels = c("Presence", "Absence"),
border_color = "black", display_numbers = FALSE,
number_color = "black",
annotation_row = row_df,
annotation_col = col_df,
fontsize_number = 8,
annotation_colors = list(Group = c("Groupe 1" = "red3", "Groupe 2" = "blue4",
"Groupe 3" = "green4"),
Genus = c(GenusA = "gold", GenusB = "purple",
GenusC = "cyan")))

Cannot set all violins to the same width in R Plotly

I'm trying to reproduce in R Plotly a 2 categorical variables violin plot that works just fine in ggplot2. But when I set the widths of the individual violins to be the same, using scalemode = "width", as described in the reference (https://plotly.com/r/reference/violin/), it simply wont work. Instead, it shows the widths (violin maximum) proportional to the counts in each category.
Here is an example:
# Paths:
path_data = "data/"
path_lib = "renv/library/R-4.1/x86_64-pc-linux-gnu/"
# Packages:
require(dplyr, lib = path_lib)
require(readr, lib = path_lib)
require(RColorBrewer, lib = path_lib)
require(plotly, lib = path_lib)
# Dataset:
df = readr::read_csv(paste0(path_data, "nasa_exoplanets.csv")) %>%
as.data.frame()
attr(df, "spec") = NULL
df_varnames = readr::read_csv(paste0(path_data, "nasa_exoplanets_var_names.csv")) %>%
as.data.frame()
attr(df_varnames, "spec") = NULL
# Variables:
cat_var1 = "st_metratio"
cat_var2 = "disc_locale"
cat_var_name1 = (df_varnames %>%
dplyr::filter(var == cat_var1))$var_name
cat_var_name2 = (df_varnames %>%
dplyr::filter(var == cat_var2))$var_name
num_var = "sy_dist"
num_var_name = (df_varnames %>%
dplyr::filter(var == num_var))$var_name
# Adapt the data:
df_plot = df %>%
dplyr::select(cat_var1,
cat_var2,
num_var)
# Deal with NA:
df_plot[which(is.na(df_plot[, cat_var1])), cat_var1] = "NA"
df_plot[which(is.na(df_plot[, cat_var2])), cat_var2] = "NA"
df_plot = df_plot[which(!is.na(df_plot[, num_var])), ]
# Levels order:
sorted_levels1 = sort(unique(df_plot[, cat_var1]))
df_plot[, cat_var1] = factor(x = df_plot[, cat_var1],
levels = sorted_levels1)
sorted_levels2 = sort(unique(df_plot[, cat_var2]))
df_plot[, cat_var2] = factor(x = df_plot[, cat_var2],
levels = sorted_levels2)
# Plot:
my_palette = colorRampPalette(c("#111539", "#97A1D9"))
n_levels2 = length(unique(df_plot[, cat_var2]))
p = plot_ly(
data = df_plot,
type = "violin",
x = ~eval(parse(text = cat_var1)),
y = ~eval(parse(text = num_var)),
color = ~eval(parse(text = cat_var2)),
colors = my_palette(n_levels2),
spanmode = "hard",
alpha = 1,
box = list(visible = FALSE),
meanline = list(visible = FALSE),
points = FALSE,
scalemode = "width" ### this doesn't work ###
) %>%
layout(
xaxis = list(
title = paste0("<b>", cat_var_name1, "</b>"),
titlefont = list(size = 20),
tickfont = list(size = 18),
categoryorder = "array"
),
yaxis = list(
title = paste0("<b>", num_var_name, "</b>"),
titlefont = list(size = 20),
tickfont = list(size = 18),
type = "log"
),
margin = list(
l = 10,
r = 10,
t = 10,
b = 10
),
legend = list(
title = list(
text = paste0("<br><b>", cat_var_name2, "</b>"),
font = list(size = 18)
)
),
hoverlabel = list(font = list(size = 16)),
showlegend = TRUE,
violinmode = "group"
)
p
data file: https://github.com/rafael747cardoso/Data_Visualization_Gallery/blob/main/data/nasa_exoplanets.csv
How it should be, plotted in ggplot2:
How it is with R Plotly:

R: loop returning list of plots include NULL

I have the following code. It selects data and makes a plotly plot. The code loops through the variable "criteria" and at the end of the loop inserts the plot in the appropriate index.
Everything works fine except that all but the last elements of the list are null and only the last plot is included.
How do I include all the plotly charts in the list?
criteria <- c("A", "B", "C")
for(i in 1:length(criteria)){
plotTbl <- dataTbl[Site == criteria[i]]
plotTbl <- unique(plotTbl[ ,N := .N, by = .(Site, Var)])
noexacCols <- unique(c(brewer.pal(name="Set1", n = 9),
brewer.pal(name="Set2", n = 8),
brewer.pal(name="BrBG", n =11),
brewer.pal(name="Paired", n = 12)))
noexacCols <- noexacCols[i]
colMapper <- data.table(Var = sort(unique(plotTbl[,Var])))
colMapper[, colorCodes := noexacCols]
plotTbl <- plotTbl[colMapper, on = .(Var), nomatch = 0]
plotTbl[ ,Percent := round(100*N/sum(N), 1)]
plotTbl[ ,text2display := paste0("Site = ",Site,
"<br>",category, " = ", Var,
"<br>N = ", N, " (", Percent, "%)")]
f1 <- list(
family = "Arial, sans-serif",
size = 14,
color = "black"
)
f2 <- list(
family = "Arial, sans-serif",
size = 12,
color = "black"
)
a <- list(
title = "",
titlefont = f1,
showticklabels = TRUE,
tickangle = 0,
tickfont = f2
)
b <- list(
title = "",
titlefont = f1,
showticklabels = TRUE,
tickangle = 0,
tickfont = f2,
zeroline = TRUE,
showline = TRUE,
mirror = FALSE,
linecolor = toRGB("black"),
linewidth = 1
)
p <- list()
p[[i]] <- plot_ly(data = plotTbl ,
x = ~Var,
y = ~N,
type = 'bar',
marker = list(color = ~colorCodes),
opacity = 0.7,
hoverinfo="text",
text = ~text2display) %>%
layout(xaxis = a, yaxis = b, showlegend = F, margin = list(b = 30))
}
You create p within the loop and thus overwrite it on every revolution. Move line p <- list() before the loop.

Custom legend in rCharts (highcharts)

I have a dataframe that looks like:
## Data
df <- data.frame(label = c("A", "B", "C", "D"),
color = c("red", "red", "blue", "green"),
y = c(10, 11, 12, 13))
"A" and "B" are part of the same category, while "C" and "D" are part of separate categories.
I would like to add a legend on the chart with category labels.
## Highchart without Legend
## Basic highchart
h <- rCharts:::Highcharts$new()
h$chart(type = "column")
## Highchart data:
h$series(showInLegend = FALSE, data = rCharts::toJSONArray2(df[, c("label", "color", "y")], json = FALSE, names = TRUE))
## Highchart options:
h$xAxis(categories = unique(df$label), labels = list(rotation = 0, align = 'center', style = list(fontSize = '12px', fontFamily = 'Verdana, sans-serif')), replace = FALSE)
h$tooltip(formatter = "#! function() {return this.x + ': ' + this.y; } !#")
h$plotOptions(series = list(color = df$color), column = list(grouping = FALSE))
h # display highchart
I haven't found a method that makes any sense to solve this problem.
Any help would be appreciated.
Disclaimer: I know the question says rCharts, I just want to add an alternative using highcharter package.
Like #Optimus said, the issue is add multiples series. In case you have arbitraty number of series (colors in your example) and want add it automatically you can use highcharter with allow you to add multiples series from a list of data series with the hc_add_series_list function.
library(highcharter)
library(dplyr)
df <- data_frame(label = c("A", "B", "C", "D"),
color = c("red", "red", "blue", "green"),
y = c(10, 11, 12, 13),
x = c(1:4)-1)
head(df)
series <- df %>%
group_by(color) %>% # each serie is from one color
do(data = list.parse3(.)) %>%
ungroup() %>%
mutate(name = paste("I'm color", color)) %>%
list.parse3()
Here list.parse3 is similar to toJSONArray2.
series[[1]]
$color
[1] "blue"
$data
$data[[1]]
$data[[1]]$label
[1] "C"
$data[[1]]$color
[1] "blue"
$data[[1]]$y
[1] 12
$data[[1]]$x
[1] 2
$name
[1] "I'm color blue"
Finally:
highchart() %>%
hc_chart(type = "column") %>%
hc_add_series_list(series) %>%
hc_xAxis(categories = df$label) %>%
hc_plotOptions(column = list(grouping = FALSE))
The result will be:
And here's how I solved it.
Each 'category' is split into a separate series with an x value to determine its location on the graph (highcharts requires this for some reason. Without it, the graphs stack).
Here's a sample code that works:
## Highchart with Legend
## Remark: simply switching showInLegend to TRUE will not work
df$x <- c(0, 1, 2, 3) # add an index to dataframe (starting from 0)
# and pass it to h$series data
h <- rCharts:::Highcharts$new()
h$chart(type = "column")
h$series(name = "Category 1 (Red)", color = "red", data = rCharts::toJSONArray2(df[df$color == "red", c("label", "color", "x", "y")], json = FALSE, names = TRUE))
h$series(name = "Category 2 (Blue)", color = "blue", data = rCharts::toJSONArray2(df[df$color == "blue", c("label", "color", "x", "y")], json = FALSE, names = TRUE))
h$series(name = "Category 3 (Green)", color = "green", data = rCharts::toJSONArray2(df[df$color == "green", c("label", "color", "x", "y")], json = FALSE, names = TRUE))
h$xAxis(categories = unique(df$label), labels = list(rotation = 0, align = 'center', style = list(fontSize = '12px', fontFamily = 'Verdana, sans-serif')), replace = FALSE)
h$tooltip(formatter = "#! function() {return this.x + ': ' + this.y; } !#")
h$plotOptions(series = list(color = df$color), column = list(grouping = FALSE))
h # display chart
I hope this helps someone else.

Resources