plotly

R语言
可视化
R语言plotly包生成交互式图表
作者

不止BI

发布于

2024年4月6日

基本功能

基本配置

代码 
library(plotly)
library(bslib)
library(tidyverse)
library(timetk)
# 重新定义一个中文，且不显示plotlylogo的函数
plot_ly <- function(...) {
  config(plotly::plot_ly(...), displaylogo = FALSE, locale = "zh-cn")
}

添加图层

代码 
p <- plot_ly(data = iris, x = ~Sepal.Length, y = ~Sepal.Width) %>%
  add_markers(type = "scatter", mode = "markers")
p

添加颜色

代码 
p <- plot_ly(data = iris, x = ~Sepal.Length, y = ~Sepal.Width) %>%
  add_markers(type = "scatter", mode = "markers", color = ~Species)
p

修改刻度

  • 整数格式：“.0f”（例如：1000）

  • 浮点数格式：“.2f”（例如：1000.00）

  • 百分比格式：“%”（例如：‘.2%’ 输出50.00%）

  • 科学计数法格式：“e”（例如：1.00e+03）

  • 日期格式：“%Y-%m-%d”（例如：2022-01-01）

代码 
p <- p %>% layout(
  xaxis = list(title = "萼片长度", tickformat = ".2f"),
  yaxis = list(title = "萼片宽度", tickformat = ",")
)
p

添加标题

代码 
p <- p %>% layout(
  title = "鸢尾花种类与萼片"
)
p

修改边距

代码 
p <- p %>% layout(
  margin = 0
)
p

自定义工具提示

自定义工具提示主要用到以下几个参数：

  1. text：用于指定工具提示的内容。可以是一个字符向量，每个元素对应一个数据点的工具提示内容。也可以使用\~\~来引用数据框中的列，例如\~\~paste("Label: ", label)。

  2. hoveron：用于指定工具提示的触发方式。默认值为”point”，表示当鼠标悬停在数据点上时触发工具提示。其他可选值包括”fill”（当鼠标悬停在填充区域上时触发）和”all”（同时触发点和填充区域）。

  3. hoverlabel：用于设置工具提示的样式。可以包括以下参数：

    • bgcolor：工具提示的背景颜色。

    • font：工具提示的字体样式，可以包括size（字体大小）、family（字体类型）、color（字体颜色）等。

    • bordercolor：工具提示的边框颜色。

    • borderwidth：工具提示的边框宽度。

    • namelength：工具提示中显示的变量名的最大长度。

代码 
p <- plot_ly(
  x = c(1, 2, 3),
  y = c(1, 2, 1),
  fill = "toself",
  mode = "markers+lines",
  hoverinfo = "text"
)

subplot(
  add_trace(p, text = "triangle", hoveron = "fills"),
  add_trace(p, text = paste0("point", 1:3), hoveron = "points")
)
代码 
library(tibble)
library(forcats)

tooltip_data <- tibble(
  x = " ",
  y = 1,
  categories = as_factor(c(
    "Glyphs", "HTML tags", "Unicode",
    "HTML entities", "A combination"
  )),
  text = c(
    "<U+0001F44B> glyphs <U+0CA0>_<U+0CA0>",
    "Hello <span style='color:red'><sup>1</sup><U+2044><sub>2</sub></span>
    fraction",
    "\U0001f44b unicode \U00AE \U00B6 \U00BF",
    "&mu; &plusmn; &amp; &lt; &gt; &nbsp; &times; &plusmn; &deg;",
    paste("<b>Wow</b> <i>much</i> options")
  )
)

plot_ly(tooltip_data, hoverinfo = "text") %>%
  add_bars(
    x = ~x,
    y = ~y,
    color = ~ fct_rev(categories),
    text = ~text
  ) %>%
  layout(
    barmode = "stack",
    hovermode = "x", hoverlabel = list(bgcolor = "white", font = list(size = 16))
  )

ggplot2转plotly

使用ggplotly可以直接将ggplot2图表转为plotly图表

代码 
pm <- GGally::ggpairs(iris, aes(color = Species))
ggplotly(pm)

常用图表

散点图

代码 
plot_ly(data = iris, x = ~Sepal.Length, y = ~Sepal.Width, color = ~Species) %>%
  add_trace(type = "scatter", mode = "markers") %>%
  layout(
    xaxis = list(title = "萼片长度", tickformat = ","),
    yaxis = list(title = "萼片宽度", tickformat = ","),
    title = "鸢尾花种类与萼片",
    margin = 0
  )

哑铃图

