Skip to content

Instantly share code, notes, and snippets.

View privefl's full-sized avatar

Florian Privé privefl

View GitHub Profile
@privefl
privefl / dl_T1D_sumstats.R
Created March 27, 2019 10:15
Download T1D summary statistics
urls <- gsubfn::strapply(
readLines("https://datadryad.org//resource/doi:10.5061/dryad.ns8q3"),
"<a href=\"(/bitstream/handle/10255/dryad\\.[0-9]+/meta_chr_[0-9]+\\?sequence=1)\">",
simplify = 'c')
sumstats <- purrr::map_dfr(urls, ~ {
download.file(paste0("https://datadryad.org", .x),
destfile = (tmp <- tempfile(fileext = ".txt")))
sumstats <- bigreadr::fread2(
tmp, select = c("chromosome", "position", "a0", "a1",
sapply(list.files(pattern = "\\.html$"), function(file) {
html <- readLines(file)
new_html <- gsub(
"https:.*?MathJax\\.js\\?",
"https://mathjax.rstudio.com/latest/MathJax.js?",
html
)
writeLines(new_html, file)
})
@privefl
privefl / apply-sp.R
Created July 13, 2018 08:51
Example of efficiently using "`apply`" with a sparse matrix in R.
library(Matrix)
X <- rsparsematrix(1e4, 1e4, density = 0.01)
system.time(
test <- apply(X, 1, mean)
)
system.time(
test2 <- rowMeans(X)
@privefl
privefl / get-genes.R
Last active November 9, 2018 14:58
Get genes associated with SNPs.
require("bigstatsr")
#' Get genes
#'
#' Get genes associated with SNPs.
#'
#' @param rsid A character vector of 'rs' ID of SNPs to investigate.
#' @param ncores Number of cores to use.
#'
#' @return A character vector of genes in the form `"<name>:<ID>". Note that
MY_THEME <- function(p, coeff = 1) {
p + theme_bw() +
theme(plot.title = element_text(size = rel(2.0 * coeff), hjust = 0.5),
plot.subtitle = element_text(size = rel(1.5 * coeff), hjust = 0.5),
legend.title = element_text(size = rel(1.8 * coeff)),
legend.text = element_text(size = rel(1.3 * coeff)),
axis.title = element_text(size = rel(1.5 * coeff)),
axis.text = element_text(size = rel(1.2 * coeff)),
legend.key.height = unit(1.3 * coeff, "line"),
legend.key.width = unit(1.3 * coeff, "line"))
library(dplyr)
# dplyr programming
my_summarise <- function(df, group) {
group <- enquo(group)
df %>%
group_by(!!group) %>%
summarise_all(mean)
}
library(dplyr)
# dplyr programming
my_summarise <- function(df, group) {
group <- enquo(group)
df %>%
group_by(!!group) %>%
summarise_all(mean)
}
library(dplyr)
# dplyr programming
my_summarise <- function(df, group) {
group <- enquo(group)
df %>%
group_by(!!group) %>%
summarise_all(mean)
}
library(dplyr)
# dplyr programming
my_summarise <- function(df, group) {
group <- enquo(group)
df %>%
group_by(!!group) %>%
summarise_all(mean)
}
#### IN ORDER ####
# In first session, run:
write(1, "test.txt")
obj.lock <- flock::lock("test.txt")
# In second session, run this (this will wait the unlock in the first session)
obj.lock <- flock::lock("test.txt")
write(2, "test.txt", append = TRUE)
flock::unlock(obj.lock)