# Spider plot --------------------------------------------------------------------------------------
#' @title Spider plot
#' @description Generates an spider plot for a decision model
#' @param data data.table with the utilities of a decision model
#' @param data.label data label
#' @param data.fill data fill color
#' @param data.color data color
#' @param data.linetype line type for data
#' @param data.alpha alpha scale for data
#' @param data.size line size for data
#' @param data.label.color label color for data
#' @param data.label.size label size for data
#' @param group name for the column of groups
#' @param criteria column name for criteria
#' @param valor column name for utilities
#' @param title plot title
#' @param title.font font type for title
#' @param title.color plot title color
#' @param title.size plot title size
#' @param label.font font type for labels
#' @param label.size labels size
#' @param label.color labels color
#' @param label.angle labels angle
#' @param label.position labels position
#' @param theta plot rotation angle
#' @param grid grid for plot
#' @param grid.color grid color
#' @param grid.radius.color grid radius color
#' @param grid.linetype grid line type
#' @param grid.size grid line size
#' @param grid.radius.linetype grid radius line type
#' @param grid.radius.size grid radius line size
#' @param axis axis
#' @param axis.label axis label
#' @param axis.color axis color
#' @param axis.size axis size
#' @param axis.linetype axis line type
#' @param axis.angle axis angle
#' @param axis.label.color axis label color
#' @param axis.label.size axis label size
#' @param axis.label.displace axis label displacement
#' @param axis.label.angle axis label angel
#' @param legend.position label position
#' @param legend.size legend size
#' @param legend.text.color legend text color
#' @param plot.margin plot margin
#' @return ggplot2 object with the spider plot
#' @author Pedro Guarderas, Andrés Lopez
#' \email{pedro.felipe.guarderas@@gmail.com}
#' @examples
#' # Preparing data
#' library( data.table )
#' library( ggplot2 )
#' library( mau )
#' n <- 27
#' m <- 4
#' cols <- sample( colors()[ grepl('(purple|blue|olive)', colors() ) ], m, replace = TRUE )
#'
#' axis <- seq( 0.1, 1, 0.1 )
#' dat <- data.table( grp = paste( 'A', sort( rep( 1:m, n ) ), sep = '' ),
#' val = qlnorm( runif( m * n ) * plnorm( 1, 3, 4 ), 3, 4 ) )
#'
#' dat <- dat[ order( grp, val ) ]
#' dat[ , cri := factor( rep( paste( 'c', n:1, sep = '' ), m ),
#' levels = paste( 'c', n:1, sep = '' ), ordered = TRUE ) ]
#' dat <- as.data.frame( dat )
#'
#' parameters <- list( data = dat,
#' data.label = paste( 'A', 1:m, ' class', sep = '' ),
#' data.fill = cols,
#' data.color = cols,
#' data.linetype = rep( 'solid', m ),
#' data.alpha = rep( 0.05, m ),
#' data.size = rep( 0.7, m ),
#' data.label.color = 'black',
#' data.label.size = 15,
#'
#' group = as.name( 'grp' ),
#' criteria = as.name( 'cri' ),
#' valor = as.name( 'val' ),
#'
#' # Spider plot parameters
#' title = 'Spider',
#' title.font = 'New Times Roman',
#' title.color = 'red3',
#' title.size = 20,
#'
#' label.font = 'New Times Roman',
#' label.size = rep( 3, n ),
#' label.color = rep( 'steelblue4', n ),
#' label.angle = rep( 0, n ),
#' label.position = rep( 1.05, n ),
#'
#' theta = pi/3,
#'
#' grid = seq( 0.1, 1, 0.1 ),
#' grid.color = 'grey75',
#' grid.radius.color = 'grey75',
#' grid.linetype = 'dashed',
#' grid.size = 0.5,
#' grid.radius.linetype = 'solid',
#' grid.radius.size = 0.5,
#'
#' axis = axis, # Same as grid
#' axis.label = paste( 100 * axis, '%', sep = '' ),
#' axis.color = 'black',
#' axis.size = 0.7,
#' axis.linetype = 'solid',
#' axis.angle = 0.4*pi,
#' axis.label.color = 'darkgreen',
#' axis.label.size = 3,
#' axis.label.displace = -0.07,
#' axis.label.angle = 0,
#'
#' legend.position = c(0.9, 0.9),
#' legend.size = 0.5,
#' legend.text.color = 'black',
#'
#' plot.margin = unit( c( 1.0, 1.0, 1.0, 1.0 ),"cm") )
#'
#'
#' p <- do.call( spider_plot, parameters )
#'
#' plot(p)
#' @importFrom ggplot2 aes geom_polygon geom_segment geom_text scale_fill_manual ggplot theme element_text element_blank
#' @importFrom ggplot2 scale_color_manual scale_linetype_manual scale_alpha_manual scale_size_manual guide_legend element_rect
#' @import RColorBrewer
#' @export
spider_plot <- function( data, # Datos con los valores a plotear, data.frame
data.label,
data.fill,
data.color,
data.linetype,
data.alpha,
data.size,
data.label.color,
data.label.size,
group, # Columna de data por la cual se agrupan los datos
criteria, # Columna con los criterios de evaluación, debe ser
valor, # Columna con los valores de los polígonos
title, # Título para el plot (por ahora no en uso)
title.font, # Tipo de letra para el título (por ahora no en uso)
title.color, # Color del título
title.size, # Tamaño del título
label.font, # Tipo de letra para label
label.size, # Tamaño de etiquetas
label.color, # Color de etiquetas
label.angle, # Ángulo de etiqueas
label.position, # Posición de etiqueas
theta, # Giro del plot
grid, # Malla para los radios, vector numérico con valores únicos
grid.color, # Color del grid
grid.radius.color, # Color de los radios del grid
grid.linetype, # Tipo de línea del grid
grid.size, # Tamaño de la línea
grid.radius.linetype, # Tipo de línea de los radios del grid
grid.radius.size, # Tamaño de línea de los radios
axis, # Eje para ubicarse en el grid
axis.label, # Etiquetas del eje
axis.color, # Color del eje
axis.size, # Tamaño del eje
axis.linetype, # Tipo del eje
axis.angle, # Ángulo del eje
axis.label.color, # Color para labels
axis.label.size, # Tamaño del texto del eje
axis.label.displace, # Desplazamiento de los labels con respecto al eje
axis.label.angle, # Ángulo de labels
legend.position,
legend.size,
legend.text.color,
plot.margin # Márgenes del plot
) {
# Hay veces que está función falla numéricamente, hay que mejorarla
# Falla al volverse singular la matriz que se invierte
find.radius <- function( r, tl, tk, t ) {
M <- matrix( c( r * ( cos( tl ) - cos( tk ) ), -cos( t ),
r * ( sin( tl ) - sin( tk ) ), -sin( t ) ), 2, 2, byrow = TRUE )
b <- c( -r * cos( tk ), -r * sin( tk ) )
return( solve( M, b )[2] )
}
Grp <- deparse( substitute( group ) )
Cri <- deparse( substitute( criteria ) )
Val <- deparse( substitute( valor ) )
n <- nlevels( data[,Cri] )
m <- length( grid )
N <- n + 1
t <- ( seq( 0, 2 * pi, length.out = N ) + theta ) %% (2*pi)
t <- t[-N]
Data <- data
Data$x <- Data[[Val]] * cos( t[ as.numeric( Data[[Cri]] ) ] )
Data$y <- Data[[Val]] * sin( t[ as.numeric( Data[[Cri]] ) ] )
Labels <- data.frame( label = levels( Data[[Cri]] ) )
Labels$x <- label.position * cos( t )
Labels$y <- label.position * sin( t )
ald <- axis.label.displace * c( -sin( axis.angle ), cos( axis.angle ) )
k <- max( which( t <= axis.angle ) )
l <- (k+1) %% n
alpha <- sapply( grid, FUN = find.radius, t[l], t[k], axis.angle )
# axis.break.position <- data.frame( x = grid[m] * alpha * cos( axis.angle ),
# y = grid[m] * alpha * sin( axis.angle ),
# xlab = grid[m] * alpha * cos( axis.angle ) + ald[1],
# ylab = grid[m] * alpha * sin( axis.angle ) + ald[2] )
axis.break.position <- data.frame( x = grid,
y = rep( 0, length( grid ) ) )
axis.break.position <- data.frame( axis.break.position, label = axis.label )
with( Data, {
p <- ggplot( data = Data, aes( x = x, y = y ) )
for ( i in 1:m ) {
X <- data.frame( x = grid[i] * cos( t ), y = grid[i] * sin( t ) )
p <- p + geom_polygon( data = X, aes( x = x, y = y ),
fill = 'white',
colour = grid.color,
linetype = grid.linetype,
size = grid.size,
alpha = 0.0 )
}
p <- p + geom_segment( data = X, aes( x = 0, y = 0, xend = x, yend = y ),
colour = grid.radius.color,
linetype = grid.radius.linetype,
size = grid.radius.size )
# p <- p + geom_segment( data = X,
# aes( x = 0, y = 0,
# xend = axis.break.position[m,1],
# yend = axis.break.position[m,2] ),
# colour = axis.color,
# linetype = axis.linetype,
# size = axis.size )
#
# p <- p + geom_text( data = axis.break.position,
# aes( x = xlab, y = ylab, label = label ),
# size = axis.label.size,
# color = axis.label.color,
# angle = axis.label.angle )
p <- p + geom_text( data = axis.break.position,
aes( x = x, y = y, label = label ),
size = axis.label.size,
color = axis.label.color,
angle = axis.label.angle )
p <- p + geom_polygon( aes( fill = .data[[Grp]],
group = .data[[Grp]],
colour = .data[[Grp]],
linetype = .data[[Grp]],
alpha = .data[[Grp]],
size = .data[[Grp]] ),
show.legend = TRUE )
p <- p + scale_fill_manual( values = data.fill,
labels = data.label,
guide = guide_legend( label.theme = element_text( family = label.font, angle = 0,
colour = data.label.color,
size = data.label.size ) ) ) +
scale_color_manual( values = data.color, guide = "none" ) +
scale_linetype_manual( values = data.linetype, guide = "none" ) +
scale_alpha_manual( values = data.alpha, guide = "none" ) +
scale_size_manual( values = data.size, guide = "none" )
p <- p + geom_text( data = Labels,
aes( x = x, y = y, label = label ),
size = label.size,
color = label.color,
angle = label.angle )
# p <- p + ggtitle( label = title )
p <- p + theme( plot.margin = plot.margin,
panel.background = element_rect( fill = "white", colour = NA ),
panel.border = element_blank() ,
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
title = element_text( family = title.font, colour = title.color, size = title.size ),
axis.ticks = element_blank(),
axis.text.x = element_blank(),
axis.title.x = element_blank(),
axis.text.y = element_blank(),
axis.title.y = element_blank(),
legend.position = 'none',
legend.background = element_blank(),
legend.title = element_blank() )
return( p )
})
}
Spider.Plot <- function( data,
data.label,
data.fill,
data.color,
data.linetype,
data.alpha,
data.size,
data.label.color,
data.label.size,
group,
criteria,
valor,
title,
title.font,
title.color,
title.size,
label.font,
label.size,
label.color,
label.angle,
label.position,
theta,
grid,
grid.color,
grid.radius.color,
grid.linetype,
grid.size,
grid.radius.linetype,
grid.radius.size,
axis,
axis.label,
axis.color,
axis.size,
axis.linetype,
axis.angle,
axis.label.color,
axis.label.size,
axis.label.displace,
axis.label.angle,
legend.position,
legend.size,
legend.text.color,
plot.margin
) {
.Deprecated(
new = 'spider_plot',
msg = 'The function Spider.Plot will be replaced by the function spider_plot',
old = 'Spider.Plot' )
return( spider_plot( data,
data.label,
data.fill,
data.color,
data.linetype,
data.alpha,
data.size,
data.label.color,
data.label.size,
group,
criteria,
valor,
title,
title.font,
title.color,
title.size,
label.font,
label.size,
label.color,
label.angle,
label.position,
theta,
grid,
grid.color,
grid.radius.color,
grid.linetype,
grid.size,
grid.radius.linetype,
grid.radius.size,
axis,
axis.label,
axis.color,
axis.size,
axis.linetype,
axis.angle,
axis.label.color,
axis.label.size,
axis.label.displace,
axis.label.angle,
legend.position,
legend.size,
legend.text.color,
plot.margin ) )
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.