... | ... |
@@ -1,31 +1,31 @@ |
1 |
-setGeneric('get_color_mapping_list', function(object, ...) standardGeneric('get_color_mapping_list')) |
|
2 |
-setGeneric('set_component_height', function(object, ...) standardGeneric('set_component_height')) |
|
3 | 1 |
setGeneric('map_to_colors', function(object, ...) standardGeneric('map_to_colors')) |
4 |
-setGeneric('draw_heatmap_legend', function(object, ...) standardGeneric('draw_heatmap_legend')) |
|
5 |
-setGeneric('draw_heatmap_list', function(object, ...) standardGeneric('draw_heatmap_list')) |
|
6 |
-setGeneric('set_component_width', function(object, ...) standardGeneric('set_component_width')) |
|
7 |
-setGeneric('make_column_cluster', function(object, ...) standardGeneric('make_column_cluster')) |
|
8 |
-setGeneric('draw', function(object, ...) standardGeneric('draw')) |
|
2 |
+setGeneric('set_component_height', function(object, ...) standardGeneric('set_component_height')) |
|
3 |
+setGeneric('draw_heatmap_body', function(object, ...) standardGeneric('draw_heatmap_body')) |
|
9 | 4 |
setGeneric('component_height', function(object, ...) standardGeneric('component_height')) |
10 |
-setGeneric('row_dend', function(object, ...) standardGeneric('row_dend')) |
|
5 |
+setGeneric('re_size', function(object, ...) standardGeneric('re_size')) |
|
6 |
+setGeneric('make_layout', function(object, ...) standardGeneric('make_layout')) |
|
7 |
+setGeneric('heatmap_legend_size', function(object, ...) standardGeneric('heatmap_legend_size')) |
|
8 |
+setGeneric('get_legend_param_list', function(object, ...) standardGeneric('get_legend_param_list')) |
|
11 | 9 |
setGeneric('color_mapping_legend', function(object, ...) standardGeneric('color_mapping_legend')) |
12 |
-setGeneric('annotation_legend_size', function(object, ...) standardGeneric('annotation_legend_size')) |
|
13 |
-setGeneric('draw_heatmap_body', function(object, ...) standardGeneric('draw_heatmap_body')) |
|
10 |
+setGeneric('make_column_cluster', function(object, ...) standardGeneric('make_column_cluster')) |
|
14 | 11 |
setGeneric('column_dend', function(object, ...) standardGeneric('column_dend')) |
15 | 12 |
setGeneric('row_order', function(object, ...) standardGeneric('row_order')) |
16 |
-setGeneric('prepare', function(object, ...) standardGeneric('prepare')) |
|
17 |
-setGeneric('draw_title', function(object, ...) standardGeneric('draw_title')) |
|
18 |
-setGeneric('draw_annotation', function(object, ...) standardGeneric('draw_annotation')) |
|
13 |
+setGeneric('draw_heatmap_list', function(object, ...) standardGeneric('draw_heatmap_list')) |
|
14 |
+setGeneric('row_dend', function(object, ...) standardGeneric('row_dend')) |
|
19 | 15 |
setGeneric('add_heatmap', function(object, ...) standardGeneric('add_heatmap')) |
20 |
-setGeneric('get_legend_param_list', function(object, ...) standardGeneric('get_legend_param_list')) |
|
21 |
-setGeneric('draw_annotation_legend', function(object, ...) standardGeneric('draw_annotation_legend')) |
|
22 |
-setGeneric('heatmap_legend_size', function(object, ...) standardGeneric('heatmap_legend_size')) |
|
16 |
+setGeneric('set_component_width', function(object, ...) standardGeneric('set_component_width')) |
|
23 | 17 |
setGeneric('column_order', function(object, ...) standardGeneric('column_order')) |
18 |
+setGeneric('draw_annotation_legend', function(object, ...) standardGeneric('draw_annotation_legend')) |
|
19 |
+setGeneric('draw_heatmap_legend', function(object, ...) standardGeneric('draw_heatmap_legend')) |
|
20 |
+setGeneric('annotation_legend_size', function(object, ...) standardGeneric('annotation_legend_size')) |
|
21 |
+setGeneric('draw_annotation', function(object, ...) standardGeneric('draw_annotation')) |
|
22 |
+setGeneric('prepare', function(object, ...) standardGeneric('prepare')) |
|
24 | 23 |
setGeneric('draw_dimnames', function(object, ...) standardGeneric('draw_dimnames')) |
24 |
+setGeneric('draw', function(object, ...) standardGeneric('draw')) |
|
25 |
+setGeneric('draw_title', function(object, ...) standardGeneric('draw_title')) |
|
25 | 26 |
setGeneric('make_row_cluster', function(object, ...) standardGeneric('make_row_cluster')) |
26 | 27 |
setGeneric('component_width', function(object, ...) standardGeneric('component_width')) |
27 |
-setGeneric('re_size', function(object, ...) standardGeneric('re_size')) |
|
28 |
+setGeneric('get_color_mapping_list', function(object, ...) standardGeneric('get_color_mapping_list')) |
|
29 |
+setGeneric('draw_dend', function(object, ...) standardGeneric('draw_dend')) |
|
28 | 30 |
setGeneric('adjust_heatmap_list', function(object, ...) standardGeneric('adjust_heatmap_list')) |
29 | 31 |
setGeneric('copy_all', function(object, ...) standardGeneric('copy_all')) |
30 |
-setGeneric('draw_dend', function(object, ...) standardGeneric('draw_dend')) |
|
31 |
-setGeneric('make_layout', function(object, ...) standardGeneric('make_layout')) |
... | ... |
@@ -53,7 +53,7 @@ anno_width_and_height = function(which, width = NULL, height = NULL, |
53 | 53 |
if(!is_abs_unit(height)) { |
54 | 54 |
stop_wrap("height of the annotation can only be an absolute unit.") |
55 | 55 |
} else { |
56 |
- height = convertHeight(height, "mm") |
|
56 |
+ # height = convertHeight(height, "mm") |
|
57 | 57 |
} |
58 | 58 |
} |
59 | 59 |
if(is.null(width)) { |
... | ... |
@@ -67,7 +67,7 @@ anno_width_and_height = function(which, width = NULL, height = NULL, |
67 | 67 |
if(!is_abs_unit(width)) { |
68 | 68 |
stop_wrap("width of the annotation can only be an absolute unit.") |
69 | 69 |
} else { |
70 |
- width = convertWidth(width, "mm") |
|
70 |
+ # width = convertWidth(width, "mm") |
|
71 | 71 |
} |
72 | 72 |
} |
73 | 73 |
if(is.null(height)) { |
... | ... |
@@ -398,7 +398,6 @@ setMethod(f = "show", |
398 | 398 |
cat(" ", as.character(object@extended[i]), "extension on the", dirt[i], "\n") |
399 | 399 |
} |
400 | 400 |
} |
401 |
- |
|
402 | 401 |
}) |
403 | 402 |
|
404 | 403 |
# == title |
... | ... |
@@ -647,12 +647,17 @@ anno_points = function(x, which = c("column", "row"), border = TRUE, gp = gpar() |
647 | 647 |
} |
648 | 648 |
} |
649 | 649 |
|
650 |
+ ef = function() NULL |
|
650 | 651 |
if(is.null(.ENV$current_annotation_which)) { |
651 | 652 |
which = match.arg(which)[1] |
653 |
+ dev.null() |
|
654 |
+ ef = dev.off2 |
|
652 | 655 |
} else { |
653 | 656 |
which = .ENV$current_annotation_which |
654 | 657 |
} |
655 | 658 |
|
659 |
+ on.exit(ef()) |
|
660 |
+ |
|
656 | 661 |
if(is.data.frame(x)) x = as.matrix(x) |
657 | 662 |
if(is.matrix(x)) { |
658 | 663 |
if(ncol(x) == 1) { |
... | ... |
@@ -831,12 +836,17 @@ anno_lines = function(x, which = c("column", "row"), border = TRUE, gp = gpar(), |
831 | 836 |
extend = 0.05, axis = TRUE, axis_param = default_axis_param(which), |
832 | 837 |
width = NULL, height = NULL) { |
833 | 838 |
|
839 |
+ ef = function() NULL |
|
834 | 840 |
if(is.null(.ENV$current_annotation_which)) { |
835 | 841 |
which = match.arg(which)[1] |
842 |
+ dev.null() |
|
843 |
+ ef = dev.off2 |
|
836 | 844 |
} else { |
837 | 845 |
which = .ENV$current_annotation_which |
838 | 846 |
} |
839 | 847 |
|
848 |
+ on.exit(ef()) |
|
849 |
+ |
|
840 | 850 |
if(is.data.frame(x)) x = as.matrix(x) |
841 | 851 |
if(is.matrix(x)) { |
842 | 852 |
if(ncol(x) == 1) { |
... | ... |
@@ -1102,12 +1112,17 @@ anno_barplot = function(x, baseline = 0, which = c("column", "row"), border = TR |
1102 | 1112 |
} |
1103 | 1113 |
} |
1104 | 1114 |
|
1115 |
+ ef = function() NULL |
|
1105 | 1116 |
if(is.null(.ENV$current_annotation_which)) { |
1106 | 1117 |
which = match.arg(which)[1] |
1118 |
+ dev.null() |
|
1119 |
+ ef = dev.off2 |
|
1107 | 1120 |
} else { |
1108 | 1121 |
which = .ENV$current_annotation_which |
1109 | 1122 |
} |
1110 | 1123 |
|
1124 |
+ on.exit(ef()) |
|
1125 |
+ |
|
1111 | 1126 |
anno_size = anno_width_and_height(which, width, height, unit(1, "cm")) |
1112 | 1127 |
|
1113 | 1128 |
if(nc == 1) { |
... | ... |
@@ -1251,12 +1266,17 @@ anno_boxplot = function(x, which = c("column", "row"), border = TRUE, |
1251 | 1266 |
} |
1252 | 1267 |
} |
1253 | 1268 |
|
1269 |
+ ef = function() NULL |
|
1254 | 1270 |
if(is.null(.ENV$current_annotation_which)) { |
1255 | 1271 |
which = match.arg(which)[1] |
1272 |
+ dev.null() |
|
1273 |
+ ef = dev.off2 |
|
1256 | 1274 |
} else { |
1257 | 1275 |
which = .ENV$current_annotation_which |
1258 | 1276 |
} |
1259 | 1277 |
|
1278 |
+ on.exit(ef()) |
|
1279 |
+ |
|
1260 | 1280 |
anno_size = anno_width_and_height(which, width, height, unit(2, "cm")) |
1261 | 1281 |
|
1262 | 1282 |
## convert matrix all to list (or data frame) |
... | ... |
@@ -1451,12 +1471,17 @@ anno_histogram = function(x, which = c("column", "row"), n_breaks = 11, |
1451 | 1471 |
axis = TRUE, axis_param = default_axis_param(which), |
1452 | 1472 |
width = NULL, height = NULL) { |
1453 | 1473 |
|
1474 |
+ ef = function() NULL |
|
1454 | 1475 |
if(is.null(.ENV$current_annotation_which)) { |
1455 | 1476 |
which = match.arg(which)[1] |
1477 |
+ dev.null() |
|
1478 |
+ ef = dev.off2 |
|
1456 | 1479 |
} else { |
1457 | 1480 |
which = .ENV$current_annotation_which |
1458 | 1481 |
} |
1459 | 1482 |
|
1483 |
+ on.exit(ef()) |
|
1484 |
+ |
|
1460 | 1485 |
anno_size = anno_width_and_height(which, width, height, unit(4, "cm")) |
1461 | 1486 |
|
1462 | 1487 |
## convert matrix all to list (or data frame) |
... | ... |
@@ -1617,12 +1642,17 @@ anno_density = function(x, which = c("column", "row"), |
1617 | 1642 |
axis = TRUE, axis_param = default_axis_param(which), |
1618 | 1643 |
width = NULL, height = NULL) { |
1619 | 1644 |
|
1645 |
+ ef = function() NULL |
|
1620 | 1646 |
if(is.null(.ENV$current_annotation_which)) { |
1621 | 1647 |
which = match.arg(which)[1] |
1648 |
+ dev.null() |
|
1649 |
+ ef = dev.off2 |
|
1622 | 1650 |
} else { |
1623 | 1651 |
which = .ENV$current_annotation_which |
1624 | 1652 |
} |
1625 | 1653 |
|
1654 |
+ on.exit(ef()) |
|
1655 |
+ |
|
1626 | 1656 |
anno_size = anno_width_and_height(which, width, height, unit(4, "cm")) |
1627 | 1657 |
|
1628 | 1658 |
## convert matrix all to list (or data frame) |
... | ... |
@@ -1877,12 +1907,17 @@ anno_text = function(x, which = c("column", "row"), gp = gpar(), |
1877 | 1907 |
offset = guess_location(), location = guess_location(), |
1878 | 1908 |
width = NULL, height = NULL) { |
1879 | 1909 |
|
1910 |
+ ef = function() NULL |
|
1880 | 1911 |
if(is.null(.ENV$current_annotation_which)) { |
1881 | 1912 |
which = match.arg(which)[1] |
1913 |
+ dev.null() |
|
1914 |
+ ef = dev.off2 |
|
1882 | 1915 |
} else { |
1883 | 1916 |
which = .ENV$current_annotation_which |
1884 | 1917 |
} |
1885 | 1918 |
|
1919 |
+ on.exit(ef()) |
|
1920 |
+ |
|
1886 | 1921 |
n = length(x) |
1887 | 1922 |
gp = recycle_gp(gp, n) |
1888 | 1923 |
|
... | ... |
@@ -2023,12 +2058,17 @@ anno_joyplot = function(x, which = c("column", "row"), gp = gpar(fill = "#000000 |
2023 | 2058 |
axis = TRUE, axis_param = default_axis_param(which), |
2024 | 2059 |
width = NULL, height = NULL) { |
2025 | 2060 |
|
2061 |
+ ef = function() NULL |
|
2026 | 2062 |
if(is.null(.ENV$current_annotation_which)) { |
2027 | 2063 |
which = match.arg(which)[1] |
2064 |
+ dev.null() |
|
2065 |
+ ef = dev.off2 |
|
2028 | 2066 |
} else { |
2029 | 2067 |
which = .ENV$current_annotation_which |
2030 | 2068 |
} |
2031 | 2069 |
|
2070 |
+ on.exit(ef()) |
|
2071 |
+ |
|
2032 | 2072 |
anno_size = anno_width_and_height(which, width, height, unit(4, "cm")) |
2033 | 2073 |
|
2034 | 2074 |
## convert matrix all to list (or data frame) |
... | ... |
@@ -2219,12 +2259,17 @@ anno_horizon = function(x, which = c("column", "row"), |
2219 | 2259 |
axis = TRUE, axis_param = default_axis_param(which), |
2220 | 2260 |
width = NULL, height = NULL) { |
2221 | 2261 |
|
2262 |
+ ef = function() NULL |
|
2222 | 2263 |
if(is.null(.ENV$current_annotation_which)) { |
2223 | 2264 |
which = match.arg(which)[1] |
2265 |
+ dev.null() |
|
2266 |
+ ef = dev.off2 |
|
2224 | 2267 |
} else { |
2225 | 2268 |
which = .ENV$current_annotation_which |
2226 | 2269 |
} |
2227 | 2270 |
|
2271 |
+ on.exit(ef()) |
|
2272 |
+ |
|
2228 | 2273 |
anno_size = anno_width_and_height(which, width, height, unit(4, "cm")) |
2229 | 2274 |
|
2230 | 2275 |
## convert matrix all to list (or data frame) |
... | ... |
@@ -2818,12 +2863,17 @@ anno_summary = function(which = c("column", "row"), border = TRUE, bar_width = 0 |
2818 | 2863 |
pch = 1, size = unit(2, "mm"), gp = gpar(), |
2819 | 2864 |
width = NULL, height = NULL) { |
2820 | 2865 |
|
2866 |
+ ef = function() NULL |
|
2821 | 2867 |
if(is.null(.ENV$current_annotation_which)) { |
2822 | 2868 |
which = match.arg(which)[1] |
2869 |
+ dev.null() |
|
2870 |
+ ef = dev.off2 |
|
2823 | 2871 |
} else { |
2824 | 2872 |
which = .ENV$current_annotation_which |
2825 | 2873 |
} |
2826 | 2874 |
|
2875 |
+ on.exit(ef()) |
|
2876 |
+ |
|
2827 | 2877 |
anno_size = anno_width_and_height(which, width, height, unit(2, "cm")) |
2828 | 2878 |
|
2829 | 2879 |
axis_param = validate_axis_param(axis_param, which) |
... | ... |
@@ -2981,10 +3031,10 @@ anno_block = function(gp = gpar(), labels = NULL, labels_gp = gpar(), labels_rot |
2981 | 3031 |
if(length(labels)) { |
2982 | 3032 |
if(which == "column") { |
2983 | 3033 |
height = grobHeight(textGrob(labels, rot = labels_rot, gp = labels_gp)) |
2984 |
- height = convertHeight(height, "mm") + unit(5, "mm") |
|
3034 |
+ height = height + unit(5, "mm") |
|
2985 | 3035 |
} else { |
2986 | 3036 |
width = grobWidth(textGrob(labels, rot = labels_rot, gp = labels_gp)) |
2987 |
- width = convertWidth(width, "mm") + unit(5, "mm") |
|
3037 |
+ width = width + unit(5, "mm") |
|
2988 | 3038 |
} |
2989 | 3039 |
} |
2990 | 3040 |
|
... | ... |
@@ -164,9 +164,7 @@ annotation_axis_grob = function(at = NULL, labels = at, labels_rot = 0, gp = gpa |
164 | 164 |
h = unit(1, "npc") |
165 | 165 |
attr(gb, "width") = w |
166 | 166 |
attr(gb, "height") = h |
167 |
- } |
|
168 |
- |
|
169 |
- if(side == "top" && facing == "inside") { |
|
167 |
+ } else if(side == "top" && facing == "inside") { |
|
170 | 168 |
gl = gList( |
171 | 169 |
linesGrob(unit(c(0, 1), "npc"), unit(c(1, 1), "npc"), gp = gp), |
172 | 170 |
segmentsGrob(at, unit(1, "npc") - unit(1, "mm"), at, unit(1, "npc"), |
173 | 171 |
deleted file mode 100644 |
... | ... |
@@ -1,112 +0,0 @@ |
1 |
- |
|
2 |
-graphicsDevice = function(name, dim = c(1024, 768), col = "black", fill = "transparent", ps = 10, ..., |
|
3 |
- funcs = list(...), ipr = rep(1/72.27, 2)) { |
|
4 |
- |
|
5 |
- |
|
6 |
- dim = as.integer(dim) |
|
7 |
- |
|
8 |
- col = as(col, "RGBInt") |
|
9 |
- fill = as(fill, "RGBInt") |
|
10 |
- |
|
11 |
- dev = .Call("R_createGraphicsDevice", funcs, as.character(name), dim, col, fill, as.integer(ps), |
|
12 |
- list(funcs@initDevice, funcs@GEInitDevice), ipr) |
|
13 |
- invisible(dev) |
|
14 |
-}) |
|
15 |
- |
|
16 |
-empty_dev = function() { |
|
17 |
- funs = dummyDevice() |
|
18 |
- graphicsDevice(name = "empty_dev", funcs = funs) |
|
19 |
-} |
|
20 |
- |
|
21 |
- |
|
22 |
-dummy_dev = |
|
23 |
- |
|
24 |
-> funs |
|
25 |
-An object of class "RDevDescMethods" |
|
26 |
-Slot "activate": |
|
27 |
-NULL |
|
28 |
- |
|
29 |
-Slot "circle": |
|
30 |
-NULL |
|
31 |
- |
|
32 |
-Slot "clip": |
|
33 |
-NULL |
|
34 |
- |
|
35 |
-Slot "close": |
|
36 |
-NULL |
|
37 |
- |
|
38 |
-Slot "deactivate": |
|
39 |
-NULL |
|
40 |
- |
|
41 |
-Slot "locator": |
|
42 |
-NULL |
|
43 |
- |
|
44 |
-Slot "line": |
|
45 |
-NULL |
|
46 |
- |
|
47 |
-Slot "metricInfo": |
|
48 |
-function (char, gc, ascent, descent, width, dev) |
|
49 |
-{ |
|
50 |
- width[1] = gc$ps * gc$cex |
|
51 |
- ascent[1] = 1 |
|
52 |
- descent[1] = 0.25 |
|
53 |
-} |
|
54 |
-<environment: 0x2351d48> |
|
55 |
- |
|
56 |
-Slot "mode": |
|
57 |
-NULL |
|
58 |
- |
|
59 |
-Slot "newPage": |
|
60 |
-NULL |
|
61 |
- |
|
62 |
-Slot "polygon": |
|
63 |
-NULL |
|
64 |
- |
|
65 |
-Slot "polyline": |
|
66 |
-NULL |
|
67 |
- |
|
68 |
-Slot "rect": |
|
69 |
-NULL |
|
70 |
- |
|
71 |
-Slot "size": |
|
72 |
-function (left, right, bottom, top, dev) |
|
73 |
-{ |
|
74 |
- right[1] = dev$right |
|
75 |
- bottom[1] = dev$bottom |
|
76 |
-} |
|
77 |
-<environment: 0x2266248> |
|
78 |
- |
|
79 |
-Slot "strWidth": |
|
80 |
-function (str, gc, dev) |
|
81 |
-{ |
|
82 |
- gc$cex * gc$ps * nchar(str) |
|
83 |
-} |
|
84 |
-<environment: 0x2351d48> |
|
85 |
- |
|
86 |
-Slot "text": |
|
87 |
-NULL |
|
88 |
- |
|
89 |
-Slot "onExit": |
|
90 |
-NULL |
|
91 |
- |
|
92 |
-Slot "getEvent": |
|
93 |
-NULL |
|
94 |
- |
|
95 |
-Slot "newFrameConfirm": |
|
96 |
-NULL |
|
97 |
- |
|
98 |
-Slot "textUTF8": |
|
99 |
-NULL |
|
100 |
- |
|
101 |
-Slot "strWidthUTF8": |
|
102 |
-NULL |
|
103 |
- |
|
104 |
-Slot "initDevice": |
|
105 |
-NULL |
|
106 |
- |
|
107 |
-Slot "GEInitDevice": |
|
108 |
-NULL |
|
109 |
- |
|
110 |
-Slot "state": |
|
111 |
-NULL |
|
112 |
- |
... | ... |
@@ -11,8 +11,8 @@ Method dispatch page for \code{add_heatmap}. |
11 | 11 |
|
12 | 12 |
\itemize{ |
13 | 13 |
\item \code{\link{add_heatmap,HeatmapAnnotation-method}}, \code{\link{HeatmapAnnotation-class}} class method |
14 |
-\item \code{\link{add_heatmap,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
15 | 14 |
\item \code{\link{add_heatmap,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method |
15 |
+\item \code{\link{add_heatmap,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
16 | 16 |
} |
17 | 17 |
} |
18 | 18 |
\examples{ |
... | ... |
@@ -10,8 +10,8 @@ Method dispatch page for \code{column_order}. |
10 | 10 |
\code{column_order} can be dispatched on following classes: |
11 | 11 |
|
12 | 12 |
\itemize{ |
13 |
-\item \code{\link{column_order,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
14 | 13 |
\item \code{\link{column_order,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method |
14 |
+\item \code{\link{column_order,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
15 | 15 |
} |
16 | 16 |
} |
17 | 17 |
\examples{ |
... | ... |
@@ -10,8 +10,8 @@ Method dispatch page for \code{component_height}. |
10 | 10 |
\code{component_height} can be dispatched on following classes: |
11 | 11 |
|
12 | 12 |
\itemize{ |
13 |
-\item \code{\link{component_height,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
14 | 13 |
\item \code{\link{component_height,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method |
14 |
+\item \code{\link{component_height,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
15 | 15 |
} |
16 | 16 |
} |
17 | 17 |
\examples{ |
... | ... |
@@ -10,8 +10,8 @@ Method dispatch page for \code{copy_all}. |
10 | 10 |
\code{copy_all} can be dispatched on following classes: |
11 | 11 |
|
12 | 12 |
\itemize{ |
13 |
-\item \code{\link{copy_all,SingleAnnotation-method}}, \code{\link{SingleAnnotation-class}} class method |
|
14 | 13 |
\item \code{\link{copy_all,AnnotationFunction-method}}, \code{\link{AnnotationFunction-class}} class method |
14 |
+\item \code{\link{copy_all,SingleAnnotation-method}}, \code{\link{SingleAnnotation-class}} class method |
|
15 | 15 |
} |
16 | 16 |
} |
17 | 17 |
\examples{ |
... | ... |
@@ -10,12 +10,12 @@ Method dispatch page for \code{draw}. |
10 | 10 |
\code{draw} can be dispatched on following classes: |
11 | 11 |
|
12 | 12 |
\itemize{ |
13 |
-\item \code{\link{draw,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method |
|
14 |
-\item \code{\link{draw,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
15 |
-\item \code{\link{draw,SingleAnnotation-method}}, \code{\link{SingleAnnotation-class}} class method |
|
16 |
-\item \code{\link{draw,Legends-method}}, \code{\link{Legends-class}} class method |
|
17 | 13 |
\item \code{\link{draw,AnnotationFunction-method}}, \code{\link{AnnotationFunction-class}} class method |
14 |
+\item \code{\link{draw,Legends-method}}, \code{\link{Legends-class}} class method |
|
18 | 15 |
\item \code{\link{draw,HeatmapAnnotation-method}}, \code{\link{HeatmapAnnotation-class}} class method |
16 |
+\item \code{\link{draw,SingleAnnotation-method}}, \code{\link{SingleAnnotation-class}} class method |
|
17 |
+\item \code{\link{draw,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method |
|
18 |
+\item \code{\link{draw,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
19 | 19 |
} |
20 | 20 |
} |
21 | 21 |
\examples{ |
... | ... |
@@ -10,8 +10,8 @@ Method dispatch page for \code{draw_title}. |
10 | 10 |
\code{draw_title} can be dispatched on following classes: |
11 | 11 |
|
12 | 12 |
\itemize{ |
13 |
-\item \code{\link{draw_title,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
14 | 13 |
\item \code{\link{draw_title,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method |
14 |
+\item \code{\link{draw_title,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
15 | 15 |
} |
16 | 16 |
} |
17 | 17 |
\examples{ |
... | ... |
@@ -10,8 +10,8 @@ Method dispatch page for \code{make_layout}. |
10 | 10 |
\code{make_layout} can be dispatched on following classes: |
11 | 11 |
|
12 | 12 |
\itemize{ |
13 |
-\item \code{\link{make_layout,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
14 | 13 |
\item \code{\link{make_layout,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method |
14 |
+\item \code{\link{make_layout,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
15 | 15 |
} |
16 | 16 |
} |
17 | 17 |
\examples{ |
... | ... |
@@ -10,12 +10,12 @@ Method dispatch page for \code{show}. |
10 | 10 |
\code{show} can be dispatched on following classes: |
11 | 11 |
|
12 | 12 |
\itemize{ |
13 |
-\item \code{\link{show,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method |
|
14 |
-\item \code{\link{show,SingleAnnotation-method}}, \code{\link{SingleAnnotation-class}} class method |
|
15 | 13 |
\item \code{\link{show,ColorMapping-method}}, \code{\link{ColorMapping-class}} class method |
16 |
-\item \code{\link{show,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
17 | 14 |
\item \code{\link{show,AnnotationFunction-method}}, \code{\link{AnnotationFunction-class}} class method |
18 | 15 |
\item \code{\link{show,HeatmapAnnotation-method}}, \code{\link{HeatmapAnnotation-class}} class method |
16 |
+\item \code{\link{show,SingleAnnotation-method}}, \code{\link{SingleAnnotation-class}} class method |
|
17 |
+\item \code{\link{show,HeatmapList-method}}, \code{\link{HeatmapList-class}} class method |
|
18 |
+\item \code{\link{show,Heatmap-method}}, \code{\link{Heatmap-class}} class method |
|
19 | 19 |
} |
20 | 20 |
} |
21 | 21 |
\examples{ |
22 | 22 |
deleted file mode 100644 |
... | ... |
@@ -1,566 +0,0 @@ |
1 |
-#include "RConverters.h" |
|
2 |
-#include "Rdefines.h" |
|
3 |
- |
|
4 |
-#include <stdio.h> |
|
5 |
- |
|
6 |
-int |
|
7 |
-R_isVariableReference(SEXP arg) |
|
8 |
-{ |
|
9 |
- SEXP e, ans; |
|
10 |
- int val; |
|
11 |
- |
|
12 |
- PROTECT(e = allocVector(LANGSXP, 3)); |
|
13 |
- SETCAR(e, Rf_install("is")); |
|
14 |
- SETCAR(CDR(e), arg); |
|
15 |
- SETCAR(CDR(CDR(e)), mkString("VariableReference")); |
|
16 |
- ans = Rf_eval(e, R_GlobalEnv); |
|
17 |
- val = INTEGER(ans)[0]; |
|
18 |
- UNPROTECT(1); |
|
19 |
- return(val); |
|
20 |
-} |
|
21 |
- |
|
22 |
-void * |
|
23 |
-getVariableReference(SEXP arg, SEXP el, const char *type, const char *tag) |
|
24 |
-{ |
|
25 |
- char tmp[256]; |
|
26 |
- sprintf(tmp, "%sRef", tag); |
|
27 |
- return(R_getNativeReference(el, type, tmp)); |
|
28 |
-} |
|
29 |
- |
|
30 |
-SEXP |
|
31 |
-R_make_var_reference(void *ref, const char * const type) |
|
32 |
-{ |
|
33 |
- SEXP ans; |
|
34 |
- SEXP klass = MAKE_CLASS("VariableReference"); |
|
35 |
- PROTECT(klass); |
|
36 |
- PROTECT(ans = NEW(klass)); |
|
37 |
-#ifdef DEBUG_R_RUNTIME |
|
38 |
- fprintf(stderr, "variable reference %p\n", ref); |
|
39 |
-#endif |
|
40 |
- SET_SLOT(ans, Rf_install("ref"), R_createNativeReference(ref, type, type)); |
|
41 |
- UNPROTECT(2); |
|
42 |
- |
|
43 |
- return(ans); |
|
44 |
-} |
|
45 |
- |
|
46 |
- |
|
47 |
-SEXP |
|
48 |
-R_createArrayReference(const void * ref, const char * const className, const char * const alias, |
|
49 |
- int *dims, unsigned int numDims, size_t sizeofElement) |
|
50 |
-{ |
|
51 |
- SEXP ans, r_dims; |
|
52 |
- SEXP klass = MAKE_CLASS(className); |
|
53 |
- int i; |
|
54 |
- |
|
55 |
- PROTECT(klass); |
|
56 |
- PROTECT(ans = NEW(klass)); |
|
57 |
- SET_SLOT(ans, Rf_install("ref"), R_MakeExternalPtr((void *) ref, Rf_install(alias), R_NilValue)); |
|
58 |
- PROTECT(r_dims = NEW_INTEGER(numDims)); |
|
59 |
- for(i = 0; i < numDims; i++) INTEGER(r_dims)[i] = dims[i]; |
|
60 |
- SET_SLOT(ans, Rf_install("length"), r_dims); |
|
61 |
- SET_SLOT(ans, Rf_install("elementSize"), ScalarInteger(sizeofElement)); |
|
62 |
- UNPROTECT(3); |
|
63 |
- |
|
64 |
- return(ans); |
|
65 |
-} |
|
66 |
- |
|
67 |
- |
|
68 |
- |
|
69 |
- |
|
70 |
-SEXP |
|
71 |
-R_createNativeReference(const void *val, const char *className, const char *tagName) |
|
72 |
-{ |
|
73 |
- SEXP ans; |
|
74 |
- SEXP klass = MAKE_CLASS((char *) className); |
|
75 |
- |
|
76 |
- if(klass == R_NilValue) { |
|
77 |
- PROBLEM "Can't find class %s", className |
|
78 |
- ERROR; |
|
79 |
- } |
|
80 |
- |
|
81 |
- /* should check this extends RC++Reference.. */ |
|
82 |
- PROTECT(klass); |
|
83 |
- PROTECT(ans = NEW(klass)); |
|
84 |
- |
|
85 |
- ans = SET_SLOT(ans, Rf_install("ref"), R_MakeExternalPtr((void *) val, Rf_install(tagName), R_NilValue)); |
|
86 |
- |
|
87 |
- UNPROTECT(2); |
|
88 |
- return(ans); |
|
89 |
-} |
|
90 |
- |
|
91 |
-void * |
|
92 |
-R_getNativeReference(SEXP arg, const char *type, const char *tag) |
|
93 |
-{ |
|
94 |
- SEXP el, elTag; |
|
95 |
- void *ans; |
|
96 |
- |
|
97 |
- el = GET_SLOT(arg, Rf_install("ref")); |
|
98 |
- if(R_isVariableReference(arg)) { |
|
99 |
- void *tmp; |
|
100 |
- tmp = getVariableReference(arg, el, type, tag); |
|
101 |
- if(!tmp) { |
|
102 |
- PROBLEM "Got null value for variable reference %s", type |
|
103 |
- ERROR; |
|
104 |
- } |
|
105 |
- return(tmp); |
|
106 |
- } |
|
107 |
- |
|
108 |
- |
|
109 |
-/* XXX added allow through if the TAG is null on the object. Just for now. */ |
|
110 |
- if(tag && tag[0] && (elTag = R_ExternalPtrTag(el)) && elTag != Rf_install(tag)) { |
|
111 |
- |
|
112 |
- /* So not a direct match. Now see if it is from a derived class |
|
113 |
- by comparing the value in the object to the name of each of the |
|
114 |
- ancestor classes. |
|
115 |
- */ |
|
116 |
- SEXP ancestors = GET_SLOT(arg, Rf_install("classes")); |
|
117 |
- int n, i; |
|
118 |
- n = Rf_length(ancestors); |
|
119 |
- for(i = 0; i < n ; i ++) { |
|
120 |
- if(strcmp(CHAR(STRING_ELT(ancestors, i)), tag) == 0) |
|
121 |
- break; |
|
122 |
- } |
|
123 |
- if(i == n) { |
|
124 |
- PROBLEM "Looking for %s, got %s", |
|
125 |
- tag, elTag != R_NilValue ? CHAR(PRINTNAME(elTag)) : "NULL" |
|
126 |
- ERROR; |
|
127 |
- } |
|
128 |
- } |
|
129 |
- |
|
130 |
- ans = R_ExternalPtrAddr(el); |
|
131 |
- |
|
132 |
- if(!ans) { |
|
133 |
- PROBLEM "NULL value passed to R_getNativeReference. This may not be an error, but it could be.\n Have you loaded an object from a previous R session?" |
|
134 |
- ERROR; |
|
135 |
- } |
|
136 |
- return(ans); |
|
137 |
-} |
|
138 |
- |
|
139 |
- |
|
140 |
-int |
|
141 |
-convertFromRToInt(SEXP obj) |
|
142 |
-{ |
|
143 |
- return(INTEGER(obj)[0]); |
|
144 |
-} |
|
145 |
- |
|
146 |
- |
|
147 |
-SEXP |
|
148 |
-convertIntToR(int x) |
|
149 |
-{ |
|
150 |
- SEXP ans; |
|
151 |
- ans = allocVector(INTSXP, 1); |
|
152 |
- INTEGER(ans)[0] = x; |
|
153 |
- return(ans); |
|
154 |
-} |
|
155 |
- |
|
156 |
-SEXP |
|
157 |
-convertDoubleToR(double x) |
|
158 |
-{ |
|
159 |
- SEXP ans; |
|
160 |
- ans = allocVector(REALSXP, 1); |
|
161 |
- REAL(ans)[0] = x; |
|
162 |
- return(ans); |
|
163 |
-} |
|
164 |
- |
|
165 |
-SEXP |
|
166 |
-convertDoubleArrayToR(int len, const double *x, int copy, int start, int end) |
|
167 |
-{ |
|
168 |
- SEXP ans; |
|
169 |
- int i, num; |
|
170 |
- |
|
171 |
- num = end - start + 1; |
|
172 |
- ans = allocVector(REALSXP, num); |
|
173 |
- for(i = 0; i < num ; i++) |
|
174 |
- REAL(ans)[i] = x[i + start]; |
|
175 |
- return(ans); |
|
176 |
-} |
|
177 |
- |
|
178 |
-#define MIN(a, b) ((a) < (b) ? (a) : (b)) |
|
179 |
- |
|
180 |
-void |
|
181 |
-convertRCharacterToCharArray(char *dest, SEXP r_value, int array_len) |
|
182 |
-{ |
|
183 |
- int i; |
|
184 |
- int len; |
|
185 |
- |
|
186 |
- len = MIN(Rf_length(r_value), array_len); |
|
187 |
- for(i = 0; i < len; i++) |
|
188 |
- dest[i] = CHAR(STRING_ELT(r_value, i))[0]; |
|
189 |
-} |
|
190 |
- |
|
191 |
-SEXP |
|
192 |
-convertCharArrayToR(int dim, const char *x, int copy, int start, int end) |
|
193 |
-{ |
|
194 |
- SEXP ans; |
|
195 |
- int i, num; |
|
196 |
- char buf[2]; |
|
197 |
- |
|
198 |
- buf[1] = '\0'; |
|
199 |
- num = end - start + 1; |
|
200 |
- PROTECT(ans = allocVector(STRSXP, num)); |
|
201 |
- for(i = 0; i < num ; i++) { |
|
202 |
- buf[0] = x[i + start]; |
|
203 |
- SET_STRING_ELT(ans, i, mkChar(buf)); |
|
204 |
- } |
|
205 |
- UNPROTECT(1); |
|
206 |
- return(ans); |
|
207 |
-} |
|
208 |
- |
|
209 |
- |
|
210 |
-#if 0 |
|
211 |
-/* Why are these commented out? Because we generate them programmatically. |
|
212 |
- |
|
213 |
- convertDoubleArrayToR. |
|
214 |
-*/ |
|
215 |
-SEXP |
|
216 |
-convertIntArrayToR(const int *x, int len, int start, int end) |
|
217 |
-{ |
|
218 |
- SEXP ans; |
|
219 |
- int i; |
|
220 |
- |
|
221 |
- |
|
222 |
- ans = allocVector(INTSXP, len); |
|
223 |
- for(i = 0; i < len ; i++) |
|
224 |
- INTEGER(ans)[i] = x[i]; |
|
225 |
- return(ans); |
|
226 |
-} |
|
227 |
- |
|
228 |
- |
|
229 |
-SEXP |
|
230 |
-convertUnsignedIntArrayToR(const unsigned int *x, int len) |
|
231 |
-{ |
|
232 |
- SEXP ans; |
|
233 |
- int i; |
|
234 |
- |
|
235 |
- ans = allocVector(REALSXP, len); |
|
236 |
- for(i = 0; i < len ; i++) |
|
237 |
- REAL(ans)[i] = x[i]; |
|
238 |
- return(ans); |
|
239 |
-} |
|
240 |
-#endif |
|
241 |
- |
|
242 |
- |
|
243 |
- |
|
244 |
-SEXP |
|
245 |
-convertStringArrayToR(const char * const *x, int len) |
|
246 |
-{ |
|
247 |
- SEXP ans; |
|
248 |
- int i; |
|
249 |
- |
|
250 |
- PROTECT(ans = allocVector(STRSXP, len)); |
|
251 |
- for(i = 0; i < len ; i++) |
|
252 |
- SET_STRING_ELT(ans, i, mkChar(x[i] ? x[i] : "")); |
|
253 |
- UNPROTECT(1); |
|
254 |
- return(ans); |
|
255 |
-} |
|
256 |
- |
|
257 |
- |
|
258 |
- |
|
259 |
-SEXP |
|
260 |
-createREnumerationValue(int val, const char * const *names, const int *values, int namesLength, const char *name) |
|
261 |
-{ |
|
262 |
- SEXP ans; |
|
263 |
- int i; |
|
264 |
- |
|
265 |
- PROTECT(ans =allocVector(INTSXP, 1)); |
|
266 |
- INTEGER(ans)[0] = val; |
|
267 |
- |
|
268 |
- for(i = 0; i < namesLength; i++) { |
|
269 |
- if(val == values[i]) { |
|
270 |
- SET_NAMES(ans, mkString(names[i])); |
|
271 |
- break; |
|
272 |
- } |
|
273 |
- } |
|
274 |
- |
|
275 |
- if(i == namesLength) { |
|
276 |
- PROBLEM "Unrecognized value (%d) in enumeration %s", val, name |
|
277 |
- ERROR; |
|
278 |
- } |
|
279 |
- /* Do we want an enumeration value element here also. */ |
|
280 |
- SET_CLASS(ans, mkString(name)); |
|
281 |
- |
|
282 |
- UNPROTECT(1); |
|
283 |
- return(ans); |
|
284 |
-} |
|
285 |
- |
|
286 |
- |
|
287 |
-/* |
|
288 |
- Finalize for deallocating the space we allocate for references to structures |
|
289 |
- created in S as part of the automatically generated code. |
|
290 |
- */ |
|
291 |
-void |
|
292 |
-SimpleAllocFinalizer(SEXP ans) |
|
293 |
-{ |
|
294 |
- void *ptr = R_ExternalPtrAddr(ans); |
|
295 |
- if(ptr) { |
|
296 |
-#ifdef DEBUG_R_RUNTIME |
|
297 |
- fprintf(stderr, "Finalizing %p\n", ptr); fflush(stderr); |
|
298 |
-#endif |
|
299 |
- free(ptr); |
|
300 |
- R_ClearExternalPtr(ans); |
|
301 |
- } |
|
302 |
-} |
|
303 |
- |
|
304 |
-/** |
|
305 |
- Convert R object into either a function or the address of a C routine. |
|
306 |
- For a C routine, the caller can specify the name of the typedef which is |
|
307 |
- checked using the TAG for the external pointer. |
|
308 |
-*/ |
|
309 |
-void * |
|
310 |
-Rfrom_Callbable(SEXP obj, const char * const TypeDefName, CallableType *type) |
|
311 |
-{ |
|
312 |
- |
|
313 |
- /* If TypeDefName is NULL, we don't bother checking*/ |
|
314 |
- if(TYPEOF(obj) == EXTPTRSXP) { |
|
315 |
- if(TypeDefName && R_ExternalPtrTag(obj) != Rf_install(TypeDefName)) { |
|
316 |
- PROBLEM "[RfromCallbable] incorrect type name for a native routine pointer %s, not %s", |
|
317 |
- CHAR(asChar(R_ExternalPtrTag(obj))), TypeDefName |
|
318 |
- ERROR; |
|
319 |
- } |
|
320 |
- |
|
321 |
- if(type) |
|
322 |
- *type = NATIVE_ROUTINE; |
|
323 |
- |
|
324 |
- return(R_ExternalPtrAddr(obj)); |
|
325 |
- } else if(TYPEOF(obj) == CLOSXP) { |
|
326 |
- if(type) |
|
327 |
- *type = R_FUNCTION; |
|
328 |
- return(obj); |
|
329 |
- } |
|
330 |
- |
|
331 |
- PROBLEM "the Rfrom_Callable routine only handles native routines and " |
|
332 |
- ERROR; |
|
333 |
- |
|
334 |
- return((void *) NULL); |
|
335 |
- } |
|
336 |
- |
|
337 |
- |
|
338 |
-SEXP |
|
339 |
-R_makeNames(const char *names[], int len) |
|
340 |
-{ |
|
341 |
- SEXP ans; |
|
342 |
- int i; |
|
343 |
- PROTECT(ans = NEW_CHARACTER(len)); |
|
344 |
- for(i = 0; i < len; i++) |
|
345 |
- SET_STRING_ELT(ans, i, mkChar(names[i])); |
|
346 |
- UNPROTECT(1); |
|
347 |
- |
|
348 |
- return(ans); |
|
349 |
-} |
|
350 |
- |
|
351 |
-typedef struct { |
|
352 |
- void **els; |
|
353 |
- unsigned long length; |
|
354 |
-} RPointerList; |
|
355 |
- |
|
356 |
-SEXP |
|
357 |
-R_listToRefArray(SEXP r_els, SEXP r_type) |
|
358 |
-{ |
|
359 |
- const char *type; |
|
360 |
- SEXP el; |
|
361 |
- int i, n; |
|
362 |
- void *tmp; |
|
363 |
- RPointerList *ans; |
|
364 |
- |
|
365 |
- n = GET_LENGTH(r_els); |
|
366 |
- ans = (RPointerList *) malloc(sizeof(RPointerList)); |
|
367 |
- ans->els = (void **) malloc(sizeof(void *) * n); |
|
368 |
- |
|
369 |
- for(i = 0; i < n; i++) { |
|
370 |
- el = VECTOR_ELT(r_els, i); |
|
371 |
- tmp = R_getNativeReference(el, type, type); |
|
372 |
- ans->els[i] = tmp; |
|
373 |
- } |
|
374 |
- /*XXX Need finalizer */ |
|
375 |
- return(R_MAKE_REF_TYPE(ans, RPointerList)); |
|
376 |
-} |
|
377 |
- |
|
378 |
- |
|
379 |
-SEXP |
|
380 |
-R_RPointerList_length(SEXP r_ref) |
|
381 |
-{ |
|
382 |
- RPointerList *l = R_GET_REF_TYPE(r_ref, RPointerList); |
|
383 |
- return(ScalarReal(l->length)); |
|
384 |
-} |
|
385 |
- |
|
386 |
- |
|
387 |
-char ** |
|
388 |
-getRStringArray(SEXP els) |
|
389 |
-{ |
|
390 |
- char **ans; |
|
391 |
- int i, len; |
|
392 |
- |
|
393 |
- len = GET_LENGTH(els); |
|
394 |
- if(len == 0) |
|
395 |
- return(NULL); |
|
396 |
- ans = (char **) malloc(sizeof(char *) * len); |
|
397 |
- for(i = 0; i < len ; i++) |
|
398 |
- ans[i] = strdup(CHAR(STRING_ELT(els, i))); |
|
399 |
- return(ans); |
|
400 |
-} |
|
401 |
- |
|
402 |
- |
|
403 |
- |
|
404 |
-/* |
|
405 |
- Determine if obj is an instance of the class given by className |
|
406 |
- which should be an S4 class. |
|
407 |
-*/ |
|
408 |
-Rboolean |
|
409 |
-IS_S4_INSTANCE(SEXP obj, const char *className) |
|
410 |
-{ |
|
411 |
- SEXP e, ans; |
|
412 |
- Rboolean status; |
|
413 |
- |
|
414 |
- if(!IS_S4_OBJECT(obj)) |
|
415 |
- return(FALSE); |
|
416 |
- |
|
417 |
- PROTECT(e = allocVector(LANGSXP, 3)); |
|
418 |
- SETCAR(e, Rf_install("is")); |
|
419 |
- SETCAR(CDR(e), obj); |
|
420 |
- SETCAR(CDR(CDR(e)), mkString(className)); |
|
421 |
- ans = eval(e, R_GlobalEnv); |
|
422 |
- status = LOGICAL(ans)[0]; |
|
423 |
- UNPROTECT(1); |
|
424 |
- return(status); |
|
425 |
-} |
|
426 |
- |
|
427 |
- |
|
428 |
- |
|
429 |
-#ifdef __cplusplus |
|
430 |
-extern "C" |
|
431 |
-#endif |
|
432 |
-SEXP |
|
433 |
-R_new_int(SEXP r_value) |
|
434 |
-{ |
|
435 |
- int *val = (int *) malloc(sizeof(int)); |
|
436 |
- if(!val) { |
|
437 |
- PROBLEM "cannot allocate space for a single integer" |
|
438 |
- ERROR; |
|
439 |
- } |
|
440 |
- |
|
441 |
- return(R_createNativeReference((void *) val, "intPtr", "intPtr")); |
|
442 |
-} |
|
443 |
- |
|
444 |
- |
|
445 |
-#ifdef __cplusplus |
|
446 |
-extern "C" |
|
447 |
-#endif |
|
448 |
-SEXP |
|
449 |
-R_new_long_int(SEXP r_value) |
|
450 |
-{ |
|
451 |
- void *val = malloc(sizeof(long int)); |
|
452 |
- if(!val) { |
|
453 |
- PROBLEM "cannot allocate space for a single long int" |
|
454 |
- ERROR; |
|
455 |
- } |
|
456 |
- |
|
457 |
- return(R_createNativeReference((void *) val, "long_intPtr", "long_intPtr")); |
|
458 |
-} |
|
459 |
- |
|
460 |
- |
|
461 |
-void * |
|
462 |
-R_asFunctionPointer(SEXP r_val, void *defaultFun, void *stack) |
|
463 |
-{ |
|
464 |
- if(TYPEOF(r_val) == CLOSXP) { |
|
465 |
-// put on the relevant stack |
|
466 |
- return(defaultFun); |
|
467 |
- } else if(TYPEOF(r_val) == EXTPTRSXP) { |
|
468 |
- return(R_ExternalPtrAddr(r_val)); |
|
469 |
- } |
|
470 |
- |
|
471 |
- return(NULL); |
|
472 |
-} |
|
473 |
- |
|
474 |
- |
|
475 |
-#ifdef __cplusplus |
|
476 |
-extern "C" |
|
477 |
-#endif |
|
478 |
-SEXP |
|
479 |
-R_duplicateArray(SEXP r_ref, SEXP r_size, SEXP r_elementDup) |
|
480 |
-{ |
|
481 |
- void *array, *copy; |
|
482 |
- size_t numBytes = (size_t) REAL(r_size)[0]; |
|
483 |
- SEXP r_ans, tmp; |
|
484 |
- |
|
485 |
- array = R_getNativeReference(r_ref, NULL, NULL); |
|
486 |
- copy = malloc( numBytes ); |
|
487 |
- if(!copy) { |
|
488 |
- PROBLEM "Cannot allocate %lf bytes to copy native array", REAL(r_size)[0] |
|
489 |
- ERROR; |
|
490 |
- } |
|
491 |
- memcpy(copy, array, numBytes); |
|
492 |
- tmp = GET_SLOT(r_ref, Rf_install("ref")); |
|
493 |
- r_ans = R_MakeExternalPtr(copy, R_ExternalPtrTag(tmp), R_ExternalPtrProtected(tmp)); |
|
494 |
- return(r_ans); |
|
495 |
-} |
|
496 |
- |
|
497 |
- |
|
498 |
- |
|
499 |
-#ifdef __cplusplus |
|
500 |
-extern "C" |
|
501 |
-#endif |
|
502 |
-SEXP |
|
503 |
-R_isNativeNull(SEXP ext) |
|
504 |
-{ |
|
505 |
- return(ScalarLogical(R_ExternalPtrAddr(ext) == NULL)); |
|
506 |
-} |
|
507 |
- |
|
508 |
- |
|
509 |
-#ifdef __cplusplus |
|
510 |
-extern "C" |
|
511 |
-#endif |
|
512 |
-SEXP |
|
513 |
-R_addressOfPointer(SEXP ext) |
|
514 |
-{ |
|
515 |
-/* Need to know the tag and the protected for the external pointer. |
|
516 |
-Leave to R code to put in the correct class. |
|
517 |
-*/ |
|
518 |
- void *p = R_ExternalPtrAddr(ext); |
|
519 |
- |
|
520 |
- return(R_NilValue); |
|
521 |
-} |
|
522 |
- |
|
523 |
- |
|
524 |
-#include <stdarg.h> |
|
525 |
- |
|
526 |
-SEXP |
|
527 |
-createRRoutineReference(void *fun, const char * const routineName, const char * const returnTypeName, unsigned int numParams, ...) |
|
528 |
-{ |
|
529 |
- SEXP ans, klass, tmp; |
|
530 |
- va_list args; |
|
531 |
- |
|
532 |
- PROTECT(klass = MAKE_CLASS("CRoutineRef")); |
|
533 |
- PROTECT(ans = NEW(klass)); |
|
534 |
- SET_SLOT(ans, Rf_install("ref"), R_MakeExternalPtr(fun, Rf_install("CRoutine"), R_NilValue)); |
|
535 |
- if(routineName) |
|
536 |
- SET_SLOT(ans, Rf_install("name"), ScalarString(mkChar(routineName))); |
|
537 |
- SET_SLOT(ans, Rf_install("returnType"), ScalarString(mkChar(returnTypeName))); |
|
538 |
- SET_SLOT(ans, Rf_install("numParameters"), ScalarInteger(numParams)); |
|
539 |
- |
|
540 |
- if(numParams > 0) { |
|
541 |
- PROTECT( tmp = NEW_CHARACTER(numParams)); |
|
542 |
- va_start(args, numParams); |
|
543 |
- for(int i = 0; i < numParams; i++) |
|
544 |
- SET_STRING_ELT(tmp, i, mkChar(va_arg(args, const char * const))); |
|
545 |
- SET_SLOT(ans, Rf_install("parameterTypes"), tmp); |
|
546 |
- va_end(args); |
|
547 |
- UNPROTECT(1); |
|
548 |
- } |
|
549 |
- |
|
550 |
- |
|
551 |
- UNPROTECT(2); |
|
552 |
- return(ans); |
|
553 |
-} |
|
554 |
- |
|
555 |
- |
|
556 |
-#define GET_EXT_PTR_REF(x) \ |
|
557 |
- (TYPEOF((x)) == EXTPTRSXP ? R_ExternalPtrAddr((x)) : \ |
|
558 |
- R_ExternalPtrAddr(GET_SLOT((x), Rf_install("ref")))) |
|
559 |
- |
|
560 |
- |
|
561 |
-SEXP |
|
562 |
-R_isNilPointer(SEXP r_ref) |
|
563 |
-{ |
|
564 |
- void *val = GET_EXT_PTR_REF(r_ref); |
|
565 |
- return(ScalarLogical( val ? FALSE : TRUE )); |
|
566 |
-} |
567 | 0 |
deleted file mode 100644 |
... | ... |
@@ -1,128 +0,0 @@ |
1 |
-#ifndef RAUTO_CONVERTERS_H |
|
2 |
-#define RAUTO_CONVERTERS_H |
|
3 |
- |
|
4 |
-/* For now! */ |
|
5 |
-#define DEBUG_R_RUNTIME 1 |
|
6 |
- |
|
7 |
-#include <stdlib.h> |
|
8 |
- |
|
9 |
-#include <Rinternals.h> |
|
10 |
-#include <Rdefines.h> |
|
11 |
- |
|
12 |
- |
|
13 |
-#ifdef __cplusplus |
|
14 |
-extern "C" { |
|
15 |
-#endif |
|
16 |
- |
|
17 |
- |
|
18 |
-typedef enum { R_DEEP_COPY, R_DUPLICATE, R_REFERENCE } R_CopyLevel; |
|
19 |
- |
|
20 |
-#define INTEGER_ELT(x, i) INTEGER(x)[i] |
|
21 |
-#define REAL_ELT(x, i) REAL(x)[i] |
|
22 |
- |
|
23 |
- |
|
24 |
-#define FAIL(msg) { PROBLEM msg \ |
|
25 |
- ERROR; \ |
|
26 |
- } |
|
27 |
- |
|
28 |
-#define NEW_REAL NEW_NUMERIC |
|
29 |
- |
|
30 |
-typedef enum {NATIVE_ROUTINE, R_FUNCTION} CallableType; |
|
31 |
- |
|
32 |
- |
|
33 |
-int convertFromRToInt(SEXP obj); |
|
34 |
-SEXP convertDoubleToR(double x); |
|
35 |
-SEXP convertIntToR(int x); |
|
36 |
-//SEXP convertIntArrayToR(const int *x, int len, int start, int end); |
|
37 |
-//SEXP convertUnsignedIntArrayToR(const unsigned int *x, int len); |
|
38 |
- |
|
39 |
-char ** getRStringArray(SEXP); |
|
40 |
- |
|
41 |
-/** |
|
42 |
- Utility for converting a value from an enumeration to an R object |
|
43 |
- that is an integer scalar (vector of length 1) with a name |
|
44 |
- */ |
|
45 |
-SEXP createREnumerationValue(int val, const char * const *names, const int *values, int namesLength, const char *name); |
|
46 |
- |
|
47 |
-/** |
|
48 |
- Finalizer routine that cleans up the memory used when allocating a reference |
|
49 |
- to a C-level structure. |
|
50 |
- */ |
|
51 |
-void SimpleAllocFinalizer(SEXP ans); |
|
52 |
- |
|
53 |
-void *Rfrom_Callbable(SEXP obj, const char * const TypeDefName, CallableType *type) ; |
|
54 |
- |
|
55 |
- |
|
56 |
-#ifdef __cplusplus |
|
57 |
-extern "C" |
|
58 |
-#endif |
|
59 |
-SEXP convertStringArrayToR(const char * const *x, int len); |
|
60 |
- |
|
61 |
- |
|
62 |
-void * R_getNativeReference(SEXP arg, const char *type, const char *tag); |
|
63 |
-SEXP R_createNativeReference(const void * const val, const char *className, const char *tagName); |
|
64 |
- |
|
65 |
-#define R_GET_REF_TYPE(arg, class) \ |
|
66 |
- (class *) R_getNativeReference(arg, #class, #class) |
|
67 |
- |
|
68 |
- |
|
69 |
-#define R_MAKE_REF_TYPE(arg, class) \ |
|
70 |
- R_createNativeReference(arg, #class, #class) |
|
71 |
- |
|
72 |
- |
|
73 |
-#define DEREF_REF(x, type) * ((type *) R_getNativeReference((x), #type, #type)) |
|
74 |
- |
|
75 |
-#define DEREF_REF_PTR(x, type) ((type *) R_getNativeReference((x), #type, #type)) |
|
76 |
- |
|
77 |
- |
|
78 |
-SEXP R_makeNames(const char *names[], int len); |
|
79 |
- |
|
80 |
- |
|
81 |
- |
|
82 |
-SEXP R_createArrayReference(const void *ref, const char * const className, const char * const type, |
|
83 |
- int *dimensions, unsigned int numDimension, size_t sizeofElement); |
|
84 |
- |
|
85 |
-SEXP R_make_var_reference(void *ref, const char * const type); |
|
86 |
-#define R_MAKE_VAR_REFERENCE(addr, type) R_make_var_reference((addr), type) |
|
87 |
-void *getVariableReference(SEXP arg, SEXP el, const char *type, const char *tag); |
|
88 |
- |
|
89 |
-/*XXX Put the proper type on the stack */ |
|
90 |
-void *R_asFunctionPointer(SEXP r_val, void *defaultFun, void *stack); |
|
91 |
- |
|
92 |
-//XXXX This is then macro-ized out!! |
|
93 |
-//SEXP copy_int_array_to_R(const int * const x, int len); |
|
94 |
-#define copy_int_array_to_R convertIntArrayToR |
|
95 |
- |
|
96 |
- |
|
97 |
-/* XXX This must be kept in synchronization with C++CastValues in R/classes.R in this package */ |
|
98 |
-typedef enum { |
|
99 |
- STATIC = 1, |
|
100 |
- DYNAMIC, |
|
101 |
- REINTERPRET, |
|
102 |
- CONST |
|
103 |
-} CastType; |
|
104 |
- |
|
105 |
- |
|
106 |
-Rboolean IS_S4_INSTANCE(SEXP obj, const char *className); |
|
107 |
- |
|
108 |
- |
|
109 |
-SEXP R_duplicateArray(SEXP r_ref, SEXP r_size, SEXP r_elementDup); |
|
110 |
- |
|
111 |
- |
|
112 |
-SEXP R_isNativeNull(SEXP ext); |
|
113 |
-SEXP R_addressOfPointer(SEXP ext); |
|
114 |
- |
|
115 |
- |
|
116 |
-SEXP convertDoubleArrayToR(int len, const double *x, int copy, int start, int end); |
|
117 |
-SEXP convertCharArrayToR(int dim, const char *x, int copy, int start, int end); |
|
118 |
- |
|
119 |
-void convertRCharacterToCharArray(char *dest, SEXP r_value, int array_len); |
|
120 |
- |
|
121 |
- |
|
122 |
-SEXP createRRoutineReference(void *, const char * const routineName, const char * const returnTypeName, unsigned int numParams, ...); |
|
123 |
- |
|
124 |
-#ifdef __cplusplus |
|
125 |
-} |
|
126 |
-#endif |
|
127 |
- |
|
128 |
-#endif |
129 | 0 |
deleted file mode 100644 |
... | ... |
@@ -1,41 +0,0 @@ |
1 |
-#include <Rdefines.h> |
|
2 |
-#include <R_ext/GraphicsEngine.h> |
|
3 |
-#include <R_ext/GraphicsDevice.h> |
|
4 |
-//#include <RConverters.h> |
|
5 |
-#include "RConverters.h" |
|
6 |
- |
|
7 |
- |
|
8 |
-struct RDevDescMethods { |
|
9 |
- SEXP activate ; |
|
10 |
- SEXP circle ; |
|
11 |
- SEXP clip ; |
|
12 |
- SEXP close ; |
|
13 |
- SEXP deactivate ; |
|
14 |
- SEXP locator ; |
|
15 |
- SEXP line ; |
|
16 |
- SEXP metricInfo ; |
|
17 |
- SEXP mode ; |
|
18 |
- SEXP newPage ; |
|
19 |
- SEXP polygon ; |
|
20 |
- SEXP polyline ; |
|
21 |
- SEXP rect ; |
|
22 |
- SEXP size ; |
|
23 |
- SEXP strWidth ; |
|
24 |
- SEXP text ; |
|
25 |
- SEXP onExit ; |
|
26 |
- SEXP getEvent ; |
|
27 |
- SEXP newFrameConfirm ; |
|
28 |
- SEXP textUTF8 ; |
|
29 |
- SEXP strWidthUTF8 ; |
|
30 |
- |
|
31 |
- SEXP initDevice; |
|
32 |
- SEXP state; |
|
33 |
-}; |
|
34 |
-typedef struct RDevDescMethods RDevDescMethods ; |
|
35 |
- |
|
36 |
-SEXP R_copyStruct_RDevDescMethods ( const struct RDevDescMethods *value); |
|
37 |
- |
|
38 |
- |
|
39 |
-#include "proxyDecls.h" |
|
40 |
- |
|
41 |
-#include "createExpressions.h" |