Página Inicial > gráficos, regressão > Como adicionar legendas em gráficos da lattice

Como adicionar legendas em gráficos da lattice

Gráfico com bandas de confiança, legenda e assinatura de autor e versão.

No post Como fazer legendas em gráficos eu mostrei procedimentos para gráficos do pacote graphics. Nesse post vou apresentar procedimento para fazer legendas em gráficos da lattice, desenvolvido por Deepayan Sarkar. Iremos empregar as opções auto.key=, key=, colorkey=, e as funções draw.key() e draw.colorkey(). O pacote grid, desenvolvido por Paul Murrell será necessário para posicionarmos as legendas na página gráfica. Nos exemplos temos legendas para pontos, linhas, pontos e linhas, barras, escala de cores para gráficos de três dimensões, gráfico com duas legendas, posicionamento da legenda com o mouse e gráfico com legenda para representar o ajuste de um modelo de regressão com valores observados, preditos e intervalo de confiança.

#-----------------------------------------------------------------------------
# pacotes

require(lattice) # para fazer os gráficos
require(grid)    # para posicionar as legendas

#-----------------------------------------------------------------------------
# dados de indice agronômico em função da cultivar de milho e dose de N

da <- read.table("http://www.leg.ufpr.br/~walmes/cursoR/anovareg.txt",
                 header=TRUE, sep="\t")
str(da)

#-----------------------------------------------------------------------------
# legenda para gráfico de dispersão

# gráfico com legenda padrão
xyplot(indice~dose, groups=cultivar, data=da, jitter.x=TRUE, auto.key=TRUE)

# gráfico com legenda em colunas e alteração dos padrões dos pontos
xyplot(indice~dose, groups=cultivar, data=da, jitter.x=TRUE,
       auto.key=list(columns=3),
       par.settings=list(superpose.symbol=list(pch=15:17, col=3:5, cex=1.2)))

# muda a posição da legenda
xyplot(indice~dose, groups=cultivar, data=da, jitter.x=TRUE,
       auto.key=list(space="right", columns=1),
       par.settings=list(superpose.symbol=list(pch=15:17, col=3:5, cex=1.2)))

# coloca a legenda dentro do gráfico
xyplot(indice~dose, groups=cultivar, data=da, jitter.x=TRUE,
       auto.key=list(corner=c(0.95,0.05), columns=1),
       par.settings=list(superpose.symbol=list(pch=15:17, col=3:5, cex=1.2)))

#-----------------------------------------------------------------------------
# legenda para gráfico de linhas

db <- with(da, aggregate(indice, list(cultivar=cultivar, dose=dose), mean))
col <- trellis.par.get("superpose.line")$col[1:nlevels(db$cultivar)]

# gráfico com legendas de linhas, nomes *antes* das linhas
xyplot(x~dose, groups=cultivar, data=db, type="l",
       key=list(corner=c(0.95,0.05), columns=1,
         text=list(levels(db$cultivar)),
         lines=list(col=col)))

# gráfico com legendas de linhas, nomes *depois* das linhas
xyplot(x~dose, groups=cultivar, data=db, type="l",
       key=list(corner=c(0.95,0.05), columns=1,
         lines=list(col=col),
         text=list(levels(db$cultivar))))

#-----------------------------------------------------------------------------
# legenda para gráfico de linhas e pontos

xyplot(x~dose, groups=cultivar, data=db, type="o", pch=19,
       key=list(corner=c(0.95,0.05), columns=1,
         type="o", divide=1,
         lines=list(col=col, pch=19),
         text=list(levels(db$cultivar))))

#-----------------------------------------------------------------------------
# legenda para pontos e reta de regressão

# ajuste de modelo e criação de objeto com valores observados e preditos
m0 <- lm(indice~cultivar*(dose+I(dose^2)), data=da)
dc <- expand.grid(cultivar=levels(da$cultivar), dose=seq(0,300,l=100))
dc$indice <- predict(m0, newdata=dc)
dc$ind <- "predito"
da$ind <- "obsevado"
dc <- rbind(da[,-3], dc)
str(dc)

# legenda fora do gráfico
xyplot(indice~dose|cultivar, groups=ind, data=dc,
       distribute.type=TRUE, type=c("p","l"), col=1, layout=c(3,1),
       key=list(space="top", columns=2, type="o", divide=1,
         lines=list(pch=c(1,NA), lty=c(0,1)),
         text=list(c("valores observados","valores preditos"))))

