R----Shiny包介绍学习

为什么用Shiny

Shiny让数据分析师写完分析与可视化代码后，稍微再花几十分钟，就可以把分析代码工程化，将分析成果快速转化为交互式网页分享给别人。所以，如果你是一名使用R的数据分析师，选择Shiny是非常明智的，因为它不需要你有新的技能，且开发起来实在太快。它跟通常我们了解的其他框架不一样：其他框架一般都是前后端分离，后端提供json，前端根据json绘图绘表，需要若干个程序员协同开发完成。然而这种可视化的小工具往往是得不到研发资源的支持，只能本数据分析师一人操刀前后端全包。

#########################
＃一个时间序列数据可视化栗子
#########################
library(shiny)
library(shinyjs)
library(DT)
library(dplyr)
library(tidyr)
library(stringr)
library(ggplot2)
library(scales)
library(plotly)

run.sql <- function(sql, debug=FALSE) {
  if(debug==FALSE){
    df <- XXXXX # 自行定义函数，根据数据存储位置，执行SQL语句
  }
  else{
    # 测试数据
    group_id <- rep(1, nrow(economics))
    dt <- paste(as.character(economics$date), "00:00:00")
    df <- cbind(group_id, dt, economics)
  }
  return(df)
}

ui <- fluidPage(
  useShinyjs(),
  titlePanel("时间序列数据可视化工具"),
  # 第一部分：SQL命令提交界面
  div(id="download"，
      fluidRow(
        column(12,
               textOutput(outputId="download_info")
        )
      ),
      fluidRow(
        column(12,
               HTML(
                 paste(‘<textarea id="sql_cmd" rows="10", cols="180">‘,
                       "select * from xxxx limit 1000;",
                       ‘</textarea>‘)
               )
        )
      ),
      fluidRow(
        column(12,
               actionButton(inputId="refresh_button", label="加载数据", icon=icon("submit")
               )
        )
      )
  ),

  shinyjs::hidden(
    div(id="table",
        # 第二部分：SQL命令执行结果显示
        hr(),
        dataTableOutput(outputId="sql_tab"),

        # 第三部分：可视化规则设置
        hr(),
        textOutput(outputId="tab_button_message"),
        sidebarLayout(
          div(id="table_tool",
              sidebarPanel(
                selectInput(inputId="group_fields", label="绘图分组字段", choices=NULL, selected=NULL, multiple=TRUE),
                selectInput(inputId="x_field", label="设置x轴字段，必须是日期时间", choices=NULL, selected=NULL, multiple=FALSE),
                selectInput(inputId="y_line_fields", label="设置y轴线图字段", choices=NULL, selected=NULL, multiple=TRUE),
                selectInput(inputId="y_point_fields", label="设置y轴点图字段", choices=NULL, selected=NULL, multiple=TRUE),
                selectInput(inputId="group_shape_field", label="设置点图形状字段", choices=NULL, selected=NULL, multiple=FALSE),
                actionButton(inputId="tab_button", label="显示分组表格", icon=icon("submit")),
                width=3
              )
          ),
          div(id="group_content",
              mainPanel(dataTableOutput(outputId="group_tab"),
                        width=9
              )
          )
        )
        )
  ),

  # 第四部分：可视化图形
  shinyjs::hidden(
    div(id = "plot",
        hr(),
        plotlyOutput(outputId="case_viewer", height="600px")
    )
  )
  )

