1.完善《读取非标准格式的单细胞数据》

2.新增《在Quarto中嵌入Shiny应用程序》
djhcod · Jan 13, 2024 · 6a4a120 · 6a4a120
1 parent b4d1012
commit 6a4a120
Show file tree

Hide file tree

Showing 11 changed files with 1,337 additions and 1,086 deletions.
diff --git a/counties.rdata b/counties.rdata
diff --git a/docs/quarto_foundation/quarto_shiny.html b/docs/quarto_foundation/quarto_shiny.html
diff --git a/docs/quarto_foundation/yaml_settings.html b/docs/quarto_foundation/yaml_settings.html
diff --git a/docs/search.json b/docs/search.json
diff --git a/docs/sitemap.xml b/docs/sitemap.xml
@@ -126,7 +126,7 @@
   </url>
   <url>
     <loc>https://djhcod.github.io/r-notes/quarto_foundation/yaml_settings.html</loc>
-    <lastmod>2024-01-13T09:26:21.461Z</lastmod>
+    <lastmod>2024-01-13T13:56:32.658Z</lastmod>
   </url>
   <url>
     <loc>https://djhcod.github.io/r-notes/quarto_foundation/images_settings.html</loc>
@@ -178,6 +178,6 @@
   </url>
   <url>
     <loc>https://djhcod.github.io/r-notes/quarto_foundation/quarto_shiny.html</loc>
-    <lastmod>2024-01-13T12:18:58.848Z</lastmod>
+    <lastmod>2024-01-13T13:58:39.673Z</lastmod>
   </url>
 </urlset>
