@@ -118,6 +118,7 @@ export("anno_simple")

 export("anno_text")

 export("cluster_within_group")

 export("columnAnnotation")

+export("convertXY_in_vp")

 export("decorate_annotation")

 export("decorate_column_dend")

 export("decorate_column_names")

@@ -145,6 +146,7 @@ export("max_text_height")

 export("max_text_width")

 export("oncoPrint")

 export("packLegend")

+export("pindex")

 export("rowAnnotation")

 export("row_anno_barplot")

 export("row_anno_boxplot")

@@ -1,3 +1,12 @@

+CHANGES in VERSION 1.99.0

+

+This a major update of the package. The main changes are:

+* support column split

+* support align heatmaps vertically

+* add a naive `AnnotationFunction` class to handle annotation functions

+

+=======================

+

 CHANGES in VERSION 1.19.1

 * `Heatmap()`: no column name added if the input matrix is a one-column matrix.

@@ -88,7 +88,10 @@ setMethod(f = "draw_heatmap_body",

         do.call(device_fun, c(list(filename = temp_image, width = max(c(heatmap_width*raster_quality, 1)), height = max(c(heatmap_height*raster_quality, 1))), raster_device_param))

         grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = unit(1/nc, 'npc'), height = unit(1/nr, 'npc'), gp = do.call('gpar', c(list(fill = col_matrix), gp)))

         if(is.function(layer_fun)) {

-            layer_fun(row_order, column_order)

+            layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 

+                x[expand_index[[2]]], y[expand_index[[1]]],

+                unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),

+                as.vector(col_matrix))

         }

         dev.off2()