server <- function(input, output, session) {
  observe({
    # 检查SQL输入框
    if(is.null(input$sql_cmd) | input$sql_cmd == "") {
      shinyjs::disable("refresh_button")
    }
    else{
      shinyjs::enable("refresh_button")
    }
    # 检查可视化规则设置
    if (input$x_field == "" | (is.null(input$y_line_fields) & is.null(input$y_point_fields)) | is.null(input$group_fields)) {
      shinyjs::disable("tab_button")
    } else {
      shinyjs::enable("tab_button")
    }
  })

  # 执行SQL命令获取数据
  sql_data <- eventReactive(input$refresh_button, {
    cat(file=stderr(), "#### event log ####: refresh button clicked\n")
    shinyjs::disable("refresh_button")
    shinyjs::hide(id = "table", anim = TRUE)
    shinyjs::hide(id = "plot", anim = TRUE)
    res <- run.sql(input$sql_cmd, debug=TRUE)
    updateSelectInput(session, inputId="group_fields", choices=colnames(res))
    updateSelectInput(session, inputId="x_field", choices=colnames(res))
    updateSelectInput(session, inputId="y_line_fields", choices=colnames(res))
    updateSelectInput(session, inputId="y_point_fields", choices=colnames(res))
    updateSelectInput(session, inputId="group_shape_field", choices=c("无",colnames(res)), selected="无")
    shinyjs::enable("refresh_button")
    shinyjs::show(id = "table", anim = TRUE)
    shinyjs::hide(id = "group_content", anim = FALSE)
    return(res)
  })  

  # SQL命令执行状态
  output$download_info <- renderText({
    if(input$refresh_button == 0){
      message <- "请敲入SQL select查询语句，点击按钮提交"
    }
    else{
      message <- isolate({paste0("表格下载成功！总行数",  nrow(sql_data()), "，总列数", ncol(sql_data()), "，更新时间是", as.character(lubridate::now(), format="%Y-%m-%d %H:%M:%S"))
      })
    }
    message
  })

  # 显示SQL执行结果
  output$sql_tab <- DT::renderDataTable({
    datatable(sql_data(), filter=‘top‘, selection=‘single‘)
  })

  # 获取绘图分组结果
  group_data <- eventReactive(input$tab_button, {
    cat(file=stderr(), "#### event log ####: tab button clicked\n")
    res <- sql_data() %>%
      select(one_of(input$group_fields)) %>%
      distinct()
    shinyjs::show(id="group_content", anim=TRUE)
    return(res)
  })

  output$tab_button_message <- renderText({
    if(input$tab_button == 0) {
      message <- "请在下方左侧设置数据可视化规则；
                 点击按钮后，下方右侧将以表格显示数据分组结果；
               点击表格的一行，将在下方绘制该行所指分组数据的图形"
    }
    else {
      message <- isolate({paste0("绘图分组数",  nrow(group_data()), "，更新时间是", as.character(lubridate::now(), format="%Y-%m-%d %H:%M:%S"))
      })
    }
    message
  })

  # 显示绘图分组结果
  output$group_tab <- DT::renderDataTable({
    datatable(group_data(), filter=‘top‘, selection=‘single‘)
  })

  # 显示绘图
  observeEvent(input$group_tab_rows_selected, {
    cat(file=stderr(), paste0("#### event log ####: group table row ", input$group_tab_rows_selected, " clicked\n"))
    output$case_viewer <- renderPlotly({
      s <- input$group_tab_row_last_clicked
      cat(file=stderr(), "#### event log ####: table row", s, "clicked\n")
      p <- ggplot()
      filter_str <- isolate({str_c(group_data()[s, input$group_fields], collapse="_")}) # 使用_以配合unite方法
      target_plot_data <- sql_data() %>%
        unite_("new_var", input$group_fields, remove=FALSE) %>%
        filter(new_var==filter_str)

      if(length(input$y_line_fields) > 0) {
        target_plot_data$dt <- lubridate::ymd_hms(target_plot_data[,input$x_field], tz="UTC-8")
        line_df <- target_plot_data %>%
          tidyr::gather(col_name, thresh, one_of(input$y_line_fields)) %>%
          dplyr::mutate(thresh=as.numeric(thresh))
        p <- p + geom_line(data=line_df, aes(x=dt,y=thresh,color=col_name))
      }
      if(length(input$y_point_fields) > 0) {
        target_plot_data$dt <- lubridate::ymd_hms(target_plot_data[,input$x_field], tz="UTC-8")
        point_df <- target_plot_data %>%
          tidyr::gather(col_name, thresh, one_of(input$y_point_fields)) %>%
          dplyr::mutate(thresh=as.numeric(thresh))
        if(input$group_shape_field != "无") {
          point_df[, input$group_shape_field] <- as.factor(point_df[, input$group_shape_field])
          p <- p + geom_point(data=point_df, aes_string(x="dt",y="thresh",color="col_name", shape=input$group_shape_field))
        }
        else{
          p <- p + geom_point(data=point_df, aes(x=dt,y=thresh,color=col_name))
        }
      }
      p <- p
      ggplotly(p)
    })
    shinyjs::show("plot", anim = TRUE)
  })
}

shinyApp(ui=ui, server=server)

注：为了让用户明白工具的使用方法，代码采用shinyjs在适当的时机隐藏/显示对应的组件；在eventReactive事件驱动的计算中，需要保证至少一个依赖与该reactive的组件处于显示状态，否则无法触发计算，observeEvent不存在此问题。

转载自：R可视化：用Shiny实现类Excel数据透视图

 
 
