KopfLab / lans2r
Showing 6 of 75 files from the diff.
Other files ignored by Codecov
docs/CNAME is new.
man/calculate.Rd has changed.
README.Rmd has changed.
.gitignore has changed.
.Rbuildignore has changed.
man/plot_maps.Rd has changed.
NAMESPACE has changed.
README.md has changed.
DESCRIPTION has changed.
NEWS.md has changed.
.travis.yml has changed.

@@ -18,51 +18,50 @@
Loading
18 18
                      error_fun = function(...) return(NA), 
19 19
                      name_fun = default_name,
20 20
                      filter_new = NULL,
21 -
                      quiet = F) {
21 +
                      quiet = FALSE) {
22 22
  
23 23
  # checks
24 24
  sapply(c("variable", "value", "data_type"), col_check, data, sys.call())
25 25
  
26 26
  # default name function (concatenate the deparsed expression)
27 27
  default_name <- function(...) {
28 -
    lazy_dots(...) %>% 
29 -
      sapply(function(lexp) deparse(lexp$exp, width.cutoff = 200L), simplify = TRUE) %>% 
28 +
    rlang::enexprs(...) %>% 
29 +
      sapply(rlang::as_label, simplify = TRUE) %>% 
30 30
      paste(collapse = " ")
31 31
  }
32 32
  
33 +
  # function to parse parameters passed using c()
34 +
  parse_params <- function(param_quo) {
35 +
    if (rlang::quo_is_call(param_quo) && rlang::call_name(param_quo) == "c") 
36 +
      rlang::call_args(param_quo)
37 +
    else
38 +
      list(rlang::get_expr(param_quo))
39 +
  }
40 +
  
33 41
  # generate parameter sets
34 -
  param_exps <- lazy_dots(...)
35 -
  params <- lapply(param_exps, function(lexp) {
36 -
    strsplit(sub("^c\\((.+)\\)$", "\\1", deparse(lexp$expr,  width.cutoff = 200L)), ",\\s?")[[1]]
37 -
  })
42 +
  param_exps <- rlang::enquos(...) 
43 +
  parsed_params <- lapply(param_exps, parse_params)
38 44
  
39 45
  # determine new variable names (calling the name_fun)
40 -
  var_new <- sapply(params, function(ps) {
41 -
    sprintf("f(%s)", paste(ps, collapse = ",")) %>%  # put together function call
42 -
      lazyeval::as.lazy(parent.frame()) %>% # generate call
43 -
      lazyeval::interp(f = name_fun) %>% # inject name function
44 -
      lazy_eval() # evaluate
46 +
  var_new <- sapply(parsed_params, function(ps_exps) {
47 +
    rlang::expr(name_fun(!!!ps_exps)) %>% rlang::eval_tidy()
45 48
  })
46 49
  
47 50
  # generate the value and error expressions
48 51
  val_fields <-
49 -
    lapply(params, function(ps) {
50 -
      sprintf("f(%s)", paste(ps, collapse = ",")) %>%  # put together function call
51 -
        lazyeval::as.lazy(parent.frame()) %>% # generate call
52 -
        lazyeval::interp(f = value_fun) # inject value function
52 +
    lapply(parsed_params, function(ps_exps) {
53 +
      rlang::expr(value_fun(!!!ps_exps))
53 54
    }) %>% setNames(var_new)
54 55
  
55 56
  err_fields <-
56 -
    lapply(params, function(ps) {
57 -
      sprintf("f(%s)", paste(ps, collapse = ",")) %>%  # put together function call
58 -
        lazyeval::as.lazy(parent.frame()) %>% # generate call
59 -
        lazyeval::interp(f = error_fun) # inject value function
57 +
    lapply(parsed_params, function(ps_exps) {
58 +
      rlang::expr(error_fun(!!!ps_exps))
60 59
    }) %>% setNames(var_new)
61 60
  
62 61
  # figure out what are the actual new variables (includes overriding old ones)
63 62
  new_data_type <- data_type
64 63
  var_old <- data$variable %>% unique() %>% setdiff(var_new)
65 -
  var_new_select <- lapply(var_old, function(i) lazyeval::interp(~-var, var = as.name(i)))
64 +
  var_new_select <- lapply(var_old, function(i) rlang::expr(-!!rlang::sym(i)))
66 65
  
67 66
  # spread data into wide format (relies on groups getting carried through the spread)
68 67
  df <- spread_data(data, values = TRUE, errors = TRUE)
@@ -77,30 +76,29 @@
Loading
77 76
      # calculate values and error within in each group
78 77
      values <- 
79 78
        df_group %>% 
80 -
        mutate_(.dots = val_fields) %>% 
79 +
        mutate(!!!val_fields) %>% 
81 80
        select(-ends_with("sigma")) %>% 
82 -
        select_(.dots = var_new_select) %>% 
83 -
        tidyr::gather_("variable", "value", var_new) 
81 +
        select(!!!var_new_select) %>% 
82 +
        tidyr::gather("variable", "value", !!!var_new) 
84 83
      
85 84
      error <- 
86 85
        df_group %>% 
87 -
        mutate_(.dots = err_fields) %>% 
86 +
        mutate(!!!err_fields) %>% 
88 87
        select(-ends_with("sigma")) %>% 
89 -
        select_(.dots = var_new_select) %>% 
90 -
        tidyr::gather_("variable", "sigma", var_new) 
88 +
        select(!!!var_new_select) %>% 
89 +
        tidyr::gather("variable", "sigma", !!!var_new) 
91 90
      
92 91
      suppressMessages(left_join(values, error))  %>% 
93 -
        mutate(variable = as.character(variable)) %>% # don't like the factor it introduces
92 +
        mutate(variable = as.character(.data$variable)) %>% # don't like the factor it introduces
94 93
        return()
95 94
    }) %>% 
96 95
    filter(!is.na(value)) %>% # remove calculations that don't exist
97 96
    mutate(data_type = new_data_type)
98 97
  
99 98
  # filter out parts of it
100 -
  if (!missing(filter_new)) {
101 -
    apply_filter <- lazy(filter_new)
102 -
    new_data_add <- new_data %>% 
103 -
      filter_(.dots = list(apply_filter))
99 +
  filter_new_quo <- rlang::enquo(filter_new)
100 +
  if (!rlang::quo_is_missing(filter_new_quo) && !rlang::quo_is_null(filter_new_quo)) {
101 +
    new_data_add <- filter(new_data, !!filter_new_quo)
104 102
  } else {
105 103
    new_data_add <- new_data
106 104
  }
@@ -112,7 +110,8 @@
Loading
112 110
        "INFO: %d '%s' values + errors calculated, %d added (subset: %s)",
113 111
        "\n      values added (stored in 'variable' column): %s"),
114 112
      new_data %>%  nrow(), new_data_type, nrow(new_data_add),
115 -
      if(!missing(filter_new)) deparse(apply_filter$exp) else "all",
113 +
      if(!rlang::quo_is_missing(filter_new_quo) && !rlang::quo_is_null(filter_new_quo)) 
114 +
        rlang::expr_deparse(filter_new_quo) else "all",
116 115
      new_data_add %>% 
117 116
        group_by(variable) %>% tally() %>%
118 117
        mutate(label = paste0("'", variable, "' (", n, "x)")) %>% 
@@ -146,7 +145,7 @@
Loading
146 145
#' @return the original data frame with the sums information appended (data_type == "ion_sum")
147 146
#' @family calculations
148 147
#' @export
149 -
calculate_sums <- function(data, ..., name_fun = default_name, quiet = F) {
148 +
calculate_sums <- function(data, ..., name_fun = default_name, quiet = FALSE) {
150 149
  
151 150
  # function to sum up arbitrary number of vectors by entry
152 151
  sum_vectors <- 
@@ -158,8 +157,8 @@
Loading
158 157
  
159 158
  # default sums name
160 159
  default_name <- function(...) {
161 -
    lazy_dots(...) %>% 
162 -
      sapply(function(lexp) deparse(lexp$exp), simplify = TRUE) %>% 
160 +
    rlang::enexprs(...) %>% 
161 +
      sapply(rlang::as_label, simplify = TRUE) %>% 
163 162
      paste(collapse = "+")
164 163
  }
165 164
  
@@ -193,7 +192,7 @@
Loading
193 192
#' @return the original data frame with the ratio information appended (all ratios have data_type == "ratio")
194 193
#' @family calculations
195 194
#' @export
196 -
calculate_ratios <- function(data, ..., name_fun = default_name, quiet = F) {
195 +
calculate_ratios <- function(data, ..., name_fun = default_name, quiet = FALSE) {
197 196
  
198 197
  # default name fun
199 198
  default_name <- function(m, M) paste0(deparse(substitute(m)),"/",deparse(substitute(M)))
@@ -226,7 +225,7 @@
Loading
226 225
#' @return the original data frame with the fractional abundance information appended (all fractional abundances are in % and have data_type == "abundance")
227 226
#' @family calculations
228 227
#' @export
229 -
calculate_abundances <- function(data, ..., name_fun = default_name, quiet = F) {
228 +
calculate_abundances <- function(data, ..., name_fun = default_name, quiet = FALSE) {
230 229
  
231 230
  # default name fun
232 231
  default_name = function(m, M) paste(deparse(substitute(m)), "F")

@@ -14,8 +14,8 @@
Loading
14 14
  pattern <- paste0(prefix,"(.*)", suffix) # file pattern
15 15
  for (file in dir(folder, pattern = pattern)) {
16 16
    ion <- sub(pattern, "\\1",file)
17 -
    info <- read.table(file.path(folder, file), header=F, skip=1, fill=T, comment.char = "", sep="\t")
18 -
    data <- read.table(file.path(folder, file), header=T, skip=9, fill=T, comment.char = "", sep="\t")
17 +
    info <- read.table(file.path(folder, file), header= FALSE, skip=1, fill= TRUE, comment.char = "", sep="\t")
18 +
    data <- read.table(file.path(folder, file), header= TRUE, skip=9, fill= TRUE, comment.char = "", sep="\t")
19 19
    df <- rbind(df,
20 20
                mutate(data, 
21 21
                       ion = ion,

@@ -15,12 +15,12 @@
Loading
15 15
#' during "Display masses")
16 16
#' @param quiet - whether to report information on the loaded data or not
17 17
#' @export
18 -
load_LANS_summary <- function(analysis, ..., base_dir = ".", ion_data_only = TRUE, load_zstacks = TRUE, quiet = F) {
18 +
load_LANS_summary <- function(analysis, ..., base_dir = ".", ion_data_only = TRUE, load_zstacks = TRUE, quiet = FALSE) {
19 19
  
20 20
  if(!dir.exists(base_dir))
21 21
    stop("The base directory does not exist: ", base_dir, call. = FALSE)
22 22
  
23 -
  info <- data_frame(analysis = analysis, ...)
23 +
  info <- tibble(analysis = analysis, ...)
24 24
  data <- lapply(analysis, function(i) {
25 25
    data_folder <- file.path(base_dir, i, "dat")
26 26
    read_roi_data(data_folder, ion_data_only = ion_data_only, load_zstacks = load_zstacks, quiet = quiet) %>% 
@@ -44,12 +44,12 @@
Loading
44 44
#'    format and good error propagation.
45 45
#' @param quiet - whether to report information on the loaded data or not
46 46
#' @export
47 -
load_LANS_maps <- function(analysis, ..., base_dir = ".", ion_data_only = TRUE, quiet = F) {
47 +
load_LANS_maps <- function(analysis, ..., base_dir = ".", ion_data_only = TRUE, quiet = FALSE) {
48 48
  
49 49
  if(!dir.exists(base_dir))
50 50
    stop("The base directory does not exist: ", base_dir, call. = FALSE)
51 51
  
52 -
  info <- data_frame(analysis = analysis, ...)
52 +
  info <- tibble(analysis = analysis, ...)
53 53
  data <- lapply(analysis, function(i) {
54 54
    data_folder <- file.path(base_dir, i, "mat")
55 55
    read_map_data(data_folder, ion_data_only = ion_data_only, quiet = quiet) %>% 

@@ -17,7 +17,7 @@
Loading
17 17
#' @param quiet - whether to report information on the loaded data or not
18 18
#' @return concatenated data_frame with all the ROIs' data, with identifier columns 'plane', 'ROI' and 'variable'
19 19
#' @export
20 -
read_roi_data <- function(dat_folder, ion_data_only = TRUE, load_zstacks = TRUE, quiet = F) {
20 +
read_roi_data <- function(dat_folder, ion_data_only = TRUE, load_zstacks = TRUE, quiet = FALSE) {
21 21
  # checks
22 22
  if (!dir.exists(dat_folder))
23 23
    stop("directory does not exist: ", dat_folder, call. =FALSE)
@@ -47,7 +47,7 @@
Loading
47 47
      lapply(zstack_files, read_roi_ion_zstack_data_file) %>% bind_rows() %>% 
48 48
      left_join(roi_data %>% select(-plane, -value, -sigma), by = c("ROI", "data_type", "variable"))
49 49
  } else {
50 -
    zstack_data <- data_frame()
50 +
    zstack_data <- tibble()
51 51
  }
52 52
  
53 53
  if (!quiet) {
@@ -56,7 +56,7 @@
Loading
56 56
        "INFO: folder '%s' read successfully.",
57 57
        "\n      Data for %d ROIs with %d ions recovered: %s.",
58 58
        "\n      Z-stacks were %sloaded.%s"),
59 -
      dat_folder,
59 +
      basename(dirname(dat_folder)),
60 60
      roi_data$ROI %>% unique() %>% length(),
61 61
      roi_data$variable %>% unique() %>% length(),
62 62
      roi_data$variable %>% unique() %>% paste(collapse = ", "),
@@ -72,7 +72,7 @@
Loading
72 72
read_roi_ion_data_file <- function (file) {
73 73
  stopifnot(file.exists(file))
74 74
  ion <- sub("^(.+)\\.dac$", "\\1", basename(file))
75 -
  data <- read.table(file, header=T, skip=1, fill=T, comment.char = "", sep="\t", check.names = F)
75 +
  data <- read.table(file, header = TRUE, skip=1, fill = TRUE, comment.char = "", sep="\t", check.names = FALSE)
76 76
  
77 77
  # name checks (what is expected in dac files)
78 78
  names_exp <- c("# i", "Xi", "Yi", "MEANi", "Poiss_Ei", "Poiss_%Ei", "SIZEi", "PIXELSi", "LWratio")
@@ -82,23 +82,25 @@
Loading
82 82
  }
83 83
  
84 84
  data %>% 
85 -
    mutate_(
86 -
      .dots = list(
87 -
        plane = as.lazy(~"all"), 
88 -
        data_type = as.lazy(~"ion_count"),
89 -
        variable = as.lazy(~ion),
90 -
        sigma = as.lazy(~iso.errN(MEANi)) 
91 -
      )) %>% # recalculating it to be more precise
92 -
    select_(
93 -
      .dots = list(
94 -
        "plane", ROI = "`# i`", 
95 -
        "data_type", "variable",
96 -
        value = "MEANi", 
97 -
        "sigma", 
98 -
        coord_x = "Xi", coord_y = "Yi", 
99 -
        size = "SIZEi", pixels = "PIXELSi", 
100 -
        LW_ratio = "LWratio"
101 -
      )) %>% as_data_frame()
85 +
    mutate(
86 +
      plane = "all", 
87 +
      data_type = "ion_count",
88 +
      variable = ion,
89 +
      sigma = iso.errN(.data$MEANi) 
90 +
    ) %>% # recalculating it to be more precise
91 +
    select(
92 +
      .data$plane,
93 +
      ROI = .data$`# i`,
94 +
      .data$data_type,
95 +
      .data$variable,
96 +
      value = .data$MEANi,
97 +
      .data$sigma,
98 +
      coord_x = .data$Xi, 
99 +
      coord_y = .data$Yi, 
100 +
      size = .data$SIZEi, 
101 +
      pixels = .data$PIXELSi, 
102 +
      LW_ratio = .data$LWratio
103 +
    ) %>% as_tibble()
102 104
}
103 105
104 106
@@ -107,21 +109,21 @@
Loading
107 109
  stopifnot(file.exists(file))
108 110
  V1 <- NULL # global variable definition
109 111
  ion <- sub("^([0-9A-Z]+)\\-z.dat$", "\\1", basename(file))
110 -
  read.table(file, header = F, skip = 3, comment.char = "", sep = "\t") %>%
112 +
  read.table(file, header = FALSE, skip = 3, comment.char = "", sep = "\t") %>%
111 113
    tidyr::gather(var, value, -V1) %>% 
112 -
    rename_(.dots = list(plane = "V1")) %>% 
113 -
    group_by(plane) %>% 
114 +
    rename(plane = .data$V1) %>% 
115 +
    group_by(.data$plane) %>% 
114 116
    mutate(
115 117
      data_type = "ion_count",
116 118
      variable = ion,
117 119
      ROI = rep(seq(1, n()/2), each = 2),
118 120
      col = sub("V(\\d+)", "\\1", var) %>% as.numeric,
119 121
      var = ifelse(col %% 2 == 0, "value", "sigma")) %>% 
120 -
    select(-col) %>% 
122 +
    select(-.data$col) %>% 
121 123
    ungroup() %>% 
122 124
    tidyr::spread(var, value) %>% 
123 -
    mutate(plane = as.character(plane), # to fit with 'all' plane
124 -
           sigma = iso.errN(value)) # recalculating it to be more precise
125 +
    mutate(plane = as.character(.data$plane), # to fit with 'all' plane
126 +
           sigma = iso.errN(.data$value)) # recalculating it to be more precise
125 127
}
126 128
127 129
# Raw data (.mat) files ============
@@ -141,7 +143,7 @@
Loading
141 143
#' @param quiet - whether to report information on the loaded data or not
142 144
#' @return concatenated data_frame with the full ion maps data
143 145
#' @export
144 -
read_map_data <- function(mat_folder, ion_data_only = TRUE, quiet = F) {
146 +
read_map_data <- function(mat_folder, ion_data_only = TRUE, quiet = FALSE) {
145 147
  # checks
146 148
  if (!dir.exists(mat_folder))
147 149
    stop("directory does not exist: ", mat_folder, call.=FALSE)
@@ -167,7 +169,7 @@
Loading
167 169
        "INFO: folder '%s' read successfully.",
168 170
        "\n      Ion map data for %s x %s pixel frame (%s microm^2) for %s ions recovered: %s.",
169 171
        "\n      %s ROIs identified in the frame."),
170 -
      mat_folder,
172 +
      basename(dirname(mat_folder)),
171 173
      ion_map_data$x.px %>% max(), ion_map_data$y.px %>% max(), ion_map_data$frame_size.um[1],
172 174
      ion_map_data$variable %>% unique() %>% length(),
173 175
      ion_map_data$variable %>% unique() %>% paste(collapse = ", "),
@@ -184,28 +186,25 @@
Loading
184 186
  ion <- sub("^(.+)\\.mat$", "\\1", basename(file))
185 187
  mat <- R.matlab::readMat(file)
186 188
  rois <- mat$CELLS %>% reshape2::melt() %>% 
187 -
    as_data_frame() %>% rename (ROI = value)
189 +
    as_tibble() %>% rename (ROI = value)
188 190
  mat$IM %>% 
189 191
    # melt is significnatly faster than gather for this kind of matrix calculation
190 -
    reshape2::melt() %>% as_data_frame() %>% 
192 +
    reshape2::melt() %>% as_tibble() %>% 
191 193
    left_join(rois, by = c("Var1", "Var2")) %>% 
192 -
    mutate_(
193 -
      .dots = 
194 -
        list(
195 -
          variable = as.lazy(~ion),
196 -
          data_type = as.lazy(~"ion_count"), 
197 -
          sigma = as.lazy(~iso.errN(value)),
198 -
          x.px = as.lazy(~Var2),
199 -
          y.px = as.lazy(~max(Var1) - Var1 + 1),
200 -
          frame_size.px = as.lazy(~max(x.px)),
201 -
          frame_size.um = mat$xyscale[1,1],
202 -
          x.um = as.lazy(~x.px/frame_size.px * frame_size.um),
203 -
          y.um = as.lazy(~y.px/frame_size.px * frame_size.um)
204 -
        )
194 +
    mutate(
195 +
      variable = ion,
196 +
      data_type = "ion_count",
197 +
      sigma = iso.errN(.data$value),
198 +
      x.px = .data$Var2,
199 +
      y.px = max(.data$Var1) - .data$Var1 + 1,
200 +
      frame_size.px = max(.data$x.px),
201 +
      frame_size.um = mat$xyscale[1,1],
202 +
      x.um = .data$x.px/.data$frame_size.px * .data$frame_size.um,
203 +
      y.um = .data$y.px/.data$frame_size.px * .data$frame_size.um
205 204
    ) %>% 
206 -
    select_(.dots = c("x.px", "y.px", "frame_size.px", "x.um", "y.um", 
207 -
                      "frame_size.um", "variable", "data_type", "value", 
208 -
                      "sigma", "ROI")) %>% 
209 -
    arrange_(.dots = c("x.px", "y.px"))
205 +
    select(c("x.px", "y.px", "frame_size.px", "x.um", "y.um", 
206 +
             "frame_size.um", "variable", "data_type", "value", 
207 +
             "sigma", "ROI")) %>% 
208 +
    arrange(.data$x.px, .data$y.px)
210 209
}
211 210

@@ -11,7 +11,7 @@
Loading
11 11
#' @param normalize whether to normalize the intensity scale for each panel (default TRUE)
12 12
#' @param color_scale what color scale to use for high and low intensity, default is black & white
13 13
#' @export
14 -
plot_maps <- function(data, draw_ROIs = T, normalize = T, color_scale = c("black", "white")) {
14 +
plot_maps <- function(data, draw_ROIs = TRUE, normalize = TRUE, color_scale = c("black", "white")) {
15 15
  if (nrow(data) == 0)
16 16
    stop("no rows in data frame")
17 17
  
@@ -76,13 +76,14 @@
Loading
76 76
  # calculate border
77 77
  suppressMessages(
78 78
    data %>% filter(ROI > 0) %>% 
79 -
      group_by(ROI, add=TRUE) %>% 
80 -
      filter(variable == variable[1]) %>%  # calculate for just one variable, for speed
81 -
      mutate_(.dots = list(~is_on_border(x.px, y.px)) %>% setNames("roi_border")) %>% 
79 +
      group_by(ROI, add = TRUE) %>% 
80 +
      filter(variable == .data$variable[1]) %>%  # calculate for just one variable, for speed
81 +
      mutate(roi_border = is_on_border(.data$x.px, .data$y.px)) %>% 
82 82
      ungroup() %>% 
83 -
      filter_(.dots = list(~roi_border)) %>% 
84 -
      select(-variable) %>% 
85 -
      inner_join(data %>% group_by(ROI, variable, add=TRUE) %>% select(variable) %>% distinct()) %>% 
86 -
      arrange_(.dots = c("x.px", "y.px")) # merge variables back in
83 +
      filter(.data$roi_border) %>% 
84 +
      select(-.data$variable) %>% 
85 +
      inner_join(data %>% group_by(.data$ROI, .data$variable, add = TRUE) %>% 
86 +
                   select(.data$variable) %>% distinct()) %>% 
87 +
      arrange(.data$x.px, .data$y.px) # merge variables back in
87 88
  )
88 89
}

@@ -4,11 +4,11 @@
Loading
4 4
#' @import dplyr
5 5
#' @import tidyr
6 6
#' @import ggplot2
7 -
#' @import lazyeval
8 7
#' @importFrom stats setNames sigma var
9 8
#' @importFrom utils read.table
10 9
#' @importFrom R.matlab readMat
11 10
#' @importFrom reshape2 melt
11 +
#' @importFrom rlang !! !!!
12 12
NULL
13 13
14 14
# quiets concerns of R CMD check about . that appears in pipelines
Files Coverage
R 94.77%
Project Totals (9 files) 94.77%
Notifications are pending CI completion. Periodically Codecov will check the CI state, when complete notifications will be submitted. Push notifications now.
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading