-
Notifications
You must be signed in to change notification settings - Fork 2
/
image.R
163 lines (145 loc) · 4.89 KB
/
image.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
#' Creates a image summary
#'
#' @param img An object that can be converted to an image.
#' @param ... Currently unused.
#' @inheritParams summary_scalar
#' @param width Width of the image.
#' @param height Height of the image.
#' @param colorspace Valid colorspace values are
#' `1 - grayscale`,
#' `2 - grayscale + alpha`,
#' `3 - RGB`,
#' `4 - RGBA`,
#' `5 - DIGITAL_YUV`,
#' `6 - BGRA`
#' @family summary
#' @returns An image summary that can be logged with [log_event()].
#' @examples
#' tmp <- tempfile()
#' with_logdir(tmp, {
#' summary_image(array(runif(100), dim = c(1,10, 10, 1)))
#' })
#' @export
summary_image <- function(img, ..., metadata = NULL, tag = NA) {
UseMethod("summary_image")
}
#' @describeIn summary_image Cretes an image summary from a ggplot2 graph object.
#' The `...` will be forwarded to [grDevices::png()].
#' @export
summary_image.ggplot <- function(img, ..., width = 480, height = 480, metadata = NULL, tag = NA) {
temp <- tempfile(fileext = ".png")
on.exit({unlink(temp)}, add = TRUE)
grDevices::png(filename = temp, width = width, height = height, ...)
plot(img)
grDevices::dev.off()
sze <- fs::file_info(temp)$size
raw <- readBin(temp, n = sze, what = "raw")
summary_image(
raw,
width = width,
height = height,
colorspace = 4,
metadata = metadata,
tag = tag
)
}
#' @describeIn summary_image Creates an image from an R array. The array should be
#' numeric, with values between 0 and 1. Dimensions should be `(batch, height, width, channels)`.
#' @export
summary_image.array <- function(img, ..., metadata = NULL, tag = NA) {
if (length(dim(img)) <= 3) {
cli::cli_abort(c(
"Expected an array with dimensions {.code (batch, height, width, channels)}",
i = "Got an array with dimensions {.code ({paste(dim(img), collapse=', ')})}."
))
}
if (is.null(metadata)) {
metadata <- summary_metadata(plugin_name = "images")
}
if (!all(field(metadata, "plugin_name") == "images")) {
cli::cli_abort(c(
"Plugin name should be 'images'",
x = "Got {.val {unique(field(metadata, 'plugin_name'))}}"
))
}
# See https://github.com/tensorflow/tensorboard/blob/a74c10dd197e7b2a07219855a61bc62651e80065/tensorboard/plugins/image/summary_v2.py#L111
# for the implementation.
# The images are converted to a character evctor, the first 2 elements being the
# dimensions, and the others containing the image encoded a png.
png_images <- apply(img, 1, function(x) {
png::writePNG(x)
}, simplify = FALSE)
blob_images <- blob::new_blob(png_images)
dims <- dim(img)
dims <- blob::blob(as.raw(dims[3]), as.raw(dims[2]))
blobs <- c(dims, blob_images)
summary_tensor(
blobs,
dtype = "string",
metadata = metadata,
tag = tag
)
}
#' @describeIn summary_image Creates an image from [blob::blob()] vctr of PNG encoded images,
#' (eg using [png::writePNG()]). `width`, `height` and `colorspace` are recycled
#' thus they can be a single scalar or a vector the same size of the images blob.
#' @export
summary_image.blob <- function(img, ..., width, height, colorspace, metadata = NULL, tag = NA) {
c(img, width, height, colorspace) %<-% vec_recycle_common(img, width, height, colorspace)
image <- summary_summary_image(
buffer = img,
width = width,
height = height,
colorspace = colorspace
)
new_summary_image(image, metadata = metadata, tag = tag)
}
#' @describeIn summary_image Creates an image from a png encoded image. Eg, created
#' with [png::writePNG()]. In this case you need to provide `width`, `height` and
#' `colorspace` arguments.
#' @export
summary_image.raw <- function(img, ..., width, height, colorspace, metadata = NULL, tag = NA) {
summary_image(
img = blob::blob(img),
width = width,
height = height,
colorspace = colorspace,
metadata = metadata,
tag = tag
)
}
new_summary_image <- function(img = new_summary_summary_image(), ..., metadata = NULL, tag = character()) {
if (is.null(metadata)) {
metadata <- summary_metadata(plugin_name = "images")
}
summary_values(metadata = metadata, image = img, class = "tfevents_summary_image", tag = tag)
}
summary_summary_image <- function(buffer, width, height, colorspace) {
new_summary_summary_image(
buffer = vec_cast(buffer, blob()),
width = width,
height = height,
colorspace = colorspace
)
}
#' @importFrom blob blob
new_summary_summary_image <- function(buffer = blob(), width = integer(), height = integer(), colorspace = integer()) {
buffer <- vec_cast(buffer, blob())
vctrs::new_rcrd(
fields = list(
buffer = buffer,
width = width,
height = height,
colorspace = colorspace
),
class = "summary_summary_image"
)
}
#' @export
vec_ptype2.summary_summary_image.summary_summary_image <- function(x, y, ...) {
new_summary_summary_image()
}
#' @export
vec_cast.summary_summary_image.summary_summary_image <- function(x, to, ...) {
x
}