@@ -149,12 +152,20 @@ setMethod(f = "draw_heatmap_body",

         }

         if(is.function(cell_fun)) {

-            for(i in row_order) {

-                for(j in column_order) {

-                    cell_fun(j, i, unit(x[which(column_order == j)], "npc"), unit(y[which(row_order == i)], "npc"), unit(1/nc, "npc"), unit(1/nr, "npc"), col_matrix[which(row_order == i), which(column_order == j)])

+            for(i in seq_len(nr)) {

+                for(j in seq_len(nc)) {

+                    cell_fun(column_order[j], row_order[i], unit(x[j], "npc"), unit(y[i], "npc"), 

+                        unit(1/nc, "npc"), unit(1/nr, "npc"), 

+                        col_matrix[i, j])

                 }

             }

         }

+        if(is.function(layer_fun)) {

+            layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 

+                x[expand_index[[2]]], y[expand_index[[1]]],

+                unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),

+                as.vector(col_matrix))

+        }

     }

     if(!identical(border, FALSE)) {

@@ -225,6 +225,7 @@ setMethod(f = "add_heatmap",

 # -ht_gap = gap, 

 # -main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1],

 # -padding = NULL,

+# -adjust_annotation_name adjust_annotation_name

 # -row_dend_side = c("original", "left", "right"),

 # -row_sub_title_side = c("original", "left", "right"),

 # -column_dend_side = c("original", "top", "bottom"),

@@ -308,6 +309,7 @@ setMethod(f = "draw",

     main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1],

     padding = NULL,

+    adjust_annotation_name = FALSE,

     row_dend_side = c("original", "left", "right"),

     row_sub_title_side = c("original", "left", "right"),

@@ -389,6 +391,8 @@ setMethod(f = "draw",

     object@heatmap_legend_param$offset = heatmap_legend_offset

     object@annotation_legend_param$offset = annotation_legend_offset

+    object@ht_list_param$adjust_annotation_name = adjust_annotation_name

+

     object = make_layout(

         object, 

         row_title = row_title, 

@@ -474,34 +478,34 @@ setMethod(f = "draw",

     # calculate proper padding

     if(is.null(padding)) {

         padding = GLOBAL_PADDING

-        if(!has_heatmap_list_component(object, "heatmap_legend_bottom") && 

-           !has_heatmap_list_component(object, "annotation_legend_bottom") &&

-           !has_heatmap_list_component(object, "column_title_bottom")) {

-            if(object@layout$row_anno_max_bottom_extended[[1]] > object@layout$max_bottom_component_height[[1]]) {

-                padding[1] = object@layout$row_anno_max_bottom_extended - object@layout$max_bottom_component_height + GLOBAL_PADDING[1]

-            }

-        }

-        if(!has_heatmap_list_component(object, "heatmap_legend_left") && 

-           !has_heatmap_list_component(object, "annotation_legend_left") &&

-           !has_heatmap_list_component(object, "row_title_left")) {

-            if(object@layout$column_anno_max_left_extended[[1]] > object@layout$max_left_component_width[[1]]) {

-                padding[2] = object@layout$column_anno_max_left_extended - object@layout$max_left_component_width + GLOBAL_PADDING[2]

-            }

-        }

-        if(!has_heatmap_list_component(object, "heatmap_legend_top") && 

-           !has_heatmap_list_component(object, "annotation_legend_top") &&

-           !has_heatmap_list_component(object, "column_title_top")) {

-            if(object@layout$row_anno_max_top_extended[[1]] > object@layout$max_top_component_height[[1]]) {

-                padding[3] = object@layout$row_anno_max_top_extended - object@layout$max_top_component_height + GLOBAL_PADDING[3]

-            }

-        }

-        if(!has_heatmap_list_component(object, "heatmap_legend_right") && 

-           !has_heatmap_list_component(object, "annotation_legend_right") &&

-           !has_heatmap_list_component(object, "row_title_right")) {

-            if(object@layout$column_anno_max_right_extended[[1]] > object@layout$max_right_component_width[[1]]) {

-                padding[4] = object@layout$column_anno_max_right_extended - object@layout$max_right_component_width + GLOBAL_PADDING[4]

-            }

-        }

+        # if(!has_heatmap_list_component(object, "heatmap_legend_bottom") && 

+        #    !has_heatmap_list_component(object, "annotation_legend_bottom") &&

+        #    !has_heatmap_list_component(object, "column_title_bottom")) {

+        #     if(object@layout$row_anno_max_bottom_extended[[1]] > object@layout$max_bottom_component_height[[1]]) {

+        #         padding[1] = object@layout$row_anno_max_bottom_extended - object@layout$max_bottom_component_height + GLOBAL_PADDING[1]

+        #     }

+        # }

+        # if(!has_heatmap_list_component(object, "heatmap_legend_left") && 

+        #    !has_heatmap_list_component(object, "annotation_legend_left") &&

+        #    !has_heatmap_list_component(object, "row_title_left")) {

+        #     if(object@layout$column_anno_max_left_extended[[1]] > object@layout$max_left_component_width[[1]]) {

+        #         padding[2] = object@layout$column_anno_max_left_extended - object@layout$max_left_component_width + GLOBAL_PADDING[2]

+        #     }

+        # }

+        # if(!has_heatmap_list_component(object, "heatmap_legend_top") && 

+        #    !has_heatmap_list_component(object, "annotation_legend_top") &&

+        #    !has_heatmap_list_component(object, "column_title_top")) {

+        #     if(object@layout$row_anno_max_top_extended[[1]] > object@layout$max_top_component_height[[1]]) {

+        #         padding[3] = object@layout$row_anno_max_top_extended - object@layout$max_top_component_height + GLOBAL_PADDING[3]

+        #     }

+        # }

+        # if(!has_heatmap_list_component(object, "heatmap_legend_right") && 

+        #    !has_heatmap_list_component(object, "annotation_legend_right") &&

+        #    !has_heatmap_list_component(object, "row_title_right")) {

+        #     if(object@layout$column_anno_max_right_extended[[1]] > object@layout$max_right_component_width[[1]]) {

+        #         padding[4] = object@layout$column_anno_max_right_extended - object@layout$max_right_component_width + GLOBAL_PADDING[4]

+        #     }

+        # }

         object@ht_list_param$padding = padding

     }

@@ -453,19 +453,28 @@ setMethod(f = "draw_heatmap_list",

     n = length(object@ht_list)

     ht_gap = object@ht_list_param$ht_gap

+    adjust_annotation_name = object@ht_list_param$adjust_annotation_name

-#     padding = unit(c(0, 0, 0, 0), "mm")

+    padding = unit(c(0, 0, 0, 0), "mm")

-#     if((has_heatmap_list_component(object, "heatmap_legend_right") || 

-#        has_heatmap_list_component(object, "annotation_legend_right")) &&

-#        !has_heatmap_list_component(object, "row_title_right")) {

-#         if(object@layout$column_anno_max_right_extended[[1]] > object@layout$max_right_component_width[[1]]) {

-#             padding[4] = object@layout$column_anno_max_right_extended - object@layout$max_right_component_width + GLOBAL_PADDING[4]

-#         }

-#     }

-# browser()

-#     pushViewport(viewport(x = padding[2], y = padding[1], width = unit(1, "npc") - padding[2] - padding[4],

-#         height = unit(1, "npc") - padding[1] - padding[3], just = c("left", "bottom")))

+    if(adjust_annotation_name) {

+        if(object@layout$row_anno_max_bottom_extended[[1]] > object@layout$max_bottom_component_height[[1]]) {

+            padding[1] = object@layout$row_anno_max_bottom_extended - object@layout$max_bottom_component_height

+        }

+        if(object@layout$column_anno_max_left_extended[[1]] > object@layout$max_left_component_width[[1]]) {

+            padding[2] = object@layout$column_anno_max_left_extended - object@layout$max_left_component_width + GLOBAL_PADDING[2]

+        }

+            

+        if(object@layout$row_anno_max_top_extended[[1]] > object@layout$max_top_component_height[[1]]) {

+            padding[3] = object@layout$row_anno_max_top_extended - object@layout$max_top_component_height + GLOBAL_PADDING[3]

+        }

+        if(object@layout$column_anno_max_right_extended[[1]] > object@layout$max_right_component_width[[1]]) {

+            padding[4] = object@layout$column_anno_max_right_extended - object@layout$max_right_component_width + GLOBAL_PADDING[4]

+        }

+    }

+

+    pushViewport(viewport(x = padding[2], y = padding[1], width = unit(1, "npc") - padding[2] - padding[4],

+        height = unit(1, "npc") - padding[1] - padding[3], just = c("left", "bottom")))

     if(object@direction == "horizontal") {

@@ -579,7 +588,7 @@ setMethod(f = "draw_heatmap_list",

         upViewport()

     }

-    # upViewport()

+    upViewport()

 })

@@ -109,7 +109,7 @@ ht_opt = setGlobalOptions(

 			}

 		},

 		.length = 1),

-	show_vp_border = FALSE,

+	show_vp_border = TRUE,

 	anno_simple_row_size = unit(5, "mm")

 )

@@ -10,6 +10,7 @@

 #           determines how to extract them. Only work when ``mat`` is a matrix.

 # -alter_fun a single function or a list of functions which define how to add graphics for different alterations.

 #                 If it is a list, the names of the list should cover all alteration types.

+# -alter_fun_is_vectorized

 # -col a vector of color for which names correspond to alteration types.

 # -top_annotation

 # -right_annotation

@@ -46,6 +47,7 @@

 oncoPrint = function(mat, 

 	get_type = function(x) x,

 	alter_fun, 

+	alter_fun_is_vectorized = NULL,

 	col, 

 	top_annotation = HeatmapAnnotation(column_barplot = anno_oncoprint_barplot(),

@@ -114,89 +116,135 @@ oncoPrint = function(mat,

 	cat("All mutation types:", paste(all_type, collapse = ", "), "\n")

-	if(missing(alter_fun) && missing(col)) {

-		if(length(mat_list) == 1) {

-			af = function(x, y, w, h, v, j, i) {

-				grid.rect(x, y, w, h, gp = gpar(fill = "#CCCCCC", col = NA))

-				if(v[1]) grid.rect(x, y, w*0.9, h*0.9, gp = gpar(fill = "red", col = NA))

+

+	# type as the third dimension

+	arr = array(FALSE, dim = c(dim(mat_list[[1]]), length(all_type)), dimnames = c(dimnames(mat_list[[1]]), list(all_type)))

+	for(i in seq_along(all_type)) {

+		arr[, , i] = mat_list[[i]]

+	}

+

+	oncoprint_row_order = function() {

+		order(rowSums(count_matrix), n_mut, decreasing = TRUE)

+	}

+

+	oncoprint_column_order = function() {

+		scoreCol = function(x) {

+			score = 0

+			for(i in 1:length(x)) {

+				if(x[i]) {

+					score = score + 2^(length(x)-i*1/x[i])

+				}

 			}

+			return(score)

+		}

+		scores = apply(count_matrix[row_order, ,drop = FALSE], 2, scoreCol)

+		order(scores, decreasing=TRUE)

+	}

+

+	if(missing(alter_fun)) {

+		if(length(mat_list) == 1) {

+			af = list(

+				background = function(x, y, w, h, j, i) {

+					grid.rect(x, y, w, h, gp = gpar(fill = "#CCCCCC", col = NA))

+				},

+				function(x, y, w, h, j, i) {

+					grid.rect(x, y, w*0.9, h*0.9, gp = gpar(fill = "red", col = NA))

+				}

+			)

+			alter_fun_is_vectorized = TRUE

+			names(af) = c("background", names(mat_list))

 			col = "red"

 		} else if(length(mat_list) == 2) {

-			af = function(x, y, w, h, v, j, i) {

-				grid.rect(x, y, w, h, gp = gpar(fill = "#CCCCCC", col = NA))

-				if(v[1]) grid.rect(x, y, w*0.9, h*0.9, gp = gpar(fill = "red", col = NA))

-		        if(v[2]) grid.rect(x, y, w*0.9, h*0.4, gp = gpar(fill = "blue", col = NA))

-		    }

-		    col = c("red", "blue")

+			af = list(

+				background = function(x, y, w, h, j, i) {

+					grid.rect(x, y, w, h, gp = gpar(fill = "#CCCCCC", col = NA))

+				},

+				function(x, y, w, h, j, i) {

+					grid.rect(x, y, w*0.9, h*0.9, gp = gpar(fill = "red", col = NA))

+				},

+				function(x, y, w, h, j, i) {

+					grid.rect(x, y, w*0.9, h*0.4, gp = gpar(fill = "blue", col = NA))

+				}

+			)

+			alter_fun_is_vectorized = TRUE

+			names(af) = c("background", names(mat_list))

+			col = c("red", "blue")

 		} else {

 			stop("`alter_fun` should be specified.")

 		}

 		names(col) = names(mat_list)

-	} else if(is.list(alter_fun)) {

+		warning("Using default `alter_fun` graphics and reset `col`.")

+	}

+

+	if(is.list(alter_fun)) {

 		# validate the list first

 		if(is.null(alter_fun$background)) alter_fun$background = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(fill = "#CCCCCC", col = NA))

 		sdf = setdiff(all_type, names(alter_fun))

 		if(length(sdf) > 0) {

-			stop(paste0("You should define shape function for: ", paste(sdf, collapse = ", ")))

+			stop(paste0("You should define graphic function for: ", paste(sdf, collapse = ", ")))

 		}

 		alter_fun = alter_fun[unique(c("background", intersect(names(alter_fun), all_type)))]

-		af = function(x, y, w, h, v, j, i) {

-			if(!is.null(alter_fun$background)) alter_fun$background(x, y, w, h)

-

-			alter_fun = alter_fun[names(alter_fun) != "background"]

+		if(is.null(alter_fun_is_vectorized)) {

+			alter_fun_is_vectorized = guess_alter_fun_is_vectorized(alter_fun)

+		}

-			if(sum(v)) {

-				for(nm in names(alter_fun)) {

-					if(v[nm]) {

-						if(length(formals(alter_fun[[nm]])) == 6) {

-							alter_fun[[nm]](x, y, w, h, j, i)

-						} else {

-							alter_fun[[nm]](x, y, w, h)

-						}

+		if(alter_fun_is_vectorized) {

+			layer_fun = function(j, i, x, y, w, h, fill) {

+				alter_fun$background(x, y, w, h)

+				for(nm in all_type) {

+					m = arr[, , nm]

+					l = pindex(m, i, j)

+					if(sum(l)) {

+						alter_fun[[nm]](x[l], y[l], w[l], h[l])

+					}

+				}

+			}

+			cell_fun = NULL

+		} else {

+			layer_fun = NULL

+			cell_fun = function(j, i, x, y, w, h, fill) {

+				alter_fun$background(x, y, w, h)

+				for(nm in all_type) {

+					if(arr[i, j, nm]) {

+						alter_fun[[nm]](x, y, w, h)

 					}

 				}

 			}

 		}

-	} else {

-		if(length(formals(alter_fun)) == 7) {

-			af = function(x, y, w, h, v, j, i) {

-				alter_fun(x, y, w, h, v, j, i)

+	} else if(is.function(alter_fun)) {

+		

+		if(length(formals(alter_fun)) == 5) {

+			af = function(x, y, w, h, v, j, i) alter_fun(x, y, w, h, v)

+		} else {

+			af = alter_fun

+		}

+

+		if(is.null(alter_fun_is_vectorized)) {

+			alter_fun_is_vectorized = FALSE

+		}

+

+		if(alter_fun_is_vectorized) {

+			layer_fun = function(j, i, x, y, w, h, fill) {

+				v = pindex(arr, i, j)

+				af(x, y, w, h, v, j, i)

 			}

+			cell_fun = NULL

 		} else {

-			af = function(x, y, w, h, v, j, i) {

-				alter_fun(x, y, w, h, v)

+			layer_fun = NULL

+			cell_fun = function(j, i, x, y, w, h, fill) {

+				v = arr[i, j, ]

+				af(x, y, w, h, v, j, i)

 			}

 		}

+	} else {

+		stop("You need to set `alter_fun`.")

 	}

 	col = col[intersect(names(col), all_type)]

-	# type as the third dimension

-	arr = array(FALSE, dim = c(dim(mat_list[[1]]), length(all_type)), dimnames = c(dimnames(mat_list[[1]]), list(all_type)))

-	for(i in seq_along(all_type)) {

-		arr[, , i] = mat_list[[i]]

-	}

-

-	oncoprint_row_order = function() {

-		order(rowSums(count_matrix), n_mut, decreasing = TRUE)

-	}

-

-	oncoprint_column_order = function() {

-		scoreCol = function(x) {

-			score = 0

-			for(i in 1:length(x)) {

-				if(x[i]) {

-					score = score + 2^(length(x)-i*1/x[i])

-				}

-			}

-			return(score)

-		}

-		scores = apply(count_matrix[row_order, ,drop = FALSE], 2, scoreCol)

-		order(scores, decreasing=TRUE)

-	}

 	count_matrix = apply(arr, c(1, 2), sum)

 	n_mut = rowSums(apply(arr, 1:2, any))

@@ -268,11 +316,7 @@ oncoPrint = function(mat,

 		rect_gp = gpar(type = "none"), 

 		cluster_rows = FALSE, cluster_columns = FALSE, 

 		row_order = row_order, column_order = column_order,

-		cell_fun = function(j, i, x, y, width, height, fill) {

-			z = arr[i, j, ]

-			names(z) = dimnames(arr)[[3]]

-			af(x, y, width, height, z, j, i)

-		},

+		cell_fun = cell_fun, layer_fun = layer_fun,

 		top_annotation = top_annotation,

 		left_annotation = left_annotation,

 		right_annotation = right_annotation,

@@ -364,4 +408,27 @@ anno_oncoprint_barplot = function(type = all_type, which = c("column", "row"),

 	}

 }

+guess_alter_fun_is_vectorized = function(alter_fun) {

+	n = 50

+	if(is.list(alter_fun)) {

+		x = 1:n

+		y = 1:n

+		w = unit(1:n, "mm")

+		h = unit(1:n, "mm")

+		dev.null()

+		oe = try({

+			for(i in seq_along(alter_fun)) {

+				alter_fun[[i]](x, y, w, h)

+			}

+		}, silent = TRUE)

+		dev.off2()

+		if(inherits(oe, "try-error")) {

+			return(FALSE)

+		} else {

+			return(TRUE)

+		}

+	} else {

+		return(FALSE)

+	}

+}

@@ -502,3 +502,85 @@ recycle_param = function(x, all_names, default) {

         return(x)

     }

 }

+

+# == title

+# Convert XY in a parent viewport

+#

+# == param

+# -u a list of two units which is x and y

+# -vp_name the name of the parent viewport

+#

+# == example

+# grid.newpage()

+# pushViewport(viewport(x = 0.5, y = 0.5, width = 0.5, height = 0.5, just = c("left", "bottom")))

+# u = list(x = unit(2, "cm"), y = unit(2, "cm"))

+# convertXY_in_vp(u)

+convertXY_in_vp = function(u, vp_name = "ROOT") {

+    vp = current.viewport()

+    current_vp_name = vp$name

+    original_vp_name = current_vp_name

+    while(current_vp_name != vp_name) {

+

+        if(current_vp_name == "ROOT") {

+            return(u)

+        }

+

+        u$x = convertX(u$x, "mm")

+        u$y = convertX(u$y, "mm")

+        current_vp_x = convertX(vp$x - vp$width*vp$valid.just[1], "mm")

+        current_vp_y = convertY(vp$y - vp$height*vp$valid.just[2], "mm")

+

+        upViewport(1)

+        offset_x = convertX(current_vp_x, "mm")

+        offset_y = convertY(current_vp_y, "mm")

+        u$x = u$x + offset_x

+        u$y = u$y + offset_y

+

+        vp = current.viewport()

+        current_vp_name = vp$name

+    }

+    seekViewport(original_vp_name)

+

+    return(u)

+}

+

+# == title

+# Get values in a matrix by pair-wise indices

+#

+# == param

+# -m a matrix or a 3d array

+# -i row indices

+# -j column indicies

+#

+# == example

+# m = matrix(rnorm(100), 10)

+# m2 = m[m > 0]

+# ind = do.call("rbind", lapply(1:10, function(ci) {

+#     i = which(m[, ci] > 0)

+#     cbind(i = i, j = rep(ci, length(i)))

+# }))

+# pindex(m, ind[, 1], ind[, 2])

+# identical(pindex(m, ind[, 1], ind[, 2]), m[m > 0])

+#

+# # 3d array

+# arr = array(1:27, dim = c(3, 3, 3))

+# pindex(arr, 1:2, 2:3)

+# identical(pindex(arr, 1:2, 2:3),

+#    rbind(arr[1, 2, ], arr[2, 3, ]))

+pindex = function(m, i, j) {

+    nr = nrow(m)

+    nc = ncol(m)

+    ind = (j-1)*nr + i

+    dm = dim(m)

+    if(length(dm) == 2) {

+        v = as.vector(m)

+        v[ind]

+    } else if(length(dm) == 3) {

+        v = m

+        dim(v) = c(dm[1]*dm[2], dm[3])

+        v[ind, , drop = FALSE]

+    } else {

+        stop("dimension of `m` can only be 2 and 3.")

+    }

+}

+

new file mode 100644

@@ -0,0 +1,23 @@

+\name{convertXY_in_vp}

+\alias{convertXY_in_vp}

+\title{

+Convert XY in a parent viewport

+}

+\description{

+Convert XY in a parent viewport

+}

+\usage{

+convertXY_in_vp(u, vp_name = "ROOT")

+}

+\arguments{

+

+  \item{u}{a list of two units which is x and y}

+  \item{vp_name}{the name of the parent viewport}

+

+}

+\examples{

+grid.newpage()

+pushViewport(viewport(x = 0.5, y = 0.5, width = 0.5, height = 0.5, just = c("left", "bottom")))

+u = list(x = unit(2, "cm"), y = unit(2, "cm"))

+convertXY_in_vp(u)

+}

@@ -32,6 +32,7 @@ Draw a list of heatmaps

     main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1],

     padding = NULL,

+    adjust_annotation_name = FALSE,

     row_dend_side = c("original", "left", "right"),

     row_sub_title_side = c("original", "left", "right"),

@@ -104,6 +105,7 @@ Draw a list of heatmaps

   \item{ht_gap}{= gap, }

   \item{main_heatmap}{= which(sapply(object@ht_list, inherits, "Heatmap"))[1],}

   \item{padding}{= NULL,}

+  \item{adjust_annotation_name}{adjust_annotation_name}

   \item{row_dend_side}{= c("original", "left", "right"),}

   \item{row_sub_title_side}{= c("original", "left", "right"),}

   \item{column_dend_side}{= c("original", "top", "bottom"),}

@@ -10,6 +10,7 @@ Make oncoPrint

 oncoPrint(mat,

     get_type = function(x) x,

     alter_fun,

+    alter_fun_is_vectorized = NULL,

     col,

     top_annotation = HeatmapAnnotation(column_barplot = anno_oncoprint_barplot(),

@@ -37,6 +38,7 @@ oncoPrint(mat,

   \item{mat}{a character matrix which encodes mulitple alterations or a list of matrix for which every matrix contains binary value representing the alteration is present or absent. When it is a list, the names represent alteration types. You can use \code{\link{unify_mat_list}} to make all matrix having same row names and column names.}

   \item{get_type}{If different alterations are encoded in the matrix, this self-defined function determines how to extract them. Only work when \code{mat} is a matrix.}

   \item{alter_fun}{a single function or a list of functions which define how to add graphics for different alterations. If it is a list, the names of the list should cover all alteration types.}

+  \item{alter_fun_is_vectorized}{-alter_fun_is_vectorized}

   \item{col}{a vector of color for which names correspond to alteration types.}

   \item{top_annotation}{-top_annotation}

   \item{right_annotation}{-right_annotation}

new file mode 100644

@@ -0,0 +1,34 @@

+\name{pindex}

+\alias{pindex}

+\title{

+Get values in a matrix by pair-wise indices

+}

+\description{

+Get values in a matrix by pair-wise indices

+}

+\usage{

+pindex(m, i, j)

+}

+\arguments{

+

+  \item{m}{a matrix or a 3d array}

+  \item{i}{row indices}

+  \item{j}{column indicies}

+

+}

+\examples{

+m = matrix(rnorm(100), 10)

+m2 = m[m > 0]

+ind = do.call("rbind", lapply(1:10, function(ci) {

+    i = which(m[, ci] > 0)

+    cbind(i = i, j = rep(ci, length(i)))

+}))

+pindex(m, ind[, 1], ind[, 2])

+identical(pindex(m, ind[, 1], ind[, 2]), m[m > 0])

+

+# 3d array

+arr = array(1:27, dim = c(3, 3, 3))

+pindex(arr, 1:2, 2:3)

+identical(pindex(arr, 1:2, 2:3),

+   rbind(arr[1, 2, ], arr[2, 3, ]))

+}