R語言程式設計導論

林嶔 (Lin, Chin)

Lesson 15 圖形化互動App

第一節：創造互動式圖形(1)

– ui.R

library(shiny)

fluidPage(
  fluidRow(
    column(width = 4,
           plotOutput("plot1", height = 350,
                      click = "plot_click",
                      dblclick = dblclickOpts(id = "plot_dblclick"),
                      hover = hoverOpts(id = "plot_hover"),
                      brush = brushOpts(id = "plot_brush")
           )
    )
  ),
  fluidRow(
    column(width = 3,
           verbatimTextOutput("click_info")
    ),
    column(width = 3,
           verbatimTextOutput("dblclick_info")
    ),
    column(width = 3,
           verbatimTextOutput("hover_info")
    ),
    column(width = 3,
           verbatimTextOutput("brush_info")
    )
  )
)

– server.R

library(shiny)

data(cars)
dat = cars

shinyServer(function(input, output) {
  output$plot1 <- renderPlot({
    plot(dat)
  })
  
  output$click_info <- renderPrint({
    cat("input$plot_click:\n")
    str(input$plot_click)
  })
  output$hover_info <- renderPrint({
    cat("input$plot_hover:\n")
    str(input$plot_hover)
  })
  output$dblclick_info <- renderPrint({
    cat("input$plot_dblclick:\n")
    str(input$plot_dblclick)
  })
  output$brush_info <- renderPrint({
    cat("input$plot_brush:\n")
    str(input$plot_brush)
  })
  
})

第一節：創造互動式圖形(2)

– 這邊需要用到兩個新函數：reactiveValues()、observe()和observeEvent()

library(shiny)

fluidPage(
  fluidRow(
    column(width = 4,
           plotOutput("plot1", height = 400,
                      brush = brushOpts(id = "plot1_brush", resetOnNew = TRUE))
    ),
    column(width = 4,
           plotOutput("plot2", height = 400)
    ),
    column(width = 4,
           plotOutput("plot3", height = 400,
                      dblclick = "plot3_dblclick",
                      brush = brushOpts(id = "plot3_brush", resetOnNew = TRUE))
    )
  )
)
library(shiny)

data(cars)
dat = cars

shinyServer(function(input, output) {
  
  ranges1 = reactiveValues(x = NULL, y = NULL)
  
  observe({
    brush1 = input$plot1_brush
    if (!is.null(brush1)) {
      ranges1$x = c(brush1$xmin, brush1$xmax)
      ranges1$y = c(brush1$ymin, brush1$ymax)
    } else {
      ranges1$x = NULL
      ranges1$y = NULL
    }
  })
  
  output$plot1 <- renderPlot({
    plot(dat)
  })
  
  output$plot2 <- renderPlot({
    plot(dat, xlim = ranges1$x, ylim = ranges1$y)
  })
  
  ranges2 <- reactiveValues(x = NULL, y = NULL)
  
  output$plot3 <- renderPlot({
    plot(dat, xlim = ranges2$x, ylim = ranges2$y)
  })
  
  observeEvent(input$plot3_dblclick, {
    brush2 <- input$plot3_brush
    if (!is.null(brush2)) {
      ranges2$x <- c(brush2$xmin, brush2$xmax)
      ranges2$y <- c(brush2$ymin, brush2$ymax)
    } else {
      ranges2$x <- NULL
      ranges2$y <- NULL
    }
  })
  
})

練習1：手動標註系統(1)

– 我們先看看裡面的一個文字檔案，而這個檔案描述的是5張圖的人類位置在哪：

box_info = read.csv("examples/label.csv", header = TRUE, stringsAsFactors = FALSE)
box_info
##    obj_name   col_left col_right   row_bot   row_top prob img_id
## 1    person 0.60728125 0.7782344 0.8139110 0.1637471    1      1
## 2    person 0.00000000 0.0971250 0.7015925 0.6154801    1      1
## 3    person 0.50981250 0.6211250 0.8687150 0.4078505    1      2
## 4    person 0.01529687 0.2058281 0.9194159 0.3903271    1      2
## 5    person 0.79756250 0.9907812 0.9042757 0.4001636    1      2
## 6    person 0.32854688 0.6720156 0.8738333 0.2985208    1      3
## 7    person 0.88721875 0.9362500 0.7515368 0.5911255    1      4
## 8    person 0.39248437 0.4289219 0.3639394 0.2303463    1      4
## 9    person 0.47934375 0.4961250 0.6005000 0.5788542    1      5
## 10   person 0.76668750 0.7721250 0.5681875 0.5610833    1      5

練習1：手動標註系統(2)

library(jpeg)
library(imager)

Show_img = function (img, box_info = NULL, col_bbox = '#FFFFFF00', col_label = '#FF0000FF') {
  
  par(mar = rep(0, 4))
  plot(NA, xlim = c(0, 1), ylim = c(1, 0), xaxt = "n", yaxt = "n", bty = "n")
  img = (img - min(img))/(max(img) - min(img))
  img = as.raster(img)
  rasterImage(img, 0, 1, 1, 0, interpolate=FALSE)
  
  
  if (!is.null(box_info)) {
    if (nrow(box_info) > 0) {
      for (i in 1:nrow(box_info)) {
        size = max(box_info[i,3] - box_info[i,2], 0.2)
        rect(xleft = box_info[i,2], xright = box_info[i,2] + 0.06*sqrt(size)*nchar(box_info[i,1]),
             ybottom = box_info[i,5] + 0.08*sqrt(size), ytop = box_info[i,5],
             col = col_label, border = col_label, lwd = 0)
        text(x = box_info[i,2] + 0.03*sqrt(size) * nchar(box_info[i,1]),
             y = box_info[i,5] + 0.04*sqrt(size),
             labels = box_info[i,1],
             col = 'white', cex = 1.5*sqrt(size), font = 2)
        rect(xleft = box_info[i,2], xright = box_info[i,3],
             ybottom = box_info[i,4], ytop = box_info[i,5],
             col = col_bbox, border = col_label, lwd = 5*sqrt(size))
      }
    }
  }
  
}
img = readJPEG("examples/2.jpeg")
Show_img(img, box_info[box_info[,"img_id"] == 2,])

img = readJPEG("examples/3.jpeg")
Show_img(img, box_info[box_info[,"img_id"] == 3,])