# legenda dentro do gráfico
xyplot(indice~dose|cultivar, groups=ind, data=dc,
       distribute.type=TRUE, type=c("p","l"), col=1, layout=c(3,1),
       key=list(corner=c(0.95,0.05), columns=1, type="o", divide=1,
         lines=list(pch=c(1,NA), lty=c(0,1)),
         text=list(c("valores observados","valores preditos"))))

#-----------------------------------------------------------------------------
# dados de mortalidade de aves em função do tipo de resfriamento do aviário

ma <- read.table("http://www.leg.ufpr.br/~walmes/cursoR/mortes.txt",
                 header=TRUE, sep="\t")
str(ma)

#-----------------------------------------------------------------------------
# legenda para gráficos de barras

mb <- with(ma, aggregate(mortes, list(galpao=galpao, sistema=asper), sum))
str(mb)

col <- c("forestgreen", "palegreen")

# legenda fora da região gráfica
barchart(x~galpao, groups=sistema, data=mb, horiz=FALSE, col=col,
         key=list(space="top", columns=2,
           rectangles=list(col=col),
           text=list(c("com aspersão","sem aspersão"))))

# legenda fora da região gráfica com título
barchart(x~galpao, groups=sistema, data=mb, horiz=FALSE, col=col,
         key=list(title="Sistema de resfriamento", cex.title=1.1,
           space="top", columns=2,
           rectangles=list(col=col),
           text=list(c("com aspersão","sem aspersão"))))

# legenda dentro da região gráfica com título
barchart(x~galpao, groups=sistema, data=mb, horiz=FALSE, col=col,
         key=list(title="Sistema de resfriamento", cex.title=1.1,
           corner=c(0.05,0.95), columns=1, padding.text=2,
           rectangles=list(col=col, size=3, height=0.8, border=TRUE),
           text=list(c("com aspersão","sem aspersão"))))

#-----------------------------------------------------------------------------
# escolhendo a posição da legenda com o mouse

barchart(x~galpao, groups=sistema, data=mb, horiz=FALSE, col=col)
trellis.focus(name="page")
loc <- grid.locator(unit="npc") # clicar no gráfico
trellis.unfocus()

barchart(x~galpao, groups=sistema, data=mb, horiz=FALSE, col=col,
         key=list(title="Sistema de\nresfriamento", cex.title=1.1,
           x=loc$x, y=loc$y, corner=c(0.5,0.5), columns=1, padding.text=2,
           rectangles=list(col=col, size=3, height=0.8, border=TRUE),
           text=list(c("com\naspersão","sem\naspersão"))))

#-----------------------------------------------------------------------------
# nota de rodapé no gráfico com assinatura, data e versão

# ajuste de modelo e criação de objeto com valores observados, preditos e IC
m0 <- lm(indice~cultivar*(dose+I(dose^2)), data=da)
dc <- expand.grid(cultivar=levels(da$cultivar), dose=seq(0,300,l=100))
indice <- predict(m0, newdata=dc, interval="confidence")
dc <- cbind(dc, stack(data.frame(indice)))
names(dc)[3] <- "indice"
dc <- rbind(da[,-3], dc)

#png("f017.png", w=500, h=350)
xyplot(indice~dose|cultivar, groups=ind, data=dc,
       distribute.type=TRUE, type=c("l","l","p","l"),
       col=1, lty=c(1,2,0,2), layout=c(3,1),
       strip=strip.custom(bg="gray90"),
       xlab="Dose de nitrogênio (kg/ha)", ylab="Índice agronômico",
       key=list(space="top", columns=3, type="o", divide=1,
         lines=list(pch=c(1,NA,NA), lty=c(0,1,2)),
         text=list(c("valores observados","valores preditos","IC 95%"))))
pushViewport(viewport())
grid.text(label=paste("Walmes Zeviani --",
            format(Sys.time(), "%d/%m/%Y %H:%M:%S --"),
            R.version.string), rot=90,
          x=unit(1, "npc")-unit(2, "mm"),
          y=unit(0, "npc")+unit(2, "mm"),
          just=c("left", "bottom"),
          gp=gpar(cex=0.8, col="gray50"))
popViewport()
#dev.off()

#-----------------------------------------------------------------------------
# legenda para gráficos de 3 dimensões

