Come disegnare la tabella di gauge in R?

Question

Come posso tracciare un grafico successivo in R?

Red = 30 
    Yellow = 40 
    Green = 30 

    Needle at 52. 

Pls mi aiutano come sono nel grande bisogno.

Grazie

Answer 1

Ecco un'implementazione molto veloce e sporco con la grafica della griglia

library(grid) 

draw.gauge<-function(x, from=0, to=100, breaks=3, 
    label=NULL, axis=TRUE, cols=c("red","yellow","green")) { 

    if (length(breaks)==1) { 
     breaks <- seq(0, 1, length.out=breaks+1) 
    } else { 
     breaks <- (breaks-from)/(to-from) 
    } 
    stopifnot(length(breaks) == (length(cols)+1)) 

    arch<-function(theta.start, theta.end, r1=1, r2=.5, col="grey", n=100) { 
     t<-seq(theta.start, theta.end, length.out=n) 
     t<-(1-t)*pi 
     x<-c(r1*cos(t), r2*cos(rev(t))) 
     y<-c(r1*sin(t), r2*sin(rev(t))) 
     grid.polygon(x,y, default.units="native", gp=gpar(fill=col)) 
    } 
    tick<-function(theta, r, w=.01) { 
     t<-(1-theta)*pi 
     x<-c(r*cos(t-w), r*cos(t+w), 0) 
     y<-c(r*sin(t-w), r*sin(t+w), 0) 
     grid.polygon(x,y, default.units="native", gp=gpar(fill="grey")) 
    } 
    addlabel<-function(m, theta, r) { 
     t<-(1-theta)*pi  
     x<-r*cos(t) 
     y<-r*sin(t) 
     grid.text(m,x,y, default.units="native") 
    } 

    pushViewport(viewport(w=.8, h=.40, xscale=c(-1,1), yscale=c(0,1))) 
    bp <- split(t(embed(breaks, 2)), 1:2) 
    do.call(Map, list(arch, theta.start=bp[[1]],theta.end=bp[[2]], col=cols)) 
    p<-(x-from)/(to-from) 
    if (!is.null(axis)) { 
      if(is.logical(axis) && axis) { 
      m <- round(breaks*(to-from)+from,0) 
      } else if (is.function(axis)) { 
      m <- axis(breaks, from, to) 
      } else if(is.character(axis)) { 
      m <- axis 
      } else { 
        m <- character(0) 
      } 
     if(length(m)>0) addlabel(m, breaks, 1.10) 
    } 
    tick(p, 1.03) 
    if(!is.null(label)) { 
      if(is.logical(label) && label) { 
      m <- x 
      } else if (is.function(label)) { 
      m <- label(x) 
      } else { 
      m <- label 
      } 
      addlabel(m, p, 1.15) 
    } 
    upViewport() 
} 

Questa funzione può essere utilizzato per disegnare un indicatore

grid.newpage() 
draw.gauge(100*runif(1)) 

o più indicatori

grid.newpage() 
pushViewport(viewport(layout=grid.layout(2,2))) 
for(i in 1:4) { 
    pushViewport(viewport(layout.pos.col=(i-1) %/%2 +1, layout.pos.row=(i-1) %% 2 + 1)) 
    draw.gauge(100*runif(1)) 
    upViewport() 
} 
popViewport() 

Non è troppo elegante, quindi dovrebbe essere facile da personalizzare.

È ora possibile anche aggiungere un'etichetta

draw.gauge(75, label="75%") 

ho aggiunto un altro aggiornamento per consentire la redazione di un "asse". Puoi impostarlo su TRUE per utilizzare i valori predefiniti oppure puoi passare in un vettore di caratteri per dare le etichette desiderate oppure puoi passare in una funzione che prenderà le interruzioni (in scala 0-1) e i valori da/a e dovrebbe restituire un valore di carattere.

grid.newpage() 
draw.gauge(100*runif(1), breaks=c(0,30,70,100), axis=T) 

Answer 2

ho trovato questa soluzione dal blog di Gaston Sanchez:

library(googleVis) 

plot(gvisGauge(data.frame(Label=”UserR!”, Value=80), 
options=list(min=0, max=100, 
yellowFrom=80, yellowTo=90, 
redFrom=90, redTo=100))) 

Here is the function created later: 

# Original code by Gaston Sanchez http://www.r-bloggers.com/gauge-chart-in-r/ 
# 
dial.plot <- function(label = "UseR!", value = 78, dial.radius = 1 
      , value.cex = 3, value.color = "black" 
      , label.cex = 3, label.color = "black" 
      , gage.bg.color = "white" 
      , yellowFrom = 75, yellowTo = 90, yellow.slice.color = "#FF9900" 
      , redFrom = 90, redTo = 100, red.slice.color = "#DC3912" 
      , needle.color = "red", needle.center.color = "black", needle.center.cex = 1 
      , dial.digets.color = "grey50" 
      , heavy.border.color = "gray85", thin.border.color = "gray20", minor.ticks.color = "gray55", major.ticks.color = "gray45") { 

    whiteFrom = min(yellowFrom, redFrom) - 2 
    whiteTo = max(yellowTo, redTo) + 2 

    # function to create a circle 
    circle <- function(center=c(0,0), radius=1, npoints=100) 
    { 
    r = radius 
    tt = seq(0, 2*pi, length=npoints) 
    xx = center[1] + r * cos(tt) 
    yy = center[1] + r * sin(tt) 
    return(data.frame(x = xx, y = yy)) 
    } 

    # function to get slices 
    slice2xy <- function(t, rad) 
    { 
    t2p = -1 * t * pi + 10*pi/8 
    list(x = rad * cos(t2p), y = rad * sin(t2p)) 
    } 

    # function to get major and minor tick marks 
    ticks <- function(center=c(0,0), from=0, to=2*pi, radius=0.9, npoints=5) 
    { 
    r = radius 
    tt = seq(from, to, length=npoints) 
    xx = center[1] + r * cos(tt) 
    yy = center[1] + r * sin(tt) 
    return(data.frame(x = xx, y = yy)) 
    } 

    # external circle (this will be used for the black border) 
    border_cir = circle(c(0,0), radius=dial.radius, npoints = 100) 

    # open plot 
    plot(border_cir$x, border_cir$y, type="n", asp=1, axes=FALSE, 
     xlim=c(-1.05,1.05), ylim=c(-1.05,1.05), 
     xlab="", ylab="") 

    # gray border circle 
    external_cir = circle(c(0,0), radius=(dial.radius * 0.97), npoints = 100) 
    # initial gage background 
    polygon(external_cir$x, external_cir$y, 
      border = gage.bg.color, col = gage.bg.color, lty = NULL) 

    # add gray border 
    lines(external_cir$x, external_cir$y, col=heavy.border.color, lwd=18) 
    # add external border 
    lines(border_cir$x, border_cir$y, col=thin.border.color, lwd=2) 

    # yellow slice (this will be used for the yellow band) 
    yel_ini = (yellowFrom/100) * (12/8) 
    yel_fin = (yellowTo/100) * (12/8) 
    Syel = slice2xy(seq.int(yel_ini, yel_fin, length.out = 30), rad= (dial.radius * 0.9)) 
    polygon(c(Syel$x, 0), c(Syel$y, 0), 
      border = yellow.slice.color, col = yellow.slice.color, lty = NULL) 

    # red slice (this will be used for the red band) 
    red_ini = (redFrom/100) * (12/8) 
    red_fin = (redTo/100) * (12/8) 
    Sred = slice2xy(seq.int(red_ini, red_fin, length.out = 30), rad= (dial.radius * 0.9)) 
    polygon(c(Sred$x, 0), c(Sred$y, 0), 
      border = red.slice.color, col = red.slice.color, lty = NULL) 

    # white slice (this will be used to get the yellow and red bands) 
    white_ini = (whiteFrom/100) * (12/8) 
    white_fin = (whiteTo/100) * (12/8) 
    Swhi = slice2xy(seq.int(white_ini, white_fin, length.out = 30), rad= (dial.radius * 0.8)) 
    polygon(c(Swhi$x, 0), c(Swhi$y, 0), 
      border = gage.bg.color, col = gage.bg.color, lty = NULL) 

    # calc and plot minor ticks 
    minor.tix.out <- ticks(c(0,0), from=5*pi/4, to=-pi/4, radius=(dial.radius * 0.89), 21) 
    minor.tix.in <- ticks(c(0,0), from=5*pi/4, to=-pi/4, radius=(dial.radius * 0.85), 21) 
    arrows(x0=minor.tix.out$x, y0=minor.tix.out$y, x1=minor.tix.in$x, y1=minor.tix.in$y, 
     length=0, lwd=2.5, col=minor.ticks.color) 

    # coordinates of major ticks (will be plotted as arrows) 
    major_ticks_out = ticks(c(0,0), from=5*pi/4, to=-pi/4, radius=(dial.radius * 0.9), 5) 
    major_ticks_in = ticks(c(0,0), from=5*pi/4, to=-pi/4, radius=(dial.radius * 0.77), 5) 
    arrows(x0=major_ticks_out$x, y0=major_ticks_out$y, col=major.ticks.color, 
     x1=major_ticks_in$x, y1=major_ticks_in$y, length=0, lwd=3) 

    # calc and plot numbers at major ticks 
    dial.numbers <- ticks(c(0,0), from=5*pi/4, to=-pi/4, radius=(dial.radius * 0.70), 5) 
    dial.lables <- c("0", "25", "50", "75", "100") 
    text(dial.numbers$x, dial.numbers$y, labels=dial.lables, col=dial.digets.color, cex=.8) 


    # Add dial lables 
    text(0, (dial.radius * -0.65), value, cex=value.cex, col=value.color) 
    # add label of variable 
    text(0, (dial.radius * 0.43), label, cex=label.cex, col=label.color) 

    # add needle 
    # angle of needle pointing to the specified value 
    val = (value/100) * (12/8) 
    v = -1 * val * pi + 10*pi/8 # 10/8 becuase we are drawing on only %80 of the cir 
    # x-y coordinates of needle 
    needle.length <- dial.radius * .67 
    needle.end.x = needle.length * cos(v) 
    needle.end.y = needle.length * sin(v) 

    needle.short.length <- dial.radius * .1 
    needle.short.end.x = needle.short.length * -cos(v) 
    needle.short.end.y = needle.short.length * -sin(v) 

    needle.side.length <- dial.radius * .05 
    needle.side1.end.x = needle.side.length * cos(v - pi/2) 
    needle.side1.end.y = needle.side.length * sin(v - pi/2) 
    needle.side2.end.x = needle.side.length * cos(v + pi/2) 
    needle.side2.end.y = needle.side.length * sin(v + pi/2) 

    needle.x.points <- c(needle.end.x, needle.side1.end.x, needle.short.end.x, needle.side2.end.x) 
    needle.y.points <- c(needle.end.y, needle.side1.end.y, needle.short.end.y, needle.side2.end.y) 
    polygon(needle.x.points, needle.y.points, col=needle.color) 

    # add central blue point 
    points(0, 0, col=needle.center.color, pch=20, cex=needle.center.cex) 
    # add values 0 and 100 
} 