代码 
library(gapminder)
gapminder %>%
  group_by(year, continent) %>%
  summarise(pop = mean(pop)) %>%
  ungroup() %>%
  mutate(year = str_c(year, "年")) %>%
  filter(year %in% c("1952年", "2007年")) %>%
  pivot_wider(names_from = year, values_from = pop) %>%
  plot_ly() %>%
  add_segments(
    x = ~`1952年`,
    y = ~continent,
    xend = ~`2007年`,
    yend = ~continent,
    color = I("gray"),
    showlegend = FALSE
  ) %>%
  add_markers(
    x = ~`1952年`,
    y = ~continent,
    color = I("#01B8AA"),
    name = "1952年"
  ) %>%
  add_markers(
    x = ~`2007年`,
    y = ~continent,
    color = I("#FD625E"),
    name = "2007年"
  ) %>%
  layout(
    xaxis = list(title = "1952年 vs 2007年 各州人口变化", tickformat = ",.0f"),
    yaxis = list(title = "洲")
  )

折线图

代码 
p <- economics %>%
  plot_ly(x = ~date, y = ~ unemploy / pop) %>%
  add_lines() %>%
  mutate(rate = unemploy / pop) %>%
  filter(rate == max(rate)) %>%
  rangeslider()
layout(p,
  annotations = list(x = ~date, y = ~rate, text = "峰值"),
  yaxis = list(tickformat = ".2%")
)

拟合线

代码 
plot_ly(
  economics,
  type = "scatter",
  x = ~date,
  y = ~uempmed,
  name = "失业人数",
  mode = "markers+lines",
  marker = list(color = "steelblue"),
  line = list(color = "steelblue", dash = "dashed")
) %>%
  add_trace(
    x = ~date,
    y = ~ fitted(loess(uempmed ~ as.numeric(date))),
    name = "拟合曲线",
    mode = "markers+lines",
    marker = list(color = "orange"),
    line = list(color = "orange", dash = "dashed")
  ) %>%
  layout(
    title = "失业时间",
    xaxis = list(title = "日期", showgrid = F),
    yaxis = list(title = "失业人数）"),
    margin = list(l = 10, r = 10, autoexpand = T),
    legend = list(
      x = 0,
      y = 1,
      orientation = "v",
      title = list(text = "")
    )
  )

帕累托图

代码 
dat <- tibble(
  category = c("A", "B", "C", "D", "E"),
  value = c(50, 30, 20, 15, 5)
) %>%
  arrange(desc(value)) %>%
  mutate(cumpercent = cumsum(value) / sum(value))

plot_ly(data = dat) %>%
  add_bars(
    x = ~category,
    y = ~value,
    showlegend = F,
    color = I("gray60"),
    name = "数量"
  ) %>%
  add_lines(
    x = ~category,
    y = ~cumpercent,
    yaxis = "y2",
    showlegend = F,
    color = I("gray40"),
    name = "累计占比"
  ) %>%
  layout(
    yaxis2 = list(
      tickfont = list(color = "black"),
      overlaying = "y",
      tickformat = ".1%",
      side = "right",
      title = "累积百分比（%）",
      showgrid = F,
      automargin = TRUE
    ),
    xaxis = list(
      title = "分类",
      showgrid = F,
      showline = F
    ),
    yaxis = list(
      title = "数量",
      showgrid = F,
      showline = F
    )
  )

折线卡

代码 
data <- data.frame(
  x = tk_make_timeseries(start_date = "2024-01-01", end_date = "2024-01-31"),
  y = runif(31, 50, 100)
)

p <- data %>%
  plot_ly(
    x = ~x,
    y = ~y
  ) %>%
  add_lines(
    color = I("#00b280"),
    fill = "tozeroy",
    span = I(1),
    alpha = 0.2
  ) %>%
  layout(
    xaxis = list(
      tickformat = "%Y-%m-%d",
      visible = FALSE,
      showgrid = FALSE,
      title = ""
    ),
    yaxis = list(
      visible = FALSE,
      showgrid = FALSE,
      title = ""
    ),
    hovermode = "x",
    margin = list(
      t = 0,
      r = 0,
      l = 0,
      b = 0
    ),
    # font = list(color = color),
    paper_bgcolor = "transparent",
    plot_bgcolor = "transparent"
  ) %>%
  config(displayModeBar = FALSE)
card(p, full_screen = T)

柱状图

代码 
mtcars %>%
  plot_ly(x = ~ factor(vs)) %>%
  add_histogram()

箱线图

代码 
bslib::card(
  iris %>%
    plot_ly(
      x = ~Species,
      y = ~Sepal.Length
    ) %>%
    add_boxplot() %>%
    layout(yaxis = list(title = "")),
  full_screen = TRUE
)

漏斗图

代码 
dat <- data.frame(
  event = c("浏览", "下载", "下单", "结算"),
  value = c(80, 60, 50, 10)
) %>%
  transform(percent = value / cumsum(value))

