New Feature: Heat Map (#30)

* initial commit for heat map

* Furnished for heat map

DESCRIPTION

@@ -7,7 +7,7 @@ Version: 0.1.5
 Date: 2016-07-27
 Author: Xiaodong Deng
 Maintainer: Xiaodong Deng <xd_deng@hotmail.com>
-Description: With this package, users can embed interactive charts to their Shiny applications. These charts will be generated by ECharts library developed by Baidu (http://echarts.baidu.com/). Current version support line charts, bar charts, pie charts, scatter plots and gauge.
+Description: With this package, users can embed interactive charts to their Shiny applications. These charts will be generated by ECharts library developed by Baidu (http://echarts.baidu.com/). Current version support line charts, bar charts, pie charts, scatter plots, gauge, word cloud, radar chart, and heat map.
 URL: https://github.com/XD-DENG/ECharts2Shiny/
 License: GPL-2
 LazyData: TRUE

R/renderCharts.R

@@ -29,6 +29,23 @@
 }
 
 
+# A function designed to help prepare data for heat map
+
+.prepare_data_for_heatmap <- function(dat){
+  n_row <- dim(dat)[1]
+  n_col <- dim(dat)[2]
+
+  temp <- c()
+  for(i in 1:n_row){
+    for(j in 1:n_col){
+      temp <- c(temp, paste("[", i, ",", j, ",", dat[i,j], "]", sep=""))
+    }
+  }
+  temp <- paste(temp, collapse = ", ")
+  temp <- paste("[", temp, "]")
+  return(temp)
+}
+
 ###########################################################################
 # Pie Chart ---------------------------------------------------------------
 ###########################################################################
@@ -807,3 +824,92 @@ renderWordcloud <- function(div_id,
     cat(to_eval)
   }
 }
+
+
+
+
+
+###########################################################################
+# Heat Map ----------------------------------------------------------------
+###########################################################################
+
+renderHeatMap <- function(div_id, data,
+                          theme = "default",
+                          show.tools = TRUE,
+                          running_in_shiny = TRUE){
+
+  data <- isolate(data)
+
+  if((is.matrix(data) == FALSE) | ((class(data[1, 1]) %in% c("numeric", "integer")) == FALSE)){
+    stop("The data input must be a matrix containing numeric or integer values")
+  }
+
+  # Check the value for theme
+  theme_placeholder <- .theme_placeholder(theme)
+
+  # Convert raw data into JSON format
+  series_data <- paste("[{type: 'heatmap',data:", .prepare_data_for_heatmap(data), ",itemStyle: {emphasis: {shadowBlur: 10,shadowColor: 'rgba(0, 0, 0, 0.5)'}}}]", sep="")
+
+  # prepare axis labels
+
+  row_names <- row.names(data)
+  col_names <- colnames(data)
+
+
+  js_statement <- paste("var ",
+                        div_id,
+                        " = echarts.init(document.getElementById('",
+                        div_id,
+                        "')",
+                        theme_placeholder,
+                        ");",
+
+                        "option_", div_id, "={tooltip:{position: 'top'}, ",
+
+                        ifelse(show.tools,
+                               "toolbox: {feature: {saveAsImage: {}}},",
+                               ""),
+
+                        "xAxis: {type: 'category',data: [",
+                        ifelse(is.null(row_names),
+                               "' '",
+                               paste(sapply(row_names,
+                                            function(x){
+                                              paste("'", x, "'", sep="")
+                                            }), collapse = ",")),
+                        "],splitArea: {show: true}},",
+
+
+                        "yAxis: {type: 'category',data: [",
+                        ifelse(is.null(col_names),
+                               "' '",
+                               paste(sapply(col_names,
+                                            function(x){
+                                              paste("'", x, "'", sep="")
+                                            }), collapse = ",")),
+                        "],splitArea: {show: true}},",
+
+                        "visualMap: {min: ", min(data), ",max: ", max(data), ",bottom: '15%', show:false},",
+
+                        "series:",
+                        series_data,
+                        "};",
+
+                        div_id,
+                        ".setOption(option_",
+                        div_id,
+                        ");",
+                        sep="")
+
+  to_eval <- paste("output$", div_id ," <- renderUI({fluidPage(tags$script(\"",
+                   js_statement,
+                   "\"))})",
+                   sep="")
+
+  if(running_in_shiny == TRUE){
+    eval(parse(text = to_eval), envir = parent.frame())
+  } else {
+    cat(to_eval)
+  }
+
+}

README.md

@@ -14,6 +14,7 @@ As an R package, *ECharts2Shiny* can help embed the interactive charts plotted b
 - Radar chart
 - Gauge
 - Word Cloud
+- Heat Map
 
 ### Contents
 - [How to Install](#how-to-install)
@@ -155,13 +156,14 @@ The ***ECharts*** JS library is under BSD license ([ECharts](https://github.com/
 
 ECharts2Shiny作为一个R包，可以帮助在Shiny应用程序中插入由[*ECharts*](https://github.com/ecomfe/echarts)库绘出的交互图形。当前支持的图形包括
 
-- 饼图（pie chart）
-- 折线图（line chart）
-- 柱形图（bar chart）
+- 饼图 （pie chart）
+- 折线图 （line chart）
+- 柱形图 （bar chart）
 - 散点图 (scatter chart)
-- 雷达图(radar chart)
-- 仪表盘（gauge）
-- 词云（word cloud）
+- 雷达图 (radar chart)
+- 仪表盘 （gauge）
+- 词云 （word cloud）
+- 热力图 (heat map)
 
 
 ###目录

examples/example-14 Heat Map/server.R

@@ -0,0 +1,20 @@
+library(shiny)
+library(ECharts2Shiny)
+
+dat_1 <- volcano
+
+dat_2 <- volcano
+row.names(dat_2) <- 1:dim(dat_2)[1]
+colnames(dat_2) <- 1:dim(dat_2)[2]
+
+shinyServer(function(input, output) {
+
+  # Call functions from ECharts2Shiny to render charts
+  renderHeatMap(div_id = "test_1",
+                 data = dat_1)
+
+  renderHeatMap(div_id = "test_2", theme = "macarons",
+                data = dat_2)
+
+  }
+)

examples/example-14 Heat Map/ui.R

@@ -0,0 +1,20 @@
+library(shiny)
+library(ECharts2Shiny)
+
+shinyUI(fluidPage(
+
+  # We HAVE TO to load the ECharts javascript library in advance
+  loadEChartsLibrary(),
+  loadEChartsTheme("macarons"),
+
+  h3("To Give A Matrix without Row Names or Column Names", align = "center"),
+  tags$div(id="test_1", style="width:100%;height:400px;"),
+  deliverChart(div_id = "test_1"),
+
+  h3("To Give A Matrix with Row Names & Column Names", align = "center"),
+  tags$div(id="test_2", style="width:100%;height:400px;"),
+  deliverChart(div_id = "test_2")
+
+  )
+)
+

man/renderHeatMap.Rd

@@ -0,0 +1,51 @@
+\name{renderHeatMap}
+\alias{renderHeatMap}
+\title{
+Render Heat Map Plotted by ECharts into Shiny Applications
+}
+\description{
+renderHeatMap() function helps render heat map charts into Shiny applications.
+}
+\usage{
+renderHeatMap(div_id, data,
+              theme = "default",
+              show.tools = TRUE,
+              running_in_shiny = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+  \item{div_id}{
+The division id users specified for this chart. The division will be specified in ui.R.
+}
+  \item{data}{
+The data input must be a matrix containing numeric or integer values. Users can choose to have or not have row names or columns names. If row names or column names are assigned to the matrix, the names will be the axis label. Otherwise, the axis label will be empty.
+}
+  \item{theme}{
+Which ECharts theme to use. Valid values include "default", "roma", "infographic", "macarons", "vintage", "shine".
+}
+  \item{show.tools}{
+If display the tool bar. The default value is TRUE.
+}
+  \item{running_in_shiny}{
+      If we're actually running this in a Shiny library, or we're simply doing testing. Default valus is "TRUE". If "FALSE", the function will print what it's supposed to evaluate.
+}
+}
+\references{
+https://github.com/ecomfe/echarts-wordcloud
+}
+\author{
+  Xiaodong DENG
+
+  (ECharts library is authored by Baidu team)
+}
+\note{
+  Users need to state the division for the chart first, with tags$div() function of Shiny packages. Please note that the division id must keep unique (duplicated division id will cause error).
+}
+
+\examples{
+# please refer to vignettes or /example folder on GitHub homepage for the practical examples
+
+renderHeatMap("test", data = volcano, running_in_shiny = FALSE)
+
+}
+