R语言Shiny App和 交互式绘图echarts4r包Advanced深探

更新

library(shiny)
ui <- fluidPage(
  fluidRow(
    column(12, actionButton("update", "Update"))
  ),
  fluidRow(
    column(12, echarts4rOutput("plot"))
  )
)

server <- function(input, output){
  data <- eventReactive(input$update, {
    Sys.sleep(1) # sleep one second to show loading
    data.frame(
      x = 1:10,
      y = rnorm(10)
    )
  })
  
  output$plot <- renderEcharts4r({
    data() |> 
      e_charts(x) |> 
      e_bar(y) |> 
      e_show_loading()
  })
}

shinyApp(ui, server)

基本应用

library(shiny)
library(echarts4r)

ui <- fluidPage(
  actionButton("add", "Add Data to y"),
  echarts4rOutput("plot"),
  verbatimTextOutput("selected")
)

server <- function(input, output, session){
  
  data <- data.frame(x = rnorm(10, 5, 3), y = rnorm(10, 50, 12), z = rnorm(10, 50, 5))
  
  react <- eventReactive(input$add, {
    set.seed(sample(1:1000, 1))
    data.frame(x = rnorm(10, 5, 2), y = rnorm(10, 50, 10))
  })
  
  output$plot <- renderEcharts4r({
    data |> 
      e_charts(x) |> 
      e_scatter(y) |>
      e_scatter(z) |> 
      e_brush(throttleDelay = 1000)
  })
  
  observeEvent(input$add, {
    echarts4rProxy("plot") |> 
      e_append1_p(0, react(), x, y)
  })
  
  output$selected <- renderPrint({
    input$plot_brush
  })
  
}

shinyApp(ui, server)

Shiny App

library(shiny)
library(echarts4r)

ui <- fluidPage(
  fluidRow(
    column(3, echarts4rBoxOutput("box1")),
    column(3, echarts4rBoxOutput("box2")),
    column(3, echarts4rBoxOutput("box3")),
    column(3, echarts4rBoxOutput("box4"))
  )
)

server <- function(input, output){
  output$box1 <- renderEcharts4rBox({
    echarts4rBox(cars, speed, dist, "Cake", type = "bar")
  })
  
  output$box2 <- renderEcharts4rBox({
    echarts4rBox(cars, speed, dist, "Pears", type = "area")
  })
  
  output$box3 <- renderEcharts4rBox({
    echarts4rBox(cars, speed, dist, "More Cakes!", type = "step")
  })
  
  output$box4 <- renderEcharts4rBox({
    echarts4rBox(cars, dist, speed, "Misc", type = "scatter", title_args = list(left = "right"))
  })
}

shinyApp(ui, server)

分类

时间线

library(echarts4r)

iris |> 
  group_by(Species) |> 
  e_charts(Sepal.Length) |> 
  e_line(Sepal.Width) |> 
  e_title("Grouped data")

library(echarts4r)

iris |> 
  group_by(Species) |> 
  e_charts(Sepal.Length, timeline = TRUE) |> 
  e_line(Sepal.Width) |> 
  e_title("Timeline")

存储栈

library(echarts4r)

df <- data.frame(
  x = LETTERS[1:10],
  a = runif(10),
  b = runif(10),
  c = runif(10),
  d = runif(10)
)

df |> 
  e_charts(x) |> 
  e_bar(a, stack = "grp") |> 
  e_bar(b, stack = "grp") |> 
  e_bar(c, stack = "grp2") |> 
  e_bar(d, stack = "grp2") 

散点图

library(echarts4r)

iris |> 
  group_by(Species) |> 
  e_charts(Sepal.Length) |> 
  e_scatter(Petal.Length, Sepal.Width)

library(echarts4r)

my_scale <- function(x){
  scales::rescale(x, to = c(5, 30))
}

iris |> 
  group_by(Species) |> 
  e_charts(Sepal.Length) |> 
  e_scatter(Petal.Length, Sepal.Width, scale = my_scale)

library(echarts4r)

iris |>  
  group_by(Species) |> 
  e_charts(Sepal.Length) |> 
  e_scatter(
    Petal.Length, 
    Sepal.Width, 
    scale = \(x) scales::rescale(x, to = c(5, 30))
  )

library(echarts4r)

iris |> 
  group_by(Species) |> 
  e_charts(Sepal.Length) |> 
  e_scatter(Petal.Length, symbol_size = 15)

library(echarts4r)
iris |> 
  group_by(Species) |> 
  e_charts(Sepal.Length) |> 
  e_scatter(Petal.Length, Sepal.Width, scale = log1p, symbol_size = 10)、

library(echarts4r)
echart <- mtcars |> 
  e_charts(mpg) |> 
  e_scatter(qsec, wt, scale = e_scale) |> 
  e_legend(show = FALSE)

echart |> 
  e_visual_map(wt, scale = e_scale)

library(echarts4r)
mtcars |> 
  e_charts(mpg) |> 
  e_scatter(qsec, wt, scale = NULL, scale_js = "function(data){ return data[3] * 3;}") |> 
  e_legend(show = FALSE) |> 
  e_visual_map(wt, scale = NULL)

