Can I recreate this polar coordinate spider chart in plotly?

后端 未结 3 1326
自闭症患者
自闭症患者 2021-02-04 06:18

I\'m having a bit of difficulty figuring out how to recreate the following graphic of a spider (or radar) chart, using plotly. Actually, I can\'t even recreate it in the most re

相关标签:
3条回答
  • 2021-02-04 06:42

    The options available with polar plots are still limited. There is not, so far as I can tell, any way to add text to a polar plot for the category labels around the circumference. Neither text scatter points, nor annotations nor tick labels (except at the four quarter points) are compatible with polar coordinates in plotly at the moment.

    So, we need to get a little creative.

    One type of polar coordinate system that does work nicely is a projected map of a sperical earth using an azimuthal projection. Here is a demonstration of how you might adapt that to this problem.

    First, convert the values to plot into latitude and longitudes centred on the South pole:

    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
    

    Plot using an azimuthal equidistant projection

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

    Put some labels on

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

    Finally, add grid lines

    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)
    

    Update for plotly version 4.x

    Breaking changes in the updates to plotly mean that the original version no longer works without a few modifications to bring it up to date. here is an updated version:

    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
    
    0 讨论(0)
  • 2021-02-04 06:45

    As far as I can see you have already obtained your plot with ggplot2 (example picture ). If this is true the easiest think you should do to add plotly functionalities to your plot is running ggplotly() on your ggplot object , like within the example below:

    install.packages(c("ggplot2","plotly"))
    library(ggplot2)
    library(plotly)
    
    plot <- ggplot(data =mtcars, aes(x =  mpg, y = cyl))+
     geom_point()
    
    ggplotly (plot)
    

    which will result into the following interactive plot:

    0 讨论(0)
  • 2021-02-04 06:51

    I've made some progress with this, by faking it. Polar coords, seem to just hate me:

    data:

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

    Create a circular mapping on a scatterplot, using basics:

    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
    

    And plot. I cheated here to get them to connect in the last position by double plotting row 1 and 25 again:

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

    As you can see, I've got it with the exception of that last connecting line, and the lines that pass from the origin to the text of the response.

    0 讨论(0)
提交回复
热议问题