x <- seq(-10,10,l=50)
dd <- expand.grid(x=x, y=x)
dd$z <- with(dd, 500+x+2*y-0.5*x*y-x^2-y^2)

# gráfico sem cores e sem legenda
wireframe(z~x+y, data=dd)

# gráfico com cores e legenda
wireframe(z~x+y, data=dd, drape=TRUE)

# remove a legenda
wireframe(z~x+y, data=dd, drape=TRUE, colorkey=FALSE)

# coloca a legenda embaixo
wireframe(z~x+y, data=dd, drape=TRUE, colorkey=list(space="bottom"))

# redimensionando a legenda
wireframe(z~x+y, data=dd, drape=TRUE,
          colorkey=list(width=1, height=0.7))

# gráfico de níveis de cor
levelplot(z~x+y, data=dd)

# com contornos e redimensiomento da legenda
levelplot(z~x+y, data=dd, contour=TRUE,
          colorkey=list(width=1, height=0.7))

#-----------------------------------------------------------------------------
# usando a draw.key(), usar fora da função gráfica ou dentro da panel()

xyplot(indice~dose|cultivar, groups=ind, data=dc,
       distribute.type=TRUE, type=c("l","l","p","l"),
       col=1, lty=c(1,2,0,2), layout=c(2,2),
       strip=strip.custom(bg="gray90"),
       xlab="Dose de nitrogênio (kg/ha)", ylab="Índice agronômico")
draw.key(list(space="top", columns=1, type="o", divide=1,
         lines=list(pch=c(1,NA,NA), lty=c(0,1,2)),
         text=list(c("valores observados","valores preditos","IC 95%"))),
         draw=TRUE,
         vp=viewport(x=unit(0.75, "npc"), y=unit(0.65, "npc")))

#-----------------------------------------------------------------------------
# usando a draw.colorkey(), usar fora da função gráfica ou dentro da panel()

wireframe(z~x+y, data=dd, drape=TRUE, colorkey=FALSE,
          panel=function(...){
            panel.wireframe(...)
            draw.colorkey(list(space="bottom", at=seq(250,500,25),
                               height=0.8, width=1), draw=TRUE,
                          vp=viewport(x=unit(0.5,"npc"), y=unit(0.07,"npc")))
          })

#-----------------------------------------------------------------------------
# usando duas legendas

de <- expand.grid(w=gl(3,5,la="w"), z=gl(4,3,la="z"))
de$x <- with(de, rnorm(w, as.numeric(w), 0.5))
de$y <- with(de, rnorm(z, as.numeric(z), 0.5))
pch <- c(1,2,5,7); col=1:3

xy <- xyplot(y~x, data=de, groups=z:w,
             pch=rep(pch, e=3), col=rep(col, 4))

print(xy, position=c(0,0,0.8,1), more=FALSE)
draw.key(list(text=list(levels(de$z)), points=list(pch=pch, col=1),
         space="top", columns=1, title="Níveis de Z", cex.title=1.1),
         draw=TRUE, vp=viewport(x=unit(0.85, "npc"), y=unit(0.6, "npc")))
draw.key(list(text=list(levels(de$w)), points=list(pch=15, col=col),
         space="top", columns=1, title="Níveis de W", cex.title=1.1),
         draw=TRUE, vp=viewport(x=unit(0.85, "npc"), y=unit(0.4, "npc")))

#-----------------------------------------------------------------------------
About these ads
  1. Oswaldo
    07/09/2012 às 16:19

    Muito obrigado pelo código!
    Você sabe como especificar o disposição dos paneis, por exemplo, no seu gráfico ficaram os três paneis numa única fila (não em duas filas e duas colunas).
    Grato.

    • Oswaldo
      07/09/2012 às 16:30

      Desculpa, já vi que é com “layout”.

  1. No trackbacks yet.

Deixe um comentário

Preencha os seus dados abaixo ou clique em um ícone para log in:

Logotipo do WordPress.com

Você está comentando utilizando sua conta WordPress.com. Sair / Alterar )

Imagem do Twitter

Você está comentando utilizando sua conta Twitter. Sair / Alterar )

Foto do Facebook

Você está comentando utilizando sua conta Facebook. Sair / Alterar )

Foto do Google+

Você está comentando utilizando sua conta Google+. Sair / Alterar )

Conectando a %s

Seguir

Obtenha todo post novo entregue na sua caixa de entrada.

Junte-se a 52 outros seguidores

%d blogueiros gostam disto: