Posso ricreare questo grafico a punti di coordinate polari in grafico?

Question

Sto avendo un po 'di difficoltà a capire come ricreare il seguente grafico di un grafico spider (o radar), usando la trama. In realtà, non riesco nemmeno a ricrearlo nelle versioni più recenti di ggplot2 perché ci sono state interruzioni da 1.0.1.

Ecco un esempio grafico:

Ecco la funzione originaria che ha costruito:

http://pcwww.liv.ac.uk/~william/Geodemographic%20Classifiability/func%20CreateRadialPlot.r

Ecco un esempio di come la funzione originale ha funzionato:

http://rstudio-pubs-static.s3.amazonaws.com/5795_e6e6411731bb4f1b9cc7eb49499c2082.html

.210

Ecco alcuni dati non così dummy:

d <- structure(list(Year = rep(c("2015","2016"),each=24), 
        Response = structure(rep(1L:24L,2), 
             .Label = c("Trustworthy", "Supportive", "Leading", 
                "Strong", "Dependable", "Consultative", 
                "Knowledgeable", "Sensible", 
                "Intelligent", "Consistent", "Stable", 
                "Innovative", "Aggressive", 
                "Conservative", "Visionary", 
                "Arrogant", "Professional", 
                "Responsive", "Confident", "Accessible", 
                "Timely", "Focused", "Niche", "None"), 
             class = "factor"), 
        Proportion = c(0.54, 0.48, 0.33, 0.35, 0.47, 0.3, 0.43, 0.29, 0.36, 
            0.38, 0.45, 0.32, 0.27, 0.22, 0.26,0.95, 0.57, 0.42, 
            0.38, 0.5, 0.31, 0.31, 0.12, 0.88, 0.55, 0.55, 0.31, 
            0.4, 0.5, 0.34, 0.53, 0.3, 0.41, 0.41, 0.46, 0.34, 
            0.22, 0.17, 0.28, 0.94, 0.62, 0.46, 0.41, 0.53, 0.34, 
            0.36, 0.1, 0.84), n = rep(c(240L,258L),each=24)), 
       .Names = c("Year", "Response", "Proportion", "n"), 
       row.names = c(NA, -48L), class = c("tbl_df", "tbl", "data.frame")) 

Ecco il mio tentativo (non molto buono)

plot_ly(d, r = Proportion, t = Response, x = Response, 
     color = factor(Year), mode = "markers") %>% 
layout(margin = list(l=50,r=0,b=0,t=0,pad = 4), showlegend = TRUE) 

Ogni pensiero su come potrei essere in grado di ricreare questo utilizzando plotly?

Answer 1

Le opzioni disponibili con diagrammi polari sono ancora limitate. Non c'è, per quanto posso dire, alcun modo per aggiungere del testo a una trama polare per le etichette delle categorie attorno alla circonferenza. Né i punti di dispersione del testo, né le annotazioni e le etichette di graduazione (eccetto i quattro punti di quarto) sono compatibili con le coordinate polari in questo momento.

Quindi, dobbiamo diventare un po 'creativi.

Un tipo di sistema di coordinate polari che funziona bene è una mappa proiettata di una terra sperimentale che utilizza una proiezione azimutale. Ecco una dimostrazione di come potresti adattarti a questo problema.

In primo luogo, convertire i valori per tracciare in latitudine e longitudine centrato sul polo sud:

scale <- 10 # multiply latitudes by a factor of 10 to scale plot to good size in initial view 
d$lat <- scale*d$Proportion - 90 
d$long <- (as.numeric(d$Response)-1) * 360/24 

Trama utilizzando una proiezione azimutale equidistante

p <- plot_ly(d[c(1:24,1,25:48,25),], lat=lat, lon=long, color = factor(Year), colors=c('#F8756B','#00BDC2'), 
      type = 'scattergeo', mode = 'lines+markers', showlegend=T) %>% 
layout(geo = list(scope='world', showland=F, showcoastlines=F, showframe=F, 
      projection = list(type = 'azimuthal equidistant', rotation=list(lat=-90), scale=5)), 
      legend=list(x=0.7,y=0.85)) 

mettere un po 'di etichette su

p %<>% add_trace(type="scattergeo", mode = "text", lat=rep(scale*1.1-90,24), lon=long, 
       text=Response, showlegend=F, textfont=list(size=10)) %>% 
     add_trace(type="scattergeo", mode = "text", showlegend=F, textfont=list(size=12), 
       lat=seq(-90, -90+scale,length.out = 5), lon=rep(0,5), 
       text=c("","25%","50%","75%","100%")) 

Infine, aggiungere le linee di griglia

l1 <- list(width = 0.5, color = rgb(.5,.5,.5), dash = "3px") 
l2 <- list(width = 0.5, color = rgb(.5,.5,.5)) 
for (i in c(0.1, 0.25, 0.5, 0.75, 1)) 
    p <- add_trace(lat=rep(-90, 100)-scale*i, lon=seq(0,360, length.out=100), type='scattergeo', mode='lines', line=l1, showlegend=F, evaluate=T) 
for (i in 1:24) 
    p <- add_trace(p,lat=c(-90+scale*0.1,-90+scale), lon=rep(i*360/24,2), type='scattergeo', mode='lines', line=l2, showlegend=F, evaluate=T) 

aggiornamento per la versione 4.x plotly

Rompere cambiamenti nelle aggiornamenti significa plotly che la versione originale non funziona senza alcune modifiche per portarla fino ad oggi. qui è una versione aggiornata:

library(data.table) 
gridlines1 = data.table(lat = -90 + scale*(c(0.1, 0.25, 0.5, 0.75, 1))) 
gridlines1 = gridlines1[, .(long = c(seq(0,360, length.out=100), NA)), by = lat] 
gridlines1[is.na(long), lat := NA] 

gridlines2 = data.table(long = seq(0,360, length.out=25)[-1]) 
gridlines2 = gridlines2[, .(lat = c(NA, -90, -90+scale, NA)), by = long] 
gridlines2[is.na(lat), long := NA] 

text.labels = data.table(
    lat=seq(-90, -90+scale,length.out = 5), 
    long = 0, 
    text=c("","25%","50%","75%","100%")) 

p = plot_ly() %>% 
add_trace(type="scattergeo", data = d[c(1:24, 1, 25:48, 25),], 
     lat=~lat, lon=~long, 
     color = factor(d[c(1:24, 1, 25:48, 25),]$Year), 
     mode = 'lines+markers')%>% 
layout(geo = list(scope='world', showland=F, showcoastlines=F, showframe=F, 
    projection = list(type = 'azimuthal equidistant', rotation=list(lat=-90), scale=5)), 
    legend = list(x=0.7, y=0.85)) %>% 
add_trace(data = gridlines1, lat=~lat, lon=~long, 
    type='scattergeo', mode='lines', line=l1, 
    showlegend=F, inherit = F) %>% 
add_trace(data = gridlines2, lat=~lat, lon=~long, 
    type='scattergeo', mode='lines', line=l2, showlegend=F) %>% 
add_trace(data = text.labels, lat=~lat, lon=~long, 
    type="scattergeo", mode = "text", text=~text, textfont = list(size = 12), 
    showlegend=F, inherit=F) %>% 
add_trace(data = d, lat=-90+scale*1.2, lon=~long, 
    type="scattergeo", mode = "text", text=~Response, textfont = list(size = 10), 
    showlegend=F, inherit=F) 

p 

Answer 2

Per quanto posso vedere, hai già ottenuto la tua trama con ggplot2 (immagine di esempio). Se questo è vero il modo più semplice che si dovrebbe fare per aggiungere funzionalità plotly alla trama è in esecuzione ggplotly() sul vostro oggetto ggplot, come nel seguente esempio:

install.packages(c("ggplot2","plotly")) 
library(ggplot2) 
library(plotly) 

plot <- ggplot(data =mtcars, aes(x = mpg, y = cyl))+ 
geom_point() 

ggplotly (plot) 

che si tradurrà nel seguente grafico interattivo:

Answer 3

Ho fatto qualche progresso con questo, fingendo. coordinate polari, mi sembrano odiare solo:

dati:

df <- d <- structure(list(Year = c("2015", "2015", "2015", "2015", "2015", 
"2015", "2015", "2015", "2015", "2015", "2015", "2015", "2015", 
"2015", "2015", "2015", "2015", "2015", "2015", "2015", "2015", 
"2015", "2015", "2015", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016"), Response = structure(c(1L, 2L, 3L, 4L, 
5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 
19L, 20L, 21L, 22L, 23L, 24L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 
9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 
22L, 23L, 24L), .Label = c("Trustworthy", "Supportive", "Leading", 
"Strong", "Dependable", "Consultative", "Knowledgeable", "Sensible", 
"Intelligent", "Consistent", "Stable", "Innovative", "Aggressive", 
"Conservative", "Visionary", "Arrogant", "Professional", "Responsive", 
"Confident", "Accessible", "Timely", "Focused", "Niche", "None" 
), class = "factor"), Proportion = c(0.54, 0.48, 0.33, 0.35, 
0.47, 0.3, 0.43, 0.29, 0.36, 0.38, 0.45, 0.32, 0.27, 0.22, 0.26, 
0.95, 0.57, 0.42, 0.38, 0.5, 0.31, 0.31, 0.12, 0.88, 0.55, 0.55, 
0.31, 0.4, 0.5, 0.34, 0.53, 0.3, 0.41, 0.41, 0.46, 0.34, 0.22, 
0.17, 0.28, 0.94, 0.62, 0.46, 0.41, 0.53, 0.34, 0.36, 0.1, 0.84 
), n = c(240L, 240L, 240L, 240L, 240L, 240L, 240L, 240L, 240L, 
240L, 240L, 240L, 240L, 240L, 240L, 240L, 240L, 240L, 240L, 240L, 
240L, 240L, 240L, 240L, 258L, 258L, 258L, 258L, 258L, 258L, 258L, 
258L, 258L, 258L, 258L, 258L, 258L, 258L, 258L, 258L, 258L, 258L, 
258L, 258L, 258L, 258L, 258L, 258L)), .Names = c("Year", "Response", 
"Proportion", "n"), row.names = c(NA, -48L), class = c("tbl_df", 
"tbl", "data.frame")) 

Creare una mappatura circolare su un grafico a dispersione, utilizzando basi:

df$degree <- seq(0,345,15) # 24 responses, equals 15 degrees per response 
df$o <- df$Proportion * sin(df$degree * pi/180) # SOH 
df$a <- df$Proportion * cos(df$degree * pi/180) # CAH 
df$o100 <- 1 * sin(df$degree * pi/180) # Outer ring x 
df$a100 <- 1 * cos(df$degree * pi/180) # Outer ring y 
df$a75 <- 0.75 * cos(df$degree * pi/180) # 75% ring y 
df$o75 <- 0.75 * sin(df$degree * pi/180) # 75% ring x 
df$o50 <- 0.5 * sin(df$degree * pi/180) # 50% ring x 
df$a50 <- 0.5 * cos(df$degree * pi/180) # 50% ring y 

e la trama. Ho tradito qui per loro di collegarsi in ultima posizione con doppia fila trame 1 e 25 di nuovo:

p = plot_ly() 

for(i in 1:24) { 
    p <- add_trace(
    p, 
    x = c(d$o100[i],0), 
    y = c(d$a100[i],0), 
    evaluate = TRUE, 
    line = list(color = "#d3d3d3", dash = "3px"), 
    showlegend = FALSE 
    ) 
} 

p %>% 
    add_trace(data = d[c(1:48,1,25),], x = o, y = a, color = Year, 
      mode = "lines+markers", 
      hoverinfo = "text", 
      text = paste(Year, Response,round(Proportion * 100), "%")) %>% 
    add_trace(data = d, x = o100, y = a100, 
      text = Response, 
      hoverinfo = "none", 
      textposition = "top middle", mode = "lines+text", 
      line = list(color = "#d3d3d3", dash = "3px", shape = "spline"), 
      showlegend = FALSE) %>% 
    add_trace(data = d, x = o50, y = a50, mode = "lines", 
      line = list(color = "#d3d3d3", dash = "3px", shape = "spline"), 
      hoverinfo = "none", 
      showlegend = FALSE) %>% 
    add_trace(data = d, x = o75, y = a75, mode = "lines", 
      line = list(color = "#d3d3d3", dash = "3px", shape = "spline"), 
      hoverinfo = "none", 
      showlegend = FALSE) %>% 
    layout(
    autosize = FALSE, 
    hovermode = "closest",  
    autoscale = TRUE, 
    width = 800, 
    height = 800, 
    xaxis = list(range = c(-1.25,1.25), showticklabels = FALSE, zeroline = FALSE, showgrid = FALSE), 
    yaxis = list(range = c(-1.25,1.25), showticklabels = FALSE, zeroline = FALSE, showgrid = FALSE)) 

Come potete vedere, li ho con l'eccezione di che per ultimo linea di collegamento, e le righe che passano dall'origine al testo della risposta.