时间： 2024-10-01 06:09:32

R----Shiny包介绍学习的相关文章

R----dplyr包介绍学习

dplyr包:plyr包的替代者,专门面对数据框,将ddplyr转变为更易用的接口 首先dplyr提供了一个符号%>%,该符号将左边的对象作为第一个参数传递到右边的函数中,这样就实现类似unix管道的编程风格,代码更易读. dplyr很好地解决了base包中的几个数据处理的痛点,具体可以参考本系列01. 首先,dplyr可以方便地抽取数据框的子集.抽取行的子集函数有filter,distinct,sample_frac,sample_n,slice,top_n.抽取列的子集函数是select,可

R----stringr包介绍学习

目录 stringr介绍 stringr安装 stringr的API介绍 1. stringr介绍 stringr包被定义为一致的.简单易用的字符串工具集.所有的函数和参数定义都具有一致性,比如,用相同的方法进行NA处理和0长度的向量处理. 字符串处理虽然不是R语言中最主要的功能,却也是必不可少的,数据清洗.可视化等的操作都会用到.对于R语言本身的base包提供的字符串基础函数,随着时间的积累,已经变得很多地方不一致,不规范的命名,不标准的参数定义,很难看一眼就上手使用.字符串处理在其他语言中都

R-RMySQL包介绍学习

参考内容: RMySQL数据库编程指南R语言使用RMySQL连接及读写Mysql数据库 RMySql包安装和加载优点问题,试着根据提示简单安装和加载可以使用,后续再查询资料解决. 3.2.1 连接数据库 dbConnect(MySQL(),host="localhost",dbname,user="",password="", ...) library(RMySql) #可能是安装RMySQL的问题,导致直接library(RMySql)提示不存

R----tidyr包介绍学习

tidyr包:reshape2的替代者,功能更纯粹 R将整洁数据定义为:每个变量的数据存储在自身的列中,每个观测值的数据存储在其自身的行中.整洁数据是进行数据再加工的基础. 考虑本系列04的例子.对于melt,tidyr用gather进行替代. 1 table1 <- gather(table2, 道路等级, 日均覆盖里程, one_of(c("高速覆盖里程", "快速路覆盖里程", "主要道路覆盖里程"))) 最后一个参数指定要gathe

R----DT包介绍学习

DT包:查看矩阵或数据框的内容 12 library(DT)datatable(iris, options = list(pageLength = 5)) DT包提供大量UI定制功能,即修改展示的HTML.CSS和js. 12345678910 m = matrix( c('<b>Bold</b>', '<em>Emphasize</em>', '<a href="#" onclick="alert(\'Hello\');

R----plotly包介绍学习

plotly包:让ggplot2的静态图片变得可交互 1234 library(plotly)p <- ggplot(data = diamonds, aes(x = cut, fill = clarity)) + geom_bar(position = "dodge")ggplotly(p) plotly支持facet,不过当facet的图形超过9个以后,legend处会出现bug.

R语言︱H2o深度学习的一些R语言实践——H2o包

R语言H2o包的几个应用案例 笔者寄语:受启发想了解H2o平台的一些R语言实现,网上已有一篇H2o的demo文件.笔者在这多贴一些案例,并且把自己实践的一些小例子贴出来. 关于H2o平台长啥样,可以看H2o的官网,关于深度学习长啥样,可以看一些教程,比如ParallelR博客之中的解析. 下面主要是贴几个案例,让大家看看. ------------------------------------------------------------ Matt︱R语言调用深度学习架构系列引文 R语言︱H

R语言caret包的学习（一）--数据预处理

caret包(Classification and Regression Training)是一系列函数的集合,它试图对创建预测模型的过程进行流程化.本系列将就数据预处理.特征选择.抽样.模型调参等进行介绍学习. 本文将就caret包中的数据预处理部分进行介绍学习.主要包括以下函数:model.matrix(),dummyVars(),nearZeroVar(),findCorrelation(),findLinearCombos(),preProcess(),classDist() 创建虚拟变

R包介绍

R语言的使用,很大程度上是借助各种各样的R包的辅助,从某种程度上讲,R包就是针对于R的插件,不同的插件满足不同的需求,截至2013年3月6日,CRAN已经收录了各类包4338个. 一. R语言包的安装 1.通过选择菜单: 程序包->安装程序包->在弹出的对话框中,选择你要安装的包,然后确定. 2.使用命令 install.packages("package_name","dir") package_name:是指定要安装的包名,请注意大小写. dir:包