Un titre multicolore

mercredi 8 juillet 2009, par jps29

Voici le code avec les auteurs inclus dedans (j’engrange, cela peut toujours servir) :

png("colortitle.png",width=500,height=400)
plot(rnorm(20),rnorm(20),col=rep(c("red","blue"),c(10,10)))
title(expression("Hair color" * phantom(" and Eye color")),col.main="red")
title(expression(phantom("Hair color and ") * "Eye color"),col.main="blue")
title(expression(phantom("Hair color ") * "and " * phantom("Eye color"),col.main="black"))
dev.off()

multiTitle <- function(...){
###
### multi-coloured title
###
### examples:
###  multiTitle(color="red","Traffic",
###             color="orange"," light ",
###             color="green","signal")
###
### - note triple backslashes needed for embedding quotes:
###
###  multiTitle(color="orange","Hello ",
###             color="red"," \\\"world\\\"!")
###
### Barry Rowlingson <b.rowlingson@lancaster.ac.uk>
###
 l = list(...)
 ic = names(l)=='color'
 colors = unique(unlist(l[ic]))

 for(i in colors){
   color=par()$col.main
   strings=c()
   for(il in 1:length(l)){
     p = l[[il]]
     if(ic[il]){ # if this is a color:
       if(p==i){  # if it's the current color
         current=TRUE
       }else{
         current=FALSE
       }
     }else{ # it's some text
       if(current){
         # set as text
         strings = c(strings,paste('"',p,'"',sep=""))
       }else{
         # set as phantom
         strings = c(strings,paste("phantom(\"",p,"\")",sep=""))
       }
     }
   } # next item
   ## now plot this color
   prod=paste(strings,collapse="*")
   express = paste("expression(",prod,")",sep="")
   e=eval(parse(text=express))
   title(e,col.main=i)
 } # next color
 return()
}

## Example
plot(rnorm(20),rnorm(20),col=rep(c("red","blue"),c(10,10)))
multiTitle(color="red","Hair color", color="black"," and ",color="blue","Eye color")

## By Duncan Murdoch: https://stat.ethz.ch/pipermail/r-help/2009-January/185696.html
technicolorTitle <- function(words, colours, cex=1) {
   widths <- strwidth(words,cex=cex)
   spaces <- rep(strwidth(" ",cex=cex), length(widths)-1)
   middle <- mean(par("usr")[1:2])
   total <- sum(widths) + sum(spaces)
   start <- c(0,cumsum(widths[-length(widths)] + spaces))
   start <- start + middle - total/2
   mtext(words, 3, 1, at=start, adj=0, col=colours,cex=cex)
   }

## Example
plot(1)
technicolorTitle(c("Hair color", "and", "Eye color"), c("red", "black", "blue"))

Voir en ligne : La source

Un message, un commentaire ?

modération a priori

Ce forum est modéré a priori : votre contribution n’apparaîtra qu’après avoir été validée par un administrateur du site.

Qui êtes-vous ?
Votre message