diff --git a/images/截屏2023-12-24 12.24.12.png b/images/截屏2023-12-24 12.24.12.png
diff --git a/images/截屏2024-01-03 20.56.56-01.png b/images/截屏2024-01-03 20.56.56-01.png
diff --git a/images/截屏2024-01-03 20.56.56.png b/images/截屏2024-01-03 20.56.56.png
diff --git a/quarto_foundation/quarto_shiny.qmd b/quarto_foundation/quarto_shiny.qmd
@@ -6,23 +6,21 @@ filters:
 
 > 参考：[*R-shinylive app in Quarto!*](https://quarto.thecoatlessprofessor.com/r-shinylive-demo/)
 
-本节主要介绍如何在Quarto文档中嵌入Shiny交互式应用程序，而无需依赖服务器。这是一个Quarto的全新特性，感谢Barret Schloerke等人开发的[`shinylive`包](https://posit-dev.github.io/r-shinylive/index.html)让这一特性得以实现，该包的第一个[CRAN版本](https://cloud.r-project.org/web/packages/shinylive/index.html)于2023年10月11日首次发布。
-
-> For writing online books (with Quarto), I’d like to be able to demonstrate concepts and results dynamically. To some extent, we can do this with [`gganimate`](https://gganimate.com/), but it is very limiting. We’d like to use [`shiny`](https://shiny.posit.co/). At the 2023 posit conference, Joe Cheng unveiled [`shinylive-r`](https://github.com/posit-dev/shinylive), a tool to embed R and `shiny` into a webpage using WebAssembly (aka Wasm) using [`webR`](https://docs.r-wasm.org/webr/latest/).
->
-> Shinylive is a serverless version of Shiny, which enables running Shiny applications in a web browser without needing a backend server. It was first introduced for Python during Posit Conf 2022 using WebAssembly and Pyodide, and its R version during the Posit Conf 2023 using WebR (引自：[**shinylive-r**](https://github.com/RamiKrispin/shinylive-r)).
-
 ::: callout-important
-本节不会涉及`Shiny`包的教程，请在学习本节前确保已基本掌握Shiny的使用，Shiny官方提供了一个很好的[Shiny入门指南](https://shiny.posit.co/r/getstarted/shiny-basics/lesson1/index.html)，通过它可以对Shiny应用程序的开发有一个全局的了解。
+本节不涉及Shiny的教程，请在学习本节前确保已基本掌握Shiny的使用，Shiny官方提供了一个很好的[Shiny入门指南](https://shiny.posit.co/r/getstarted/shiny-basics/lesson1/index.html)，通过它可以对Shiny应用程序的开发有一个全局的了解。
 
-[![](images/截屏2024-01-13 18.28.35.png)](https://shiny.posit.co)
+![](images/截屏2024-01-13%2018.28.35.png)
 :::
 
-视频教程：
+本节主要介绍如何在Quarto文档中嵌入Shiny交互式应用程序，而无需依赖服务器。这是一个Quarto的全新特性，感谢Barret Schloerke等人开发的[`shinylive`包](https://posit-dev.github.io/r-shinylive/index.html)让这一特性得以实现。
 
-{{< video https://www.youtube.com/watch?v=6y2FnAugP8E >}}
+Shinylive是一种非服务器依赖的Shiny，它使得Shiny应用程序能够在网页浏览器中直接运行 ，而不需要依赖后台服务器。在 2022 年的Posit大会上，第一次推出了基于 WebAssembly 和 Pyodide 的 [Shinylive for Python](https://github.com/posit-dev/py-shinylive)。随后，在2023年的Posit大会上，首次推出了基于[webR](https://docs.r-wasm.org/webr/)的R版本的`shinylive`。该包的第一个[CRAN版本](https://cloud.r-project.org/web/packages/shinylive/index.html)于2023年10月11日首次发布。
 
-![Shinylive archticture, source: Joe Cheng "Running Shiny without a server"](images/shinylive-webr.png)
+![Shinylive archticture, source: Joe Cheng "Running Shiny without a server"](images/shinylive-webr.png){width="526"}
+
+`shinylive`视频教程《*Creating a Serverless R Shiny App using Quarto with R Shinylive*》：
+
+{{< video https://www.youtube.com/watch?v=6y2FnAugP8E >}}
 
 > Currently, there are three methods (or formats) to use Shinylive applications:
 >
@@ -32,6 +30,8 @@ filters:
 >
 > -   Embed Shiny app in Quarto documentation using the quarto-shinylive extension for Quarto (引自：[**shinylive-r**](https://github.com/RamiKrispin/shinylive-r))。
 
+本节我们介绍第三种方法，即在Quarto文档中通过[**quarto-shinylive extension**](https://posit-dev.github.io/r-shinylive/index.html#setup---quarto)嵌入Shiny应用程序。
+
 ## 安装`shinylive`包
 
 要首先Shiny应用程序的嵌入，需要依赖`shinylive`包，可以从CRAN直接安装该包：
@@ -120,7 +120,73 @@ shinyApp(ui, server)
 
 ### 案例一
 
-下面是一个来自[Joe’s shiny app](https://quarto.thecoatlessprofessor.com/r-shinylive-demo/R-shinylive-demo.html)的示例：
+下面是一个来自[Shiny官方入门指南](https://shiny.posit.co/r/getstarted/shiny-basics/lesson5/)中的案例：
+
+```{shinylive-r}
+#| standalone: true
+#| viewerHeight: 600
+library(shiny)
+
+# Define UI ----
+ui <- fluidPage(
+
+  # App title ----
+  titlePanel("Hello World!"),
+
+  # Sidebar layout with input and output definitions ----
+  sidebarLayout(
+
+    # Sidebar panel for inputs ----
+    sidebarPanel(
+
+      # Input: Slider for the number of bins ----
+      sliderInput(inputId = "bins",
+                  label = "Number of bins:",
+                  min = 5,
+                  max = 50,
+                  value = 30)
+
+    ),
+
+    # Main panel for displaying outputs ----
+    mainPanel(
+
+      # Output: Histogram ----
+      plotOutput(outputId = "distPlot")
+
+    )
+  )
+)
+
+# Define server logic required to draw a histogram ----
+server <- function(input, output) {
+
+  # Histogram of the Old Faithful Geyser Data ----
+  # with requested number of bins
+  # This expression that generates a histogram is wrapped in a call
+  # to renderPlot to indicate that:
+  #
+  # 1. It is "reactive" and therefore should be automatically
+  #    re-executed when inputs (input$bins) change
+  # 2. Its output type is a plot
+  output$distPlot <- renderPlot({
+
+    x    <- faithful$waiting
+    bins <- seq(min(x), max(x), length.out = input$bins + 1)
+
+    hist(x, breaks = bins, col = "#007bc2", border = "orange",
+         xlab = "Waiting time to next eruption (in mins)",
+         main = "Histogram of waiting times")
+
+    })
+
+}
+
+# Run the app ----
+shinyApp(ui = ui, server = server)
+```
+
+代码：
 
 ```` md
 ```{shinylive-r}
@@ -181,80 +247,115 @@ shinyApp(ui = ui, server = server)
 ```
 ````
 
-```{shinylive-r}
-#| standalone: true
-#| viewerHeight: 600
-library(shiny)
-
-# Define UI ----
-ui <- fluidPage(
-
-  # App title ----
-  titlePanel("Hello World!"),
+### 案例二
 
-  # Sidebar layout with input and output definitions ----
-  sidebarLayout(
+来自：[***shinylive-in-book-test***](https://github.com/topepo/shinylive-in-book-test)
 
-    # Sidebar panel for inputs ----
-    sidebarPanel(
+```{shinylive-r}
+#| standalone: true
+#| viewerHeight: 500
+#| label: fig-shiny-spline
 
-      # Input: Slider for the number of bins ----
-      sliderInput(inputId = "bins",
-                  label = "Number of bins:",
-                  min = 5,
-                  max = 50,
-                  value = 30)
+library(ggplot2)
+library(htmltools)
 
+ui <- fluidPage(
+  
+  fluidRow(
+    column(8, 
+           sliderInput(
+             "deg_free", 
+             label = "Spline degrees of freedom:",
+             min = 3L, value = 3L, max = 8L, step = 1L
+           )
     ),
-
-    # Main panel for displaying outputs ----
-    mainPanel(
-
-      # Output: Histogram ----
-      plotOutput(outputId = "distPlot")
-
-    )
+    
+    imageOutput("spline_contours", height = "400px")
   )
 )
 
-# Define server logic required to draw a histogram ----
-server <- function(input, output) {
-
-  # Histogram of the Old Faithful Geyser Data ----
-  # with requested number of bins
-  # This expression that generates a histogram is wrapped in a call
-  # to renderPlot to indicate that:
-  #
-  # 1. It is "reactive" and therefore should be automatically
-  #    re-executed when inputs (input$bins) change
-  # 2. Its output type is a plot
-  output$distPlot <- renderPlot({
-
-    x    <- faithful$waiting
-    bins <- seq(min(x), max(x), length.out = input$bins + 1)
-
-    hist(x, breaks = bins, col = "#007bc2", border = "orange",
-         xlab = "Waiting time to next eruption (in mins)",
-         main = "Histogram of waiting times")
-
-    })
 
+server <- function(input, output, session) {
+  
+  # ------------------------------------------------------------------------
+  # Input data from remote locations on GitHub
+  
+  pred_path <-
+    paste(                                                  
+      "https://raw.githubusercontent.com",                  
+      "topepo", "shinylive-in-book-test",                   
+      "main", "predicted_values.RData",                     
+      sep = "/"                                             
+    )                                                       
+  data_path <-                                              
+    paste(                                                  
+      "https://raw.githubusercontent.com",                  
+      "topepo", "shinylive-in-book-test",                   
+      "main", "sim_val.RData",                              
+      sep = "/"                                             
+    )                                                       
+  
+  rdata_file <- tempfile()
+  download.file(pred_path, destfile = rdata_file)           
+  load(rdata_file)                                          
+  download.file(data_path, destfile = rdata_file)           
+  load(rdata_file)                                          
+  
+  # Set some ranges for the plot
+  rngs <- list(A = c(-3.3, 3.3), B = c(-4.4, 4.4))
+  
+  output$spline_contours <-
+    renderImage({
+      
+      preds <- predicted_values[predicted_values$deg_free == input$deg_free,]
+      
+      p <-
+        ggplot(preds, aes(A, B)) +
+        # Plot the validation set
+        geom_point(
+          data = sim_val, 
+          aes(col = class, pch = class), 
+          alpha = 1 / 2,
+          cex = 3
+        ) +
+        # Show the class boundary
+        geom_contour(
+          aes(z = .pred_one),
+          breaks = 1 / 2,
+          linewidth = 3 / 2,
+          col = "black"
+        ) +
+        # Formatting
+        lims(x = rngs$A, y = rngs$B) +
+        theme_bw() + 
+        theme(legend.position = "top")
+      
+      file <-
+        htmltools::capturePlot(
+          print(p), 
+          tempfile(fileext = ".svg"),
+          grDevices::svg,
+          width = 4, 
+          height = 4
+        )
+      list(src = file)
+    }, 
+    deleteFile = TRUE)
 }
 
-# Run the app ----
 shinyApp(ui = ui, server = server)
 ```
 
-### 案例二
+代码：
 
+```` md
 ```{shinylive-r}
 #| standalone: true
 #| viewerHeight: 500
 #| label: fig-shiny-spline
 
-webr::install("ggplot2")
-webr::install("htmltools")   #<- only needed to use SVG images 
-
+library(ggplot2)
+library(htmltools)
 
 ui <- fluidPage(
 
@@ -342,3 +443,13 @@ server <- function(input, output, session) {
 
 shinyApp(ui = ui, server = server)
 ```
+````
+
+::: {.callout-note collapse="true" icon="false"}
+## Session Info
+
+```{r}
+#| echo: false
+sessionInfo()
+```
+:::