/
chorddiag.R
251 lines (237 loc) · 10.9 KB
/
chorddiag.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
#' Create a D3 Chord Diagram
#'
#' Create an interactive chord diagram using the JavaScript visualization
#' library D3 (\url{http://d3js.org}). More specifically, the chord diagram
#' layout is based on \url{http://bl.ocks.org/mbostock/4062006}. Chord diagrams
#' show directed relationships among a group of entities.
#'
#' @param data A matrix containing the data. Must be square for the
#' "directional" type. Column names of the matrix (if existing) will be used
#' as group labels unless the \code{groupNames} argument is explicitely set.
#' For the "bipartite" type, the column names label the groups on the left
#' side of the chord diagram whereas the row names label the groups on the
#' right side.
#' @param type A character string for the type of chord diagram. Either
#' "directional" (default) or "bipartite" (chord diagrams can be helpful for
#' visualising symmetric relations between two categories of groups, i.e.
#' contingency tables).
#' @param width Width for the chord diagram's frame area in pixels (if NULL then
#' width is automatically determined based on context).
#' @param height Height for the chord diagram's frame area in pixels (if NULL
#' then height is automatically determined based on context).
#' @param margin Numeric margin in pixels between the outer diagram radius and
#' the edge of the display.
#' @param palette A character string. The name of the colorbrewer palette to be
#' used. For bipartite diagrams, the palette is used for the column groups.
#' @param palette2 A character string. Only used for bipartite diagrams where it
#' is the name of the colorbrewer palette to be used for the row groups.
#' @param showGroupnames A logical scalar.
#' @param groupNames A vector of character strings to be used for group
#' labeling.
#' @param groupColors A vector of colors to be used for the groups. Specifying
#' \code{groupColors} overrides any \code{palette} given. For bipartite
#' diagrams, the colors used for the row groups must precede the colors for
#' the column groups.
#' @param groupThickness Numeric thickness for the groups as a fraction of the
#' total diagram radius.
#' @param groupPadding Numeric padding in degrees between groups.
#' @param groupnamePadding Numeric padding in pixels between diagram (outer
#' circle) and group labels. Use this argument if group labels overlap with
#' tick labels. Either a scalar value to be applied to all group labels or a
#' numeric vector specifying padding for each group label separately.
#' @param groupnameFontsize Numeric font size in pixels for the group labels.
#' @param groupedgeColor Color for the group edges. If NULL group colors will be
#' used.
#' @param chordedgeColor Color for the chord edges.
#' @param categoryNames A length-2 vector of character strings to be used for
#' category labels (left and right side of a bipartite chord diagram).
#' @param categorynamePadding Numeric padding in pixels between diagram (outer
#' circle) and category labels in bipartite diagrams. Use this argument if
#' category labels overlap with tick or group labels.
#' @param categorynameFontsize Numeric font size in pixels for the category
#' labels in a bipartite diagram.
#' @param showTicks A logical scalar.
#' @param tickInterval A numeric value.
#' @param ticklabelFontsize Numeric font size in pixels for the tick labels.
#' @param fadeLevel Numeric chord fade level (opacity value between 0 and 1,
#' defaults to 0.1).
#' @param showTooltips A logical scalar (defaults to TRUE).
#' @param showZeroTooltips A logical scalar (defaults to TRUE). If set to FALSE,
#' tooltips for the value zero are hidden.
#' @param tooltipNames A vector of character strings to be used for group
#' labeling in tooltips. By default equal to \code{groupNames}.
#' @param tooltipUnit A character string for the units to be used in tooltips.
#' @param tooltipFontsize Numeric font size in pixels for the tooltips.
#' @param tooltipGroupConnector A character string to be used in tooltips:
#' "<source group> <tooltipGroupConnector> <target group>". Defaults to a
#' triangle pointing from source to target.
#' @param precision Integer number of significant digits to be used for tooltip
#' display.
#' @param clickAction character string containing JavaScript code to be executed
#' on a mouse click so that shiny can get the sourceIndex and targetIndex for the
#' purpose of filtering the data on other visualizations
#' @param clickGroupAction character string containing JavaScript code to be executed
#' on a mouse click so that shiny can get the groupIndex
#'
#'
#' @source Based on \url{http://bl.ocks.org/mbostock/4062006} with several
#' modifications.
#'
#' @examples
#' m <- matrix(c(11975, 5871, 8916, 2868,
#' 1951, 10048, 2060, 6171,
#' 8010, 16145, 8090, 8045,
#' 1013, 990, 940, 6907),
#' byrow = TRUE,
#' nrow = 4, ncol = 4)
#' groupnames <- c("black", "blonde", "brown", "red")
#' row.names(m) <- groupnames
#' colnames(m) <- groupnames
#' chorddiag(m)
#'
#' @export
chorddiag <- function(data,
type = "directional",
width = NULL, height = NULL,
margin = 100,
palette = "Dark2",
palette2 = "Greys",
showGroupnames = TRUE,
groupNames = NULL,
groupColors = NULL, groupThickness = 0.1,
groupPadding = 2,
groupnamePadding = 30, groupnameFontsize = 18,
groupedgeColor = NULL,
chordedgeColor = "#808080",
categoryNames = NULL,
categorynamePadding = 100, categorynameFontsize = 28,
showTicks = TRUE, tickInterval = NULL,
ticklabelFontsize = 10,
fadeLevel = 0.1,
showTooltips = TRUE,
showZeroTooltips = TRUE,
tooltipNames = NULL,
tooltipUnit = NULL,
tooltipFontsize = 12,
tooltipGroupConnector = " ▶ ",
precision = NULL,
clickAction = NULL,
clickGroupAction = NULL) {
if (!is.matrix(data))
stop("'data' must be a matrix class object.")
d <- dim(data)
if (type == "bipartite") {
g1 <- d[1]
g2 <- d[2]
n <- g1 + g2
m <- matrix(0, nrow = n, ncol = n)
m[1:g1, (g1+1):n] <- data
m[(g1+1):n, 1:g1] <- t(data)
g1.names <- row.names(data)
g2.names <- colnames(data)
m.names <- c(g1.names, g2.names)
row.names(m) <- m.names
colnames(m) <- m.names
if (is.null(categoryNames)) {
# get categoryNames from data dimnames
categoryNames <- names(dimnames(data))
}
data <- m
} else if (type == "directional") {
if (d[1] != d[2] ) stop("'data' must be a square matrix.")
n <- d[1]
}
if (!is.null(categoryNames) & type != "bipartite") {
warning("category names are only used for bipartite chord diagrams.")
}
if (!is.null(groupNames)) {
g <- length(groupNames)
if (g != n)
stop(paste0("length of 'groupNames' [", g, "] not equal to matrix extent [", n, "]."))
} else {
groupNames <- colnames(data)
}
rnames <- row.names(data)
if (!is.null(rnames)) {
if (!identical(rnames, groupNames))
warning("row names of the 'data' matrix differ from its column names or the 'groupNames' argument.")
}
if (length(groupnamePadding) == 1) {
groupnamePadding <- rep(groupnamePadding, n)
}
if (is.null(groupColors)) {
if (type == "directional") {
groupColors <- RColorBrewer::brewer.pal(n, palette)
} else if (type == "bipartite") {
groupColors <- c(
RColorBrewer::brewer.pal(g1, palette2),
RColorBrewer::brewer.pal(g2, palette)
)
}
}
if (is.null(tickInterval)) {
tickInterval <- 10^(floor(log10(max(data))) - 1)
}
if (is.null(tooltipNames)) {
tooltipNames = groupNames
}
if (is.null(tooltipUnit)) {
tooltipUnit <- ""
}
if (is.null(precision)) {
precision <- "null"
}
params = list(matrix = data,
options = list(type = type,
width = width, height = height,
margin = margin,
showGroupnames = showGroupnames,
groupNames = groupNames,
groupColors = groupColors,
groupThickness = groupThickness,
groupPadding = pi * groupPadding / 180,
groupnamePadding = groupnamePadding,
groupnameFontsize = groupnameFontsize,
groupedgeColor = groupedgeColor,
chordedgeColor = chordedgeColor,
categoryNames = categoryNames,
categorynamePadding = categorynamePadding,
categorynameFontsize = categorynameFontsize,
showTicks = showTicks,
tickInterval = tickInterval,
ticklabelFontsize = ticklabelFontsize,
fadeLevel = fadeLevel,
showTooltips = showTooltips,
showZeroTooltips = showZeroTooltips,
tooltipNames = tooltipNames,
tooltipFontsize = tooltipFontsize,
tooltipUnit = tooltipUnit,
tooltipGroupConnector = tooltipGroupConnector,
precision = precision,
clickAction = clickAction,
clickGroupAction = clickGroupAction))
params = Filter(Negate(is.null), params)
# create widget
htmlwidgets::createWidget(
name = 'chorddiag',
params,
width = width,
height = height,
htmlwidgets::sizingPolicy(padding = 0,
browser.fill = TRUE),
package = 'chorddiag'
)
}
#' Widget output function for use in Shiny
#'
#' @export
chorddiagOutput <- function(outputId, width = '90%', height = '350px'){
htmlwidgets::shinyWidgetOutput(outputId, 'chorddiag', width, height, package = 'chorddiag')
}
#' Widget render function for use in Shiny
#'
#' @export
renderChorddiag <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) { expr <- substitute(expr) } # force quoted
htmlwidgets::shinyRenderWidget(expr, chorddiagOutput, env, quoted = TRUE)
}