Skip to content

Commit bb2d82c

Browse files
author
Joshua Gould
committed
Convert to JSON
1 parent f906a83 commit bb2d82c

File tree

4 files changed

+154
-58
lines changed

4 files changed

+154
-58
lines changed

‎R/morpheus.R

+142-17
Original file line numberDiff line numberDiff line change
@@ -29,10 +29,123 @@ drawGrid = TRUE,
2929
gridColor = "#808080",
3030
gridThickness = 0.1,
3131
drawValues = FALSE,
32-
width = NULL, height = NULL,
32+
width = NULL,
33+
height = NULL,
34+
...
35+
) {
36+
payload <- create.payload(x,
37+
labRow = labRow,
38+
labCol = labCol,
39+
Rowv = Rowv,
40+
Colv=Colv,
41+
distfun = distfun,
42+
hclustfun = hclustfun,
43+
dendrogram = dendrogram,
44+
reorderfun = reorderfun,
45+
symm = symm,
46+
na.rm = na.rm,
47+
rowAnnotations=rowAnnotations,
48+
columnAnnotations=columnAnnotations,
49+
colorScheme = colorScheme,
50+
rowSize = rowSize,
51+
columnSize = columnSize,
52+
drawGrid = drawGrid,
53+
gridColor = gridColor,
54+
gridThickness = gridThickness,
55+
drawValues = drawValues,
56+
width = width,
57+
height = height,
58+
...)
59+
htmlwidgets::createWidget(
60+
name = 'morpheus',
61+
payload,
62+
width = width,
63+
height = height,
64+
package = 'morpheus',
65+
sizingPolicy = htmlwidgets::sizingPolicy(browser.fill = TRUE)
66+
)
67+
}
68+
69+
morpheus.toJSON <- function(x,
70+
labRow = rownames(x),
71+
labCol = colnames(x),
72+
73+
# dendrogram control
74+
Rowv = TRUE,
75+
Colv=if (symm)"Rowv" else TRUE,
76+
distfun = dist,
77+
hclustfun = hclust,
78+
dendrogram = c("both", "row", "column", "none"),
79+
reorderfun = function(d, w) reorder(d, w),
80+
symm = FALSE,
81+
na.rm = TRUE,
82+
rowAnnotations=NULL,
83+
columnAnnotations=NULL,
84+
colorScheme = NULL,
85+
rowSize = 13,
86+
columnSize = 13,
87+
drawGrid = TRUE,
88+
gridColor = "#808080",
89+
gridThickness = 0.1,
90+
drawValues = FALSE,
91+
width = NULL,
92+
height = NULL,
3393
...
3494
) {
3595

96+
payload <- create.payload(x,
97+
labRow = labRow,
98+
labCol = labCol,
99+
Rowv = Rowv,
100+
Colv=Colv,
101+
distfun = distfun,
102+
hclustfun = hclustfun,
103+
dendrogram = dendrogram,
104+
reorderfun = reorderfun,
105+
symm = symm,
106+
na.rm = na.rm,
107+
rowAnnotations=rowAnnotations,
108+
columnAnnotations=columnAnnotations,
109+
colorScheme = colorScheme,
110+
rowSize = rowSize,
111+
columnSize = columnSize,
112+
drawGrid = drawGrid,
113+
gridColor = gridColor,
114+
gridThickness = gridThickness,
115+
drawValues = drawValues,
116+
width = width,
117+
height = height,
118+
...)
119+
jsonlite::toJSON(payload$options,dataframe = "columns", null = "null", na = "null", auto_unbox = TRUE,
120+
digits = getOption("shiny.json.digits", 16), use_signif = TRUE, force = TRUE,
121+
POSIXt = "ISO8601", UTC = TRUE, rownames = FALSE, keep_vec_names = TRUE,
122+
strict_atomic = TRUE)
123+
}
124+
125+
create.payload <- function(x,
126+
labRow = rownames(x),
127+
labCol = colnames(x),
128+
Rowv = TRUE,
129+
Colv=if (symm)"Rowv" else TRUE,
130+
distfun = dist,
131+
hclustfun = hclust,
132+
dendrogram = c("both", "row", "column", "none"),
133+
reorderfun = function(d, w) reorder(d, w),
134+
symm = FALSE,
135+
na.rm = TRUE,
136+
rowAnnotations=NULL,
137+
columnAnnotations=NULL,
138+
colorScheme = NULL,
139+
rowSize = 13,
140+
columnSize = 13,
141+
drawGrid = TRUE,
142+
gridColor = "#808080",
143+
gridThickness = 0.1,
144+
drawValues = FALSE,
145+
width = NULL,
146+
height = NULL,
147+
...
148+
) {
36149
name <- deparse(substitute(x))
37150
## x is a matrix!
38151
if (! is.matrix(x)) {
@@ -170,24 +283,23 @@ width = NULL, height = NULL,
170283
morpheusOptions$gridThickness <- gridThickness
171284
morpheusOptions$drawValues <- drawValues
172285

173-
174286
x <- x[rowInd, colInd]
175287
if (!is.null(morpheusOptions$colorScheme$colors)) {
176288
morpheusOptions$colorScheme$colors <- lapply(morpheusOptions$colorScheme$colors, function(color){
177289
rgb <- col2rgb(color)
178290
paste("rgb(", rgb[1], ",", rgb[2], ",", rgb[3], ")", sep='')
179291
})
180292
}
181-
182-
if (!is.null(morpheusOptions$colorScheme$colors) && is.null(morpheusOptions$colorScheme$values)) {
293+
294+
if (!is.null(morpheusOptions$colorScheme$colors) && is.null(morpheusOptions$colorScheme$values)) {
183295
rng = range(x)
184296
nvals <- length(morpheusOptions$colorScheme$colors)
185297
fractionStep <- 1/(nvals-1)
186298
values <- vector("list", nvals)
187299
dataRange <- rng[2] - rng[1]
188300
values[1] <- rng[1]
189301
values[nvals] <- rng[2]
190-
302+
191303
for(i in 2:nvals-1) {
192304
fraction <-fractionStep*(i-1)
193305
values[i] <- rng[1] + fraction*dataRange
@@ -202,20 +314,33 @@ width = NULL, height = NULL,
202314
is.dendrogram(ddr) &&
203315
dendrogram %in% c("both", "row")) dendToTree(ddr) else NULL
204316

205-
payload <- list(rows = nrow(x), rowDendrogram = rowDendrogram, columnDendrogram = columnDendrogram, columns = ncol(x), name = name,
206-
array = x, rowNames = rownames(x), columnNames = colnames(x), rowAnnotations = rowAnnotations, columnAnnotations = columnAnnotations, options = morpheusOptions)
207-
htmlwidgets::createWidget(
208-
name = 'morpheus',
209-
payload,
210-
width = width,
211-
height = height,
212-
package = 'morpheus',
213-
sizingPolicy = htmlwidgets::sizingPolicy(browser.fill = TRUE)
214-
)
215-
216317

217-
}
218318

319+
rowVectors <- list()
320+
rowVectors[[1]] = list(name='id', array=rownames(x))
321+
322+
if(!is.null(rowAnnotations)) {
323+
for (i in 1:ncol(rowAnnotations)) {
324+
rowVectors[[i+1]] = list(name= names(rowAnnotations)[i], array=rowAnnotations[,i])
325+
}
326+
}
327+
rowMetadataModel <- list(vectors=rowVectors)
328+
columnVectors <- list()
329+
columnVectors[[1]] = list(name='id', array=colnames(x))
330+
if(!is.null(columnAnnotations)) {
331+
for (i in 1:ncol(columnAnnotations)) {
332+
columnVectors[[i+1]] = list(name= names(columnAnnotations)[i], array=columnAnnotations[,i])
333+
}
334+
}
335+
columnMetadataModel <- list(vectors=columnVectors)
336+
dataset <- list(seriesNames=list(name), rows = nrow(x), columns = ncol(x), seriesDataTypes=list('number'),
337+
seriesArrays=list(x), rowMetadataModel=rowMetadataModel, columnMetadataModel=columnMetadataModel)
338+
339+
morpheusOptions$dataset = dataset
340+
morpheusOptions$name = name
341+
payload <- list(rowDendrogram = rowDendrogram, columnDendrogram = columnDendrogram, options=morpheusOptions)
342+
return(payload)
343+
}
219344

220345
is.dendrogram <- function (x) { inherits(x, "dendrogram")}
221346

‎inst/htmlwidgets/lib/js/morpheus-latest.min.js

+1-1
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎inst/htmlwidgets/morpheus.js

+4-34
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
HTMLWidgets.widget({
2-
name: "morpheus",
3-
type: "output",
2+
name: 'morpheus',
3+
type: 'output',
44
factory: function (el, width, height) {
55
var instance = {};
66
return {
@@ -38,51 +38,21 @@ HTMLWidgets.widget({
3838
nLeafNodes: leafNodes.length
3939
};
4040
};
41-
var dataset = morpheus.Dataset.fromJSON({
42-
seriesNames: [x.name],
43-
seriesDataTypes: ['number'],
44-
seriesArrays: [x.array],
45-
rows: x.rows,
46-
columns: x.columns,
47-
rowMetadataModel: {
48-
vectors: [{
49-
name: 'id',
50-
array: x.rowNames
51-
}]
52-
},
53-
columnMetadataModel: {
54-
vectors: [{
55-
name: 'id',
56-
array: x.columnNames
57-
}]
58-
}
59-
});
6041

6142
if (x.columnDendrogram != null) {
6243
x.columnDendrogram = toDendrogram(x.columnDendrogram);
6344
}
6445
if (x.rowDendrogram != null) {
6546
x.rowDendrogram = toDendrogram(x.rowDendrogram);
6647
}
67-
if (x.rowAnnotations) {
68-
for (var key in x.rowAnnotations) {
69-
dataset.getRowMetadata().add(key).array = x.rowAnnotations[key];
70-
}
71-
}
72-
73-
if (x.columnAnnotations) {
74-
for (var key in x.columnAnnotations) {
75-
dataset.getColumnMetadata().add(key).array = x.columnAnnotations[key];
76-
}
77-
}
7848

7949
var options = x.options;
8050
options.el = el;
8151
options.columnDendrogramField = null;
8252
options.columnDendrogram = x.columnDendrogram;
8353
options.rowDendrogramField = null;
8454
options.rowDendrogram = x.rowDendrogram;
85-
options.dataset = dataset;
55+
options.dataset = morpheus.Dataset.fromJSON(x.options.dataset);
8656
options.width = width;
8757
options.height = height;
8858
var heatMap = new morpheus.HeatMap(options);
@@ -95,6 +65,6 @@ HTMLWidgets.widget({
9565
}
9666
}
9767
};
98-
instance:instance
68+
instance:instance;
9969
}
10070
});

‎man/morpheus.Rd

+7-6
Original file line numberDiff line numberDiff line change
@@ -109,13 +109,14 @@ to \code{FALSE})}
109109
110110
\examples{
111111
library(morpheus)
112-
rowAnnotations <- data.frame(annotation1=1:32, annotation2=sample(LETTERS[1:3], nrow(mtcars),
112+
x <- t(mtcars)
113+
columnAnnotations <- data.frame(annotation1=1:32, annotation2=sample(LETTERS[1:3], ncol(x),
113114
replace = TRUE))
114-
morpheus(mtcars,
115-
colorScheme=list(scalingMode="fixed", colors=heat.colors(3)),
116-
rowAnnotations=rowAnnotations,
117-
overrideRowDefaults=FALSE,
118-
rows=list(list(field='annotation2', highlightMatchingValues=TRUE, display=list('color'))))
115+
morpheus(x,
116+
colorScheme=list(scalingMode="relative", colors=heat.colors(3)),
117+
columnAnnotations=columnAnnotations,
118+
columns=list(list(field='id', display=list('text')), list(field='annotation2',
119+
highlightMatchingValues=TRUE, display=list('color'))))
119120
# Select Edit > Copy Selected Dataset in Morpheus to copy selection to clipboard in gct format
120121
# data <- read.gct('clipboard') # read the clipboard data into R
121122

0 commit comments

Comments
 (0)