【问题标题】：Can I recreate this polar coordinate spider chart in plotly?我可以在情节中重新创建这个极坐标蜘蛛图吗？
【发布时间】：2017-09-09 10:25:44
【问题描述】：

我在弄清楚如何使用 plotly 重新创建蜘蛛（或雷达）图的以下图形时遇到了一些困难。实际上，我什至无法在最新版本的 ggplot2 中重新创建它，因为自 1.0.1 以来发生了重大变化。

这是一个示例图形：

这是构建它的原始函数：

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

以下是原始函数如何工作的示例：

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

这里有一些不那么虚拟的数据：

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

这是我的尝试（不是很好）

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)

关于如何使用 plotly 重新创建它有什么想法吗？

【问题讨论】：

我很想知道为什么最近的ggplot2 版本会破坏您现有的代码。或者，反过来说，你为什么要求 plotly 解决方案而不是修复现有的 ggplot2 代码？
@UweBlock 它基于我不太了解的代码，这可能需要大量时间来调试和修复。我第一次尝试 plotly 给了我一个非常接近的解决方案。所以我想有更多经验的人会看到这个情节，也许知道怎么做。我已经包含了该功能以及如何在上述问题的更新中使用它的示例。欢迎您尝试修复 ggplot 代码。
您是否尝试将 mode="markers" 替换为 mode="lines"？
有一种简单的方法可以使用 ggplotly(yourplot) plot.ly/ggplot2/getting-started 将 ggplot2 绘图转换为 plotly 。但是，我无法使它与这种情节一起使用。这是您的数据ggplot(d, aes(y = Proportion, x = Response, group = factor(Year), colour = factor(Year))) + coord_polar() + geom_point() + geom_path() 的静态ggplot2 图
@MLavoie 是的，但是它的排列方式有问题，我不知道如何将每个属性的“xaxis”标签放在圆圈周围。

标签： r plotly

【解决方案1】：

极坐标图的可用选项仍然有限。据我所知，没有任何方法可以将文本添加到圆周上的类别标签的极坐标图中。目前，无论是文本散点、注释还是刻度标签（四个四分之一点除外）都与极坐标兼容。

所以，我们需要一点创意。

一种运行良好的极坐标系是使用方位角投影的球形地球投影图。下面是一个演示，说明您可以如何适应这个问题。

首先，将要绘制的值转换为以南极为中心的纬度和经度：

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

使用方位角等距投影进行绘图

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

贴一些标签

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

最后，添加网格线

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)

plotly 4.x 版更新

更新中的重大更改意味着如果不进行一些修改以使其保持最新状态，原始版本将不再有效。这是一个更新的版本：

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

【讨论】：

这是一个很好的方法。唯一缺少的是图例，这是演示的关键部分。
静态图形的效果很好。但是您不能缩放或移动图形，因为它采用地图投影的形状（就像看行星一样）
缩放应该可以工作，但平移会使行星旋转。问题中并没有真正指定这将是一个要求 - 由于您尝试复制的 ggplot 版本不会缩放和平移，因此当然不清楚这些功能是否是您所追求的。跨度>
非常接近我想要的。我喜欢这种方法，但是是的，我当然想使用 plotly ，因为它是交互式元素。虽然我在这里只选择了两组，但实际的用例是比较一个行业或类似性质的东西。
好的，让这种方法适应这些要求并不难。只需将这些点投影到极点附近的一个小区域，而不是整个地球上，以避免任何球面（非笛卡尔）扭曲。我已经更新以展示如何。

【解决方案2】：

通过伪装，我在这方面取得了一些进展。极坐标，似乎只是讨厌我：

数据：

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

使用基础知识在散点图上创建圆形映射：

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

还有情节。我在这里作弊，通过再次绘制第 1 行和第 25 行来让它们连接到最后一个位置：

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

~~如你所见，除了~~最后一条连接线，以及~~从原点传递到响应文本的线之外，我已经得到了它。~~

【讨论】：

这太棒了！你有绘图图的链接吗？

【解决方案3】：

据我所知，您已经使用 ggplot2 获得了您的情节（示例图片）。如果这是真的，你应该做的最简单的想法是在你的情节中添加情节功能是在你的 ggplot 对象上运行ggplotly()，如下例所示：

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

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

ggplotly (plot)

这将导致以下交互式情节：

【讨论】：

它并没有真正回答这个问题。
是的，我认为是因为我们应该更好地明确问题，正如@Uwe block所解释的那样
是的，这很容易，只是对 ggplot2 v2+ 的更新破坏了我用来生成绘图的代码。如果您查看我对问题所做的更新，您会发现原始情节的代码并不像情节上看起来那么简单。