为什么用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数据透视图

 
 

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

  1. R----dplyr包介绍学习

    dplyr包:plyr包的替代者,专门面对数据框,将ddplyr转变为更易用的接口 %>%来自dplyr包的管道函数,其作用是将前一步的结果直接传参给下一步的函数,从而省略了中间的赋值步骤,可以 ...

  2. R----stringr包介绍学习

    1. stringr介绍 stringr包被定义为一致的.简单易用的字符串工具集.所有的函数和参数定义都具有一致性,比如,用相同的方法进行NA处理和0长度的向量处理. 字符串处理虽然不是R语言中最主要 ...

  3. R----ggplot2包介绍学习

    分析数据要做的第一件事情,就是观察它.对于每个变量,哪些值是最常见的?值域是大是小?是否有异常观测? ggplot2图形之基本语法: ggplot2的核心理念是将绘图与数据分离,数据相关的绘图与数据无 ...

  4. R----ggplot2包介绍学习--转载

    https://www.cnblogs.com/nxld/p/6059603.html 分析数据要做的第一件事情,就是观察它.对于每个变量,哪些值是最常见的?值域是大是小?是否有异常观测? ggplo ...

  5. R-RMySQL包介绍学习

    参考内容: RMySQL数据库编程指南R语言使用RMySQL连接及读写Mysql数据库 RMySql包安装和加载优点问题,试着根据提示简单安装和加载可以使用,后续再查询资料解决. 3.2.1 连接数据 ...

  6. R----tidyr包介绍学习

    tidyr包:reshape2的替代者,功能更纯粹 tidyr包的应用 tidyr主要提供了一个类似Excel中数据透视表(pivot table)的功能;gather和spread函数将数据在长格式 ...

  7. R----data.table包介绍学习

    相比dplyr包,data.table包能够更大程度地提高数据的处理速度,这里就简单介绍一下data.tale包的使用方法. data.table:用于快速处理大数据集的哦 数据的读取 data.ta ...

  8. R----plotly包介绍学习

    plotly包:让ggplot2的静态图片变得可交互 Plotly 是个交互式可视化的第三方库,官网提供了Python,R,Matlab,JavaScript,Excel的接口,因此我们可以很方便地在 ...

  9. R----lubridata包介绍学习

    lubridate包,非常强大,能够识别各种类型的日期.字符型和时间型数据,都是格式比较特别的你数据,在处理时,比较麻烦,但是有了lubridate这个包之后,时间处理变得非常简单,这个包函数命名简单 ...

随机推荐

  1. Java关键字final、static使用总结

    Java关键字final.static使用总结   一.final        根据程序上下文环境,Java关键字final有“这是无法改变的”或者“终态的”含义,它可以修饰非抽象类.非抽象类成员方 ...

  2. IOS网络第一天 - 02SDWebImage

    **************SDWebImage加载图片 #import "HMAppsViewController.h" #import "HMApp.h" ...

  3. IOS第八天(5:UITableViewController新浪微博, 计算行高)

    在 4 的 基础上重写 以下的方法 control #pragma mark - 代理方法 /** 计算单元格行高 */ - (CGFloat)tableView:(UITableView *)tab ...

  4. Read4096

    Given API: int Read4096(char* buf); It reads data from a file and records the position so that the n ...

  5. xml案例(考生成绩管理系统)

    package itacst.dao; import org.w3c.dom.Document; import org.w3c.dom.Element; import org.w3c.dom.Node ...

  6. junit测试框架

    import junit.framework.Assert; import org.junit.After; import org.junit.Before; import org.junit.Tes ...

  7. Fail to start neutron-server

    问题: [root@localhost ~]# systemctl status neutron-server ● neutron-server.service - OpenStack Neutron ...

  8. phpcmsv9的评论分表策略

    comment_table表 comment表 comment_data_x表 我们留意到: comment_table表统计每个comment_data_x表里面有多少条记录, comment表只是 ...

  9. JBoss和Tomcat版本、及Servlet、JSP规范版本对应一览 【转】

    原文地址:http://blog.csdn.net/hills/article/details/40896357 JBoss和Tomcat版本.及Servlet.JSP规范版本对应一览 JBossAS ...

  10. libgdx actor 透明问题

    遇到一个问题,自定义的Actor在使用batch.draw时,其他Actor设置的透明影响到了这个Actor 处理方法为 在自定义Actor中 draw方法中 绘制前,加入 Color color = ...