-
Notifications
You must be signed in to change notification settings - Fork 16
/
fetch_data.R
177 lines (160 loc) · 7.07 KB
/
fetch_data.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
#' Download the Human DLPFC Visium data from LIBD
#'
#' This function downloads from `ExperimentHub` the dorsolateral prefrontal
#' cortex (DLPFC) human Visium data and results analyzed by LIBD. If
#' `ExperimentHub` is not available, it will download the files from Dropbox
#' using [utils::download.file()] unless the files are present already at
#' `destdir`. Note that `ExperimentHub` will cache the data and automatically
#' detect if you have previously downloaded it, thus making it the preferred
#' way to interact with the data.
#'
#' @param type A `character(1)` specifying which file you want to download. It
#' can either be: `sce` for the
#' \linkS4class{SingleCellExperiment}
#' object containing the spot-level data that includes the information for
#' visualizing the clusters/genes on top of the Visium histology, `sce_layer`
#' for the
#' \linkS4class{SingleCellExperiment}
#' object containing the layer-level data (pseudo-bulked from the spot-level),
#' or `modeling_results` for the list of tables with the `enrichment`,
#' `pairwise`, and `anova` model results from the layer-level data. It can also
#' be `sce_example` which is a reduced version of `sce` just for example
#' purposes. As of BioC version 3.13 `spe` downloads a
#' [SpatialExperiment-class][SpatialExperiment::SpatialExperiment-class] object.
#'
#' @param destdir The destination directory to where files will be downloaded
#' to in case the `ExperimentHub` resource is not available. If you already
#' downloaded the files, you can set this to the current path where the files
#' were previously downloaded to avoid re-downloading them.
#' @param eh An `ExperimentHub` object
#' [ExperimentHub-class][ExperimentHub::ExperimentHub-class].
#' @param bfc A `BiocFileCache` object
#' [BiocFileCache-class][BiocFileCache::BiocFileCache-class]. Used when
#' `eh` is not available.
#'
#' @return The requested object: `sce`, `sce_layer`, `ve` or `modeling_results` that
#' you have to assign to an object. If you didn't you can still avoid
#' re-loading the object by using `.Last.value`.
#'
#' @export
#' @import ExperimentHub
#' @importFrom AnnotationHub query
#' @importFrom methods is
#' @details The data was initially prepared by scripts at
#' https://github.com/LieberInstitute/HumanPilot and further refined by
#' https://github.com/LieberInstitute/spatialLIBD/blob/master/inst/scripts/make-data_spatialLIBD.R.
#'
#' @examples
#'
#' ## Download the SingleCellExperiment object
#' ## at the layer-level
#' if (!exists("sce_layer")) sce_layer <- fetch_data("sce_layer")
#'
#' ## Explore the data
#' sce_layer
fetch_data <-
function(type = c("sce", "sce_layer", "modeling_results", "sce_example", "spe"),
destdir = tempdir(),
eh = ExperimentHub::ExperimentHub(),
bfc = BiocFileCache::BiocFileCache()) {
## Some variables
sce <- sce_layer <- modeling_results <- sce_sub <- spe <- NULL
## Check inputs
stopifnot(methods::is(eh, "ExperimentHub"))
if (!type %in% c("sce", "sce_layer", "modeling_results", "sce_example", "spe")) {
stop(
paste(
"Other 'type' values are not supported.",
"Please use either 'sce', 'sce_layer',",
"'modeling_results', 'sce_example' or 'spe'."
),
call. = FALSE
)
}
## Deal with the special case of VisiumExperiment first
if (type == "spe") {
spe <- sce_to_spe(fetch_data("sce", destdir = destdir, eh = eh))
return(spe)
}
## Other pre-BioC 3.12 regular files
if (type == "sce") {
if (!enough_ram()) {
warning(paste(
"Your system might not have enough memory available.",
"Try with a machine that has more memory",
"or use the 'sce_example'."
))
}
hub_title <- "Human_Pilot_DLPFC_Visium_spatialLIBD_spot_level_SCE"
## While EH is not set-up
file_name <-
"Human_DLPFC_Visium_processedData_sce_scran_spatialLIBD.Rdata"
url <-
"https://www.dropbox.com/s/f4wcvtdq428y73p/Human_DLPFC_Visium_processedData_sce_scran_spatialLIBD.Rdata?dl=1"
} else if (type == "sce_layer") {
hub_title <- "Human_Pilot_DLPFC_Visium_spatialLIBD_layer_level_SCE"
## While EH is not set-up
file_name <-
"Human_DLPFC_Visium_processedData_sce_scran_sce_layer_spatialLIBD.Rdata"
url <-
"https://www.dropbox.com/s/bg8xwysh2vnjwvg/Human_DLPFC_Visium_processedData_sce_scran_sce_layer_spatialLIBD.Rdata?dl=1"
} else if (type == "modeling_results") {
hub_title <- "Human_Pilot_DLPFC_Visium_spatialLIBD_modeling_results"
## While EH is not set-up
file_name <- "Human_DLPFC_Visium_modeling_results.Rdata"
url <-
"https://www.dropbox.com/s/se6rrgb9yhm5gfh/Human_DLPFC_Visium_modeling_results.Rdata?dl=1"
} else if (type == "sce_example") {
hub_title <- "Human_DLPFC_Visium_sce_example.Rdata"
## While EH is not set-up
file_name <- "sce_sub_for_vignette.Rdata"
url <-
"https://www.dropbox.com/s/5ra9o8ku9iyyf70/sce_sub_for_vignette.Rdata?dl=1"
}
file_path <- file.path(destdir, file_name)
## Use local data if present
if (!file.exists(file_path)) {
q <-
AnnotationHub::query(eh,
pattern = c("Human_Pilot_DLPFC_Visium_spatialLIBD", hub_title)
)
if (length(q) == 1) {
## ExperimentHub has the data =)
res <- q[[1]]
if (type %in% c("sce", "sce_example")) {
res <- .update_sce(res)
} else if (type == "sce_layer") {
res <- .update_sce_layer(res)
}
return(res)
} else {
## ExperimentHub backup: download from Dropbox
file_path <- BiocFileCache::bfcrpath(bfc, url)
}
}
## Now load the data
message(Sys.time(), " loading file ", file_path)
load(file_path, verbose = FALSE)
if (type == "sce") {
return(.update_sce(sce))
} else if (type == "sce_layer") {
return(.update_sce_layer(sce_layer))
} else if (type == "modeling_results") {
return(modeling_results)
} else if (type == "sce_example") {
return(.update_sce(sce_sub))
}
}
.update_sce <- function(sce) {
## Rename here the default cluster we want to show in the shiny app
sce$spatialLIBD <- sce$layer_guess_reordered_short
## Add ManualAnnotation which was formerly called Layer, then drop Layer
sce$ManualAnnotation <- sce$Layer
sce$Layer <- NULL
return(sce)
}
.update_sce_layer <- function(sce_layer) {
## Rename here the default cluster we want to show in the shiny app
sce_layer$spatialLIBD <- sce_layer$layer_guess_reordered_short
return(sce_layer)
}