plot_ly(data = dat) %>%
  add_trace(
    type = "funnel",
    y = ~event,
    x = ~value,
    marker = list(color = RColorBrewer::brewer.pal(n = 4, name = "Pastel2")),
    text = ~ paste0(value, "<br>", scales::percent(percent)),
    textposition = "auto",
    textinfo = "value+percent previous",
    hoverinfo = "text"
  ) %>%
  plotly::layout(yaxis = list(categoryarray = ~event, title = ""))

雷达图

代码 
plot_ly(type = "scatterpolar", mode = "markers", fill = "toself") %>%
  add_trace(
    r = runif(n = 6, min = 0, max = 100),
    color = I("lightblue"),
    theta = LETTERS[1:6],
    name = "类型1"
  ) %>%
  add_trace(
    r = runif(n = 6, min = 0, max = 100),
    color = I("pink"),
    theta = LETTERS[1:6],
    name = "类型2"
  ) %>%
  layout(polar = list(radialaxis = list(
    visible = T, range = c(0, 100)
  )))

旭日图

代码 
library(dplyr)
library(plotme)
starwars_count <- count(starwars, species, eye_color, name)

count_to_sunburst(starwars_count)
代码 
count_to_sunburst(starwars_count, fill_by_n = TRUE)

树图

代码 
count_to_treemap(starwars_count, sort_by_n = TRUE)

播放轴

代码 
library(plotly)
library(gapminder)
plot_ly(
  gapminder,
  x = ~gdpPercap,
  y = ~lifeExp,
  frame = ~year,
  color = ~continent,
  sizes = c(10, 1000)
) %>%
  add_trace(
    type = "scatter",
    mode = "markers",
    size = ~pop
  ) %>%
  animation_button(label = "播放")

组合图

subplot将多个ployly图表合并为一个

代码 
panel <- . %>%
  plot_ly(x = ~date, y = ~value) %>%
  add_lines() %>%
  add_annotations(
    text = ~ unique(variable),
    x = 0.5,
    y = 1,
    yref = "paper",
    xref = "paper",
    yanchor = "bottom",
    showarrow = FALSE,
    font = list(size = 15)
  ) %>%
  layout(
    showlegend = FALSE,
    shapes = list(
      type = "rect",
      x0 = 0,
      x1 = 1,
      xref = "paper",
      y0 = 0,
      y1 = 16,
      yanchor = 1,
      yref = "paper",
      ysizemode = "pixel",
      fillcolor = toRGB("gray80"),
      line = list(color = "transparent")
    )
  )

economics_long %>%
  group_by(variable) %>%
  do(p = panel(.)) %>%
  subplot(nrows = NROW(.), shareX = TRUE)

双轴图

代码 
p <- economics %>%
  mutate(year = year(date)) %>%
  group_by(year) %>%
  summarise(pop = mean(pop), unemploy = mean(unemploy)) %>%
  mutate(unemploy_rate = unemploy / pop) %>%
  plot_ly() %>%
  add_bars(
    x = ~year, y = ~pop,
    color = I("steelblue"),
    name = "人口",
    text = ~ paste0(
      "年份：", year, "<br>",
      "人口：", format(pop, big.mark = ","), "<br>",
      "失业人口：", format(unemploy, big.mark = ","), "<br>",
      "失业率：", scales::percent(unemploy_rate, accuracy = 0.01), "<br>"
    ),
    hoverinfo = "text"
  ) %>%
  add_lines(
    x = ~year, y ~ unemploy_rate,
    name = "失业率", yaxis = "y2",
    text = ~ paste("失业率：", scales::percent(unemploy_rate, accuracy = 0.01), "<br>"),
    hoverinfo = "text",
    line = list(shape = "spline", width = 2, dash = "line")
  ) %>%
  layout(
    title = "历年人口与失业率",
    yaxis2 = list(
      tickfont = list(color = "black"),
      overlaying = "y",
      side = "right",
      title = "失业率（%）",
      tickformat = ".1%",
      showgrid = F,
      automargin = TRUE
    ),
    xaxis = list(title = "日期", showgrid = F, showline = F),
    yaxis = list(title = " ", showgrid = F, showline = F),
    margin = list(l = 10, r = 10, autoexpand = T),
    legend = list(
      x = 0, y = 1, orientation = "h",
      title = list(text = " ")
    )
  )
p
htmlwidgets

https://www.htmlwidgets.org是一个网站，收集了所有的R包的交互式组件。这些组件可以让用户在R语言中创建交互式图表、地图、表格和其他可视化元素。这些组件可以通过HTML和JavaScript嵌入到网页中，使得用户可以在网页上与数据进行交互和探索

回到顶部