Skip to content
This repository has been archived by the owner on Nov 16, 2023. It is now read-only.

Commit

Permalink
Merge branch 'develop'
Browse files Browse the repository at this point in the history 
* develop:
  fixed palette bug and allowed radius to accept an input vector
  added heatmap and moved params
  • Loading branch information
@nachocab
nachocab committed Aug 27, 2013
2 parents 4dc5f7c + 0c8469a commit 669e3d1
Show file tree
Hide file tree
Showing 14 changed files with 579 additions and 24 deletions.
2 changes: 0 additions & 2 deletions R/Chart-params.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,6 @@ Chart$methods(
get_params = function(){
params$port <<- params$port %or% 8000

params$width <<- params$width %or% 500
params$height <<- params$height %or% 500
params$title <<- params$title %or% params$main %or% internal$file$names$template # alias (main)

params$padding <<- validate_padding(params$padding)
Expand Down
22 changes: 22 additions & 0 deletions inst/templates/Heatmap/config.yml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,22 @@
info: |-
Describe what this template does
demo: |-
data <- 1:10
clickme(heatmap, data)
scripts:
- $shared/d3.v3.2.7.js
- $shared/jquery.v1.8.3.min.js
- $shared/bootstrap-tooltip.v2.3.0.js
- $shared/d3_aux.js

styles:
- $shared/clickme.css
- $shared/tooltip.css

require_packages:

require_server: no


105 changes: 105 additions & 0 deletions inst/templates/Heatmap/template/template.Rmd
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,105 @@
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>
<base target="_blank"> <!-- open all links on a new tab -->

<title>{{{ params$title }}}</title>

{{{ get_assets() }}}
</head>

<body>
<script type="text/javascript">
(function() {
var cell_height, cell_width, color_scale, data, g_col_groups, g_col_names, g_row_names, g_rows, get_row, main, row_names, show_col_names, show_row_names;

data = {{ data$formatted }};

color_scale = {{{ get_d3_color_scale() }}};

cell_width = {{ params$cell_width }};

cell_height = {{ params$cell_height }};

row_names = {{ params$row_names }};

show_col_names = {{ params$show_col_names }};

show_row_names = {{ params$show_row_names }};

main = append_main({
width: {{ params$width }},
height: {{ params$height }},
padding: {{ params$padding }}
});

g_col_groups = main.selectAll(".col_group").data(data).enter().append("g").attr("class", "col_group");

if (show_col_names === true) {
g_col_names = g_col_groups.selectAll(".col_name").data(function(d) {
return d.col_names;
}).enter().append("text").attr({
"class": "col_name",
"x": function(d, i) {
return cell_width * i;
},
"y": 6,
"dy": "-.5em",
"dx": ".4em",
"text-anchor": "start"
}).text(function(d) {
return d;
});
}

get_row = function(row) {
var cell;
return cell = d3.select(this).selectAll(".cell").data(row.row_values).enter().append("rect").attr({
"class": "cell",
"x": function(d, i) {
return cell_width * i;
},
"width": cell_width,
"height": cell_height,
"title": function(d) {
return {{{ get_tooltip_content() }}};
}
}).style("fill", function(d) {
return color_scale(d.cell_value);
});
};

$(".cell").tooltip({
html: true,
container: "body",
placement: "top"
});

g_rows = g_col_groups.selectAll(".row").data(function(d) {
return d.col_values;
}).enter().append("g").attr("class", "row").attr("transform", function(d, i) {
return "translate(0," + (cell_height * i) + ")";
}).each(get_row);

g_row_names = g_col_groups.filter(function(d, i) {
return i === 0;
}).append("g");

if (show_row_names === true) {
g_row_names.selectAll(".row_name").data(function() {
return row_names;
}).enter().append("text").attr("y", function(d, i) {
return cell_height * i;
}).attr("dy", "1em").attr("class", "row_name").text(function(d) {
return d;
});
}

}).call(this);


</script>
</body>
</html>

153 changes: 153 additions & 0 deletions inst/templates/Heatmap/template/template.coffee.Rmd
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,153 @@
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>
<base target="_blank"> <!-- open all links on a new tab -->

<title>{{{ params$title }}}</title>

{{{ get_assets() }}}
</head>

<body>
<script type="text/javascript">
```{r engine="coffee", results="asis", echo = FALSE}

data = {{ data$formatted }}

color_scale = {{{ get_d3_color_scale() }}}

cell_width = {{ params$cell_width }}
cell_height = {{ params$cell_height }}

row_names = {{ params$row_names }}

show_col_names = {{ params$show_col_names }}
show_row_names = {{ params$show_row_names }}

main = append_main(
width: {{ params$width }}
height: {{ params$height }}
padding: {{ params$padding }}

# title: {{ params$title }}
# subtitle: {{ params$subtitle }}

# xlab: {{ params$xlab }}
# ylab: {{ params$ylab }}
)

# add col groups
g_col_groups = main.selectAll(".col_group")
.data(data)
.enter().append("g")
.attr("class", "col_group")

# add col names
if show_col_names is true
g_col_names = g_col_groups.selectAll(".col_name")
.data((d) -> d.col_names)
.enter().append("text")
.attr(
"class": "col_name"
"x": (d,i) -> cell_width * i
"y": 6
"dy": "-.5em"
"dx": ".4em"
"text-anchor": "start"
).text((d) -> d)

# Add cells for each row
get_row = (row) ->
cell = d3.select(@).selectAll(".cell")
.data(row.row_values)
.enter().append("rect")
.attr(
"class": "cell"
"x": (d,i) -> cell_width*i
"width": cell_width
"height": cell_height
"title": (d) -> {{{ get_tooltip_content() }}} )
.style("fill", (d) -> color_scale(d.cell_value))


$(".cell").tooltip
html: true
container: "body"
placement: "top"

# Add rows

g_rows = g_col_groups.selectAll(".row")
.data((d) -> d.col_values)
.enter().append("g")
.attr("class", "row")
.attr("transform", (d, i) -> "translate(0,#{cell_height*i})" )
.each(get_row)
# .attr("row-id", (d,i) -> @model.rowIds[i])
# .attr("cluster", (d,i) -> @model.clusters[i])

g_row_names = g_col_groups.filter((d, i) -> i == 0).append("g")

# Add row names
if show_row_names is true
g_row_names.selectAll(".row_name")
.data(()-> row_names)
.enter().append("text")
.attr("y", (d,i) -> cell_height*i)
.attr("dy", "1em")
.attr("class", "row_name")
.text((d) -> d)

# Calculate col group widths (after appending rows names, but before fixing them)
# col_group_widths = g_col_groups[0].map( (col_group)->
# col_group.getBBox().width)

# if (data.length > 1)
# # add col group names
# g_col_group_names = g_col_groups.append("text")
# .attr(
# "x": (d, i)-> col_group_widths[i]/2
# "y": "-2em"
# "text-anchor": "middle"
# "class": "col_group_name"
# ).text((d) -> d.col_group_name)

# # TODO: refactor this madness
# col_group_x_values = [];
# i = 0
# while i < col_group_widths.length
# if i is 0
# col_group_x_values[0] = 12
# else
# col_group_x_values[i] = col_group_x_values[i - 1] + col_group_widths[i-1] + 12
# i++

# col_group_scale_range = [0, d3.sum(col_group_widths.slice(0, col_group_widths.length - 1)) + 24]

# Fix col group widths (maybe we don't even need a scale)
# main.scales.col_group = d3.scale.linear()
# .domain([0, d3.max(col_group_x_values)])
# .range(col_group_scale_range)

# g_col_group.attr("transform", (d, i) -> "translate(#{main.scales.col_group(col_group_x_values[i])},0)")

# Fix row widths
# row_width = g_row_names.node().getBBox().width

# g_row_names.selectAll("text")
# .attr(
# "x": -(12)
# "text-anchor": "end"
# )

# right aligned
# .attr(
# "x": -(row_width + 12)
# "text-anchor": "start") # left aligned

```
</script>
</body>
</html>

77 changes: 77 additions & 0 deletions inst/templates/Heatmap/tests/test-Heatmap.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,77 @@
context("Heatmap data")

test_that("format_heatmap_data", {
params <- list(data = data.frame(x = 1:10, y = 11:20))
heatmap <- Heatmap$new(params)
formatted_data <- heatmap$format_heatmap_data(params$data, colnames(params$data))
expect_equal(no_whitespace(to_json(formatted_data)), no_whitespace('[ {"col_values": [ {"row_values": [{"cell_value": 1}, {"cell_value": 11}] },
{"row_values": [{"cell_value": 2}, {"cell_value": 12}] },
{"row_values": [{"cell_value": 3}, {"cell_value": 13}] },
{"row_values": [{"cell_value": 4}, {"cell_value": 14}] },
{"row_values": [{"cell_value": 5}, {"cell_value": 15}] },
{"row_values": [{"cell_value": 6}, {"cell_value": 16}] },
{"row_values": [{"cell_value": 7}, {"cell_value": 17}] },
{"row_values": [{"cell_value": 8}, {"cell_value": 18}] },
{"row_values": [{"cell_value": 9}, {"cell_value": 19}] },
{"row_values": [{"cell_value": 10}, {"cell_value": 20}] }],
"col_names": [ "x", "y" ] }
]'), info = "neither col_groups nor row_groups")

col_groups <- factor(c("x","x","y","y"), levels= c("y", "x"))
params <- list(data = data.frame(x1 = 1:3, x2 = 4:6, y1 = 7:9, y2 = 10:12), col_groups = col_groups)
heatmap <- Heatmap$new(params)
formatted_data <- heatmap$format_heatmap_data(params$data, colnames(params$data))
expect_equal(no_whitespace(to_json(formatted_data)), no_whitespace('[ {"col_values": [ {"row_values": [{"cell_value": 7},{"cell_value": 10}] },
{"row_values": [{"cell_value": 8},{"cell_value": 11}] },
{"row_values": [{"cell_value": 9},{"cell_value": 12}] }],
"col_names": ["y1","y2"],
"col_group_name": "y" },
{"col_values": [ {"row_values": [{"cell_value": 1},{"cell_value": 4}] },
{"row_values": [{"cell_value": 2},{"cell_value": 5}] },
{"row_values": [{"cell_value": 3},{"cell_value": 6}] }],
"col_names": ["x1","x2"],
"col_group_name": "x" }
]'), info = "only col_groups")

row_groups <- c("a","a","b","b")
params <- list(data = data.frame(x = 1:4, y = 5:8), row_groups = row_groups)
heatmap <- Heatmap$new(params)
formatted_data <- heatmap$format_heatmap_data(params$data, colnames(params$data))
expect_equal(no_whitespace(to_json(formatted_data)), no_whitespace('[ {"col_values": [ {"row_values": [{"cell_value": 1},{"cell_value": 5}] },
{"row_values": [{"cell_value": 2},{"cell_value": 6}] },
{"row_values": [{"cell_value": 3},{"cell_value": 7}] },
{"row_values": [{"cell_value": 4},{"cell_value": 8}] }],
"col_names": ["x","y"],
"row_group_names": ["a","a","b","b"]}
]'), info = "only row_groups")

row_groups <- c("a","a","b","b")
col_groups <- factor(c("x","x","y","y"), levels= c("y", "x"))
params <- list(data = data.frame(x1 = 1:4, x2 = 5:8, y1 = 9:12, y2 = 13:16), row_groups = row_groups, col_groups = col_groups)
heatmap <- Heatmap$new(params)
formatted_data <- heatmap$format_heatmap_data(params$data, colnames(params$data))
expect_equal(no_whitespace(to_json(formatted_data)), no_whitespace('[ {"col_values": [ {"row_values": [{"cell_value": 9},{"cell_value": 13}] },
{"row_values": [{"cell_value": 10},{"cell_value": 14}] },
{"row_values": [{"cell_value": 11},{"cell_value": 15}] },
{"row_values": [{"cell_value": 12},{"cell_value": 16}] }],
"col_names": ["y1","y2"],
"col_group_name": "y",
"row_group_names": ["a","a","b","b"]},
{"col_values": [ {"row_values": [{"cell_value": 1},{"cell_value": 5}] },
{"row_values": [{"cell_value": 2},{"cell_value": 6}] },
{"row_values": [{"cell_value": 3},{"cell_value": 7}] },
{"row_values": [{"cell_value": 4},{"cell_value": 8}] }],
"col_names": ["x1","x2"],
"col_group_name": "x",
"row_group_names": ["a","a","b","b"]}
]'), info = "row_groups and col_groups")
})


context("Heatmap sanity")

test_that("template is generated", {
clickme(heatmap, mat(nrow = 10, ncol = 5))
})
Loading

0 comments on commit 669e3d1

Please sign in to comment.