par(mar=c(0.2,0.2,0.2,0.2), bg="black", mfrow=c(2,2)) 

dial.plot() 
dial.plot (label = "Working", value = 25, dial.radius = 1 
     , value.cex = 3.3, value.color = "white" 
     , label.cex = 2.7, label.color = "white" 
     , gage.bg.color = "black" 
     , yellowFrom = 73, yellowTo = 95, yellow.slice.color = "gold" 
     , redFrom = 95, redTo = 100, red.slice.color = "red" 
     , needle.color = "red", needle.center.color = "white", needle.center.cex = 1 
     , dial.digets.color = "white" 
     , heavy.border.color = "white", thin.border.color = "black", minor.ticks.color = "white", major.ticks.color = "white") 


dial.plot (label = "caffeine", value = 63, dial.radius = .7 
      , value.cex = 2.3, value.color = "white" 
      , label.cex = 1.7, label.color = "white" 
      , gage.bg.color = "black" 
      , yellowFrom = 80, yellowTo = 93, yellow.slice.color = "gold" 
      , redFrom = 93, redTo = 100, red.slice.color = "red" 
      , needle.color = "red", needle.center.color = "white", needle.center.cex = 1 
      , dial.digets.color = "white" 
      , heavy.border.color = "black", thin.border.color = "lightsteelblue4", minor.ticks.color = "orange", major.ticks.color = "tan") 