library(echarts4r)
mtcars |> 
  e_charts(cyl) |> 
  e_scatter(drat, symbol_size = 4) |> 
  e_scatter(
    drat, jitter_factor = 2, symbol_size = 6,
    name = "noisy"
  )

热点图

library(echarts4r)
v <- LETTERS[1:10]
matrix <- data.frame(
  x = sample(v, 300, replace = TRUE), 
  y = sample(v, 300, replace = TRUE), 
  z = rnorm(300, 10, 1),
  stringsAsFactors = FALSE
) |> 
  dplyr::group_by(x, y) |> 
  dplyr::summarise(z = sum(z)) |> 
  dplyr::ungroup()
#> `summarise()` has grouped output by 'x'. You can override using the `.groups`
#> argument.

matrix |> 
  e_charts(x) |> 
  e_heatmap(y, z) |> 
  e_visual_map(z)

日历图

library(echarts4r)
dates <- seq.Date(as.Date("2018-01-01"), as.Date("2018-12-31"), by = "day")
values <- rnorm(length(dates), 20, 6)

year <- data.frame(date = dates, values = values)

year |> 
  e_charts(date) |> 
  e_calendar(range = "2018") |> 
  e_heatmap(values, coord_system = "calendar") |> 
  e_visual_map(max = 30)

library(echarts4r)
df <- data.frame(x = 1:10, y = seq(1, 20, by = 2))

df |> 
  e_charts(x) |> 
  e_line(y) 

library(echarts4r)
df |> 
  e_charts(x) |> 
  e_polar() |> 
  e_angle_axis() |> 
  e_radius_axis() |> 
  e_line(y, coord_system = "polar", smooth = TRUE) 

定制化坐标轴

旋转坐标轴

library(echarts4r)
USArrests |> 
  e_charts(Assault) |> 
  e_line(Murder, smooth = TRUE) |> 
  e_line(Rape, y_index = 1) |>  # add secondary axis
  e_y_axis(splitLine = list(show = FALSE)) # hide split lines on first Y axis

library(echarts4r)
data.frame(
  x = LETTERS[1:5],
  y = runif(5, 1, 15)
) |> 
  e_charts(x) |> 
  e_bar(y, name = "flipped") |> 
  e_flip_coords() # flip axis

library(echarts4r)
USArrests |> 
  tibble::rownames_to_column("State") |> 
  dplyr::mutate(
    Rape = -Rape
  ) |> 
  e_charts(State) |> 
  e_area(Murder) |>
  e_bar(Rape, name = "Sick basterd", x_index = 1) |> # second y axis 
  e_mark_line("Sick basterd", data = list(type = "average")) |> 
  e_mark_point("Murder", data = list(type = "min"))

寻找参数

library(echarts4r)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
df <- tibble(
  name = "earth",        # 1st level
  children = list(
    tibble(name = c("land", "ocean"),             # 2nd level
           children = list(
             tibble(name = c("forest", "river")),   # 3rd level 
             tibble(name = c("fish", "kelp"),
                    children = list(
                      tibble(name = c("shark", "tuna"),  # 4th level 
                             NULL  # kelp
                      ))
             )
           ))
  )
)

df |> 
  e_charts() |> 
  e_tree()

转化成半径

library(echarts4r)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
df <- tibble(
  name = "earth",        # 1st level
  children = list(
    tibble(name = c("land", "ocean"),             # 2nd level
           children = list(
             tibble(name = c("forest", "river")),   # 3rd level 
             tibble(name = c("fish", "kelp"),
                    children = list(
                      tibble(name = c("shark", "tuna"),  # 4th level 
                             NULL  # kelp
                      ))
             )
           ))
  )
)

df |> 
  e_charts() |> 
  e_tree(layout = "radial")

显示标签

library(echarts4r)
library(dplyr)
USArrests |> 
  tibble::rownames_to_column("State") |> 
  dplyr::slice(1:10) |> 
  e_charts(State) |> 
  e_area(Murder, label = list(normal = list(show = TRUE))) 

嵌套数据

library(echarts4r)
# add columns to iris
iris_dat <- iris |> 
  dplyr::mutate(
    show = TRUE, # to show the labels
    fontSize = exp(Sepal.Length) / 10, # font size will correspond to Sepal.Length
    color = sample(c("red", "black", "blue"), dplyr::n(), replace = TRUE) # assign a random color to the label
  )

iris_dat |> 
  dplyr::slice(1:10) |> # simplify the graph. 
  e_charts(Sepal.Width) |> 
  e_line(Sepal.Length) |> 
  e_add_nested("label", show, fontSize, color) |> # add our columns to "label"
  e_x_axis(min = 2.5)

烟囱

集合List

library(echarts4r)
funnel <- data.frame(
  stage = c("View", "Click", "Purchase"), 
  value = c(80, 30, 20),
  color = c("blue", "red", "green")
)

funnel |> 
  e_charts() |> 
  e_funnel(value, stage) |> 
  e_add_nested("itemStyle", color)

参考资料：
https://echarts4r.john-coene.com/articles/advanced.html