R Gauge Plots
[This article was first published on SoMe Lab » r-project, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Gaston Sanchez’s post on R-Bloggers inspired me to waste a bit of time. He wanted to replicate the Google Charts widget to make gauges. I modified his code (below) in some minor ways and made a function out of it so you can alter the look and feel of your gauge. Feel free to pilfer and modify the R code…
?Download download.R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 | # # Original code by Gaston Sanchez # https://www.r-bloggers.com/gauge-chart-in-r/ # Modified by Jeff Hemsley # Somelab.net # Twitter: @JeffHemsley # 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") |
Ray-Ban Aviator
Cumpara Ochelari de Soare RayBan Aviator Ieftini si originali
Cumpara Ochelari de Soare RayBan Aviator Ieftini si originali
To leave a comment for the author, please follow the link and comment on their blog: SoMe Lab » r-project.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.