#' @eval get_description('scatter_chart')
#' @import struct
#' @export scatter_chart
#' @examples
#' D = iris_DatasetExperiment()
#' C = scatter_chart(
#' xcol = 'Petal.Width',
#' ycol = 'Sepal.Width',
#' factor_name = 'Species'
#' )
#' chart_plot(C,D)
#'
scatter_chart = function(
xcol=1,
ycol=2,
points_to_label='none',
factor_name='none',
ellipse='all',
ellipse_type='norm',
ellipse_confidence=0.95,
label_filter=character(0),
label_factor='rownames',
label_size=3.88,
...) {
out=struct::new_struct('scatter_chart',
xcol=xcol,
ycol=ycol,
points_to_label=points_to_label,
factor_name=factor_name,
ellipse=ellipse,
label_filter=label_filter,
label_factor=label_factor,
label_size=label_size,
ellipse_type=ellipse_type,
ellipse_confidence=ellipse_confidence,
...)
return(out)
}
.scatter_chart<-setClass(
"scatter_chart",
contains='chart',
slots=c(
# INPUTS
xcol='entity',
ycol='entity',
points_to_label='enum',
factor_name='entity',
ellipse='enum',
ellipse_type='enum',
ellipse_confidence='entity',
label_filter='entity',
label_factor='entity',
label_size='entity'
),
prototype = list(name='Group scatter chart',
description='Plots a 2d scatter plot of the input data.',
type="scatter",
.params=c('xcol','ycol','points_to_label','factor_name','ellipse',
'label_filter','label_factor','label_size','ellipse_type',
'ellipse_confidence'),
xcol=entity(
name='x-axis column name',
value=1,
type=c('numeric','integer','character'),
description=paste0('The column name, or index, of data to plot on the x-axis'),
max_length=1
),
ycol=entity(
name='y-axis column name',
value=2,
type=c('numeric','integer','character'),
description=paste0('The column name, or index, of data to plot on the y-axis'),
max_length=1
),
points_to_label=enum(name='Points to label',
value='none',
type='character',
description=c(
'none' = 'No samples labels are displayed.',
"all" = 'The labels for all samples are displayed.',
"outliers" = 'Labels for for potential outlier samples are displayed.'
),
allowed=c('none','all','outliers')
),
factor_name=ents$factor_name,
ellipse=enum(
name = 'Plot ellipses',
description=c(
"all" = paste0('Ellipses are plotted for all groups and all samples.'),
"group" = 'Ellipses are plotted for all groups.',
"none" = 'Ellipses are not included on the plot.',
"sample" = 'An ellipse is plotted for all samples (ignoring group)'),
allowed=c('all','group','none','sample'),
value='all'
),
ellipse_type=enum(
name='Type of ellipse',
description=c(
'norm' = paste0('Multivariate normal (p = 0.95)'),
't' = paste0('Multivariate t (p = 0.95)')
),
value='norm',
type='character',
max_length = 1,
allowed=c('norm','t')
),
ellipse_confidence=entity(
name='Ellipse confidence level',
description='The confidence level for plotting ellipses.',
value=0.95,
type='numeric',
max_length = 1
),
label_filter=entity(
name='Label filter',
value=character(0),
type='character',
description=paste0(
'Labels are only plotted for the named groups. If ',
'zero-length then all groups are included.'
)
),
label_factor=entity(name='Factor for labels',
description=paste0('The column name of sample_meta to use for ',
'labelling samples on the plot. "rownames" will use the row ',
'names from sample_meta.'),
type='character',
value='rownames',
max_length=1),
label_size=entity(name='Text size of labels',
description='The text size of labels. Note this is not in Font Units.',
type='numeric',
value=3.88,
max_length=1)
)
)
#' @importFrom sp point.in.polygon
#' @import ggplot2
#' @importFrom scales squish
#' @export
#' @template chart_plot
setMethod(f="chart_plot",
signature=c("scatter_chart",'DatasetExperiment'),
definition=function(obj,dobj)
{
# if provided convert index to names
if (is.numeric(obj$xcol)) {
obj$xcol=colnames(dobj)[obj$xcol]
}
if (is.numeric(obj$ycol)) {
obj$ycol=colnames(dobj)[obj$ycol]
}
if (obj$points_to_label=='outliers' & !(obj$ellipse %in% c('all','sample'))) {
warning('Outliers are only labelled when plotting the sample ellipse')
}
if (length(obj$factor_name)==1) {
shapes = 19 # filled circles for all samples
} else {
shapes = factor(dobj$sample_meta[[obj$factor_name[2]]])
}
if (obj$label_factor=='rownames') {
slabels = rownames(dobj$sample_meta)
} else {
slabels = dobj$sample_meta[[obj$label_factor]]
}
x=dobj$data[,obj$xcol]
y=dobj$data[,obj$ycol]
xlabel=obj$xcol
ylabel=obj$ycol
# get the factor from meta data
groups=dobj$sample_meta[[obj$factor_name[[1]]]]
# add a space to the front of the labels to offset them from the points, because nudge_x is in data units
for (i in 1:length(slabels)) {
slabels[i]=paste0(' ',slabels[i], ' ')
}
# filter by label_filter list if provided
if (length(obj$label_filter)>0) {
out=!(as.character(groups) %in% obj$label_filter)
slabels[out]=''
}
if (is(groups,'factor') | is(groups,'character')) {
plotClass= createClassAndColors(groups)
groups=plotClass$class
}
# build the plot
A <- data.frame (group=groups,x=x, y=y,slabels=slabels,shape=shapes)
out = ggplot()
# add invisible sample points for ellipse
out = out+geom_point(data=A,aes_string(x='x',y='y'),alpha=0,show.legend=FALSE)
if (length(shapes)>1) {
out=out+geom_point(data=A, aes_(x=~x,y=~y,colour=~group,shape=~shape))
} else {
out=out+geom_point(data=A, aes_(x=~x,y=~y,colour=~group),shape=shapes)
}
out=out+
geom_point(na.rm=TRUE) +
xlab(xlabel) +
ylab(ylabel)
if (length(shapes)>1) {
out=out+labs(shape=obj$factor_name[[2]],colour=obj$factor_name[[1]])
} else {
out=out+labs(color=obj$factor_name[[1]])
}
if (obj$ellipse %in% c('all','group')) {
if (is.factor(groups)) {
out = out +stat_ellipse(data=A, aes_(x=~x,y=~y,colour=~group,group=~group),type=obj$ellipse_type,
level=obj$ellipse_confidence) # ellipse for individual groups
} else {
if (is.factor(shapes)) {
out = out +stat_ellipse(data=A, aes_(x=~x,y=~y,group=~shape),color="#C0C0C0",type=obj$ellipse_type,
level=obj$ellipse_confidence) # ellipse for individual groups
}
}
}
if (is(groups,'factor')) { # if a factor then plot by group using the colours from pmp package
out=out+scale_colour_manual(values=plotClass$manual_colors,
name=obj$factor_name[[1]])
} else {# assume continuous and use the default colour gradient
out=out+scale_colour_viridis_c(limits=quantile(groups,
c(0.05,0.95),na.rm = TRUE),oob=scales::squish,name=obj$factor_name[[1]])
}
out=out+theme_Publication(base_size = 12)
# add ellipse for all samples (ignoring group)
if (obj$ellipse %in% c('all','sample')) {
out=out+stat_ellipse(type=obj$ellipse_type,mapping=aes(x=x,y=y),
colour="#C0C0C0",linetype='dashed',data=A,
level=obj$ellipse_confidence)
}
if (obj$ellipse %in% c('all','sample')) { # only do this if we plotted the sample ellipse
# identify samples outside the ellipse
build=ggplot_build(out)$data
points=build[[1]]
ell=build[[length(build)]]
# outlier for DatasetExperiment ellipse
points$in.ell=as.logical(sp::point.in.polygon(points$x,points$y,ell$x,ell$y))
# label outliers if
if (obj$points_to_label=='outliers')
{
if (!all(points$in.ell))
{
temp=subset(points,!points$in.ell)
temp$group=groups[!points$in.ell]
temp$label=slabels[!points$in.ell]
out=out+geom_text(data=temp,aes_(x=~x,y=~y,label=~label,colour=~group),size=obj$label_size,vjust="inward",hjust="inward",show.legend=FALSE)
}
}
# add a list of outliers to the plot object
out$outliers=trimws(slabels[!points$in.ell])
}
# label all points if requested
if (obj$points_to_label=='all') {
out=out+geom_text(data=A,aes_string(x='x',y='y',colour='group',label='slabels'),vjust="inward",hjust="inward",show.legend=FALSE)
}
return(out)
}
)