dial.plot (label = "Fun", value = 83, dial.radius = .7 
      , value.cex = 2.3, value.color = "white" 
      , label.cex = 1.7, label.color = "white" 
      , gage.bg.color = "black" 
      , yellowFrom = 20, yellowTo = 75, yellow.slice.color = "olivedrab" 
      , redFrom = 75, redTo = 100, red.slice.color = "green" 
      , needle.color = "red", needle.center.color = "white", needle.center.cex = 1 
      , dial.digets.color = "white" 
      , heavy.border.color = "black", thin.border.color = "lightsteelblue4", minor.ticks.color = "orange", major.ticks.color = "tan") 

Answer 3

Quindi, ecco un ggplot soluzione completamente.

Nota: Modificato dal post originale per aggiungere indicatori numerici ed etichette alle interruzioni dell'indicatore che sembra essere quello che OP sta chiedendo nel loro commento. Se l'indicatore non è necessario, rimuovere la riga annotate(...). Se le etichette non sono necessarie, rimuovere la riga geom_text(...).

gg.gauge <- function(pos,breaks=c(0,30,70,100)) { 
    require(ggplot2) 
    get.poly <- function(a,b,r1=0.5,r2=1.0) { 
    th.start <- pi*(1-a/100) 
    th.end <- pi*(1-b/100) 
    th  <- seq(th.start,th.end,length=100) 
    x  <- c(r1*cos(th),rev(r2*cos(th))) 
    y  <- c(r1*sin(th),rev(r2*sin(th))) 
    return(data.frame(x,y)) 
    } 
    ggplot()+ 
    geom_polygon(data=get.poly(breaks[1],breaks[2]),aes(x,y),fill="red")+ 
    geom_polygon(data=get.poly(breaks[2],breaks[3]),aes(x,y),fill="gold")+ 
    geom_polygon(data=get.poly(breaks[3],breaks[4]),aes(x,y),fill="forestgreen")+ 
    geom_polygon(data=get.poly(pos-1,pos+1,0.2),aes(x,y))+ 
    geom_text(data=as.data.frame(breaks), size=5, fontface="bold", vjust=0, 
       aes(x=1.1*cos(pi*(1-breaks/100)),y=1.1*sin(pi*(1-breaks/100)),label=paste0(breaks,"%")))+ 
    annotate("text",x=0,y=0,label=pos,vjust=0,size=8,fontface="bold")+ 
    coord_fixed()+ 
    theme_bw()+ 
    theme(axis.text=element_blank(), 
      axis.title=element_blank(), 
      axis.ticks=element_blank(), 
      panel.grid=element_blank(), 
      panel.border=element_blank()) 
} 
gg.gauge(52,breaks=c(0,35,70,100)) 

## multiple guages 
library(gridExtra) 
grid.newpage() 
grid.draw(arrangeGrob(gg.gauge(10),gg.gauge(20), 
         gg.gauge(52),gg.gauge(90),ncol=2)) 

È probabile che sia necessario modificare il parametro size=... per geom_text(...) e annotate(...) a seconda della dimensione reale del vostro calibro.

IMO le etichette dei segmenti sono una pessima idea: ingombrano l'immagine e vanificano lo scopo della grafica (per indicare a colpo d'occhio se la metrica è in "sicuro", "avvertimento" o "pericolo") .