Wie zeichnet man ein Messgerät-Diagramm in R?

Question

Wie kann ich das folgende Diagramm in R zeichnen?

Rot = 30
Gelb = 40
Grün = 30 

Nadel bei 52.

Answer 1

Also hier ist eine vollständige ggplot Lösung.

Hinweis: Bearbeitet aus dem Originalpost, um numerische Indikatoren und Beschriftungen an den Messskalen hinzuzufügen, was anscheinend das ist, was der OP in seinem Kommentar fragt. Wenn kein Indikator erforderlich ist, entfernen Sie die annotate(...) Zeile. Wenn keine Beschriftungen erforderlich sind, entfernen Sie die geom_text(...) Zeile.

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))

## mehrere Messgeräte
library(gridExtra)
grid.newpage()
grid.draw(arrangeGrob(gg.gauge(10),gg.gauge(20),
                      gg.gauge(52),gg.gauge(90),ncol=2))

Sie müssen wahrscheinlich den size=... Parameter an geom_text(...) und annotate(...) je nach tatsächlicher Größe Ihres Messgeräts anpassen.

Meiner Meinung nach sind die Segmentbeschriftungen eine wirklich schlechte Idee: Sie überladen das Bild und vereiteln den Zweck der Grafik (auf einen Blick anzuzeigen, ob die Metrik im "sicheren", "warnenden" oder "gefährlichen" Bereich liegt).

Answer 2

Hier ist eine sehr schnelle und einfache Implementierung mit Rastergrafiken

Bibliothek(grid)

draw.gauge<-Funktion(x, von=0, bis=100, Pausen=3, 
    Beschriftung=NULL, Achse=Wahr, Farben=c("rot","gelb","grün")) {

    wenn (Länge(Pausen)==1) {
        Pausen <- seq(0, 1, length.out=Pausen+1)
    } sonst {
        Pausen <- (Pausen-von)/(bis-von)
    }
    stopifnot(Länge(Pausen) == (Länge(Farben)+1))

    bogen<-Funktion(theta.start, theta.end, r1=1, r2=.5, col="grau", 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<-Funktion(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="grau"))
    }
    addlabel<-Funktion(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(Pausen, 2)), 1:2)
    do.call(Map, list(bogen, theta.start=bp[[1]],theta.end=bp[[2]], col=Farben))
    p<-(x-von)/(bis-von)
    wenn (!is.null(Achse)) {
            wenn(is.logisch(Achse) && Achse) {
            m <- round(Pausen*(bis-von)+von,0)
            } sonst wenn (is.funktion(Achse)) {
            m <- Achse(Pausen, von, bis)
            } sonst wenn(is.character(Achse)) {
            m <- Achse
            } sonst {
                   m <- character(0)
            }
        wenn(Länge(m)>0) addlabel(m, Pausen, 1.10)
    }
    tick(p, 1.03)
    wenn(!is.null(Beschriftung)) {
            wenn(is.logisch(Beschriftung) && Beschriftung) {
            m <- x
            } sonst wenn (is.funktion(Beschriftung)) {
            m <- Beschriftung(x)
            } sonst {
            m <- Beschriftung
            }
            addlabel(m, p, 1.15)
    }
    upViewport()
}

Diese Funktion kann verwendet werden, um eine Anzeige zu zeichnen

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

oder viele Anzeigen

grid.newpage()
pushViewport(viewport(layout=grid.layout(2,2)))
für(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()

Es ist nicht zu ausgefallen, daher sollte es einfach anpassbar sein.

Jetzt können Sie auch ein Etikett hinzufügen

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

Ich habe ein weiteres Update hinzugefügt, um das Zeichnen einer "Achse" zu ermöglichen. Sie können es auf WAHR setzen, um Standardwerte zu verwenden, oder Sie können einen Zeichenfolgenvektor übergeben, um beliebige Beschriftungen zu geben, oder Sie können eine Funktion übergeben, die die Pausen (skaliert 0-1) und die von/bis-Werte akzeptiert und einen Zeichenfolgenwert zurückgeben sollte.

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

Answer 3

Flexdashboard hat eine einfache Funktion für ein Messdiagramm. Weitere Details finden Sie unter https://rdrr.io/cran/flexdashboard/man/gauge.html

Sie können das Diagramm mit einem einfachen Aufruf wie folgt erstellen:

gauge(42, min = 0, max = 100, symbol = '%', 
gaugeSectors(success = c(80, 100), warning = c(40, 79), danger = c(0, 39)))

Answer 4

Ich habe diese Lösung im Blog von Gaston Sanchez gefunden:

library(googleVis)

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

Hier ist die spätere erstellte Funktion:

# Originalcode von Gaston Sanchez   http://www.r-bloggers.com/gauge-chart-in-r/
#
dial.plot <- function(label = "BenutzerR!", value = 78, dial.radius = 1
          , value.cex = 3, value.color = "schwarz"
          , label.cex = 3, label.color = "schwarz"
          , gage.bg.color = "weiß"
          , yellowFrom = 75, yellowTo = 90, yellow.slice.color = "#FF9900"
          , redFrom = 90, redTo = 100, red.slice.color = "#DC3912"
          , needle.color = "rot", needle.center.color = "schwarz", needle.center.cex = 1
          , dial.digets.color = "grau50"
          , heavy.border.color = "grau85", thin.border.color = "grau20", minor.ticks.color = "grau55", major.ticks.color = "grau45") {

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

  ...