Skip to content

Instantly share code, notes, and snippets.

View mrdwab's full-sized avatar

Ananda Mahto mrdwab

67 followers · 70 following
View GitHub Profile
@mrdwab
mrdwab / trim_ws.R
Last active March 8, 2018 17:07
Fast leading and trailing whitespace trimming for lists and vectors. Preserves `NA` values.
trim_list <- function(x, relist = TRUE, convert = FALSE) {
x <- replace(x, lengths(x) == 0, NA_character_)
y <- unlist(x, use.names = FALSE)
y[!nzchar(y)] <- NA_character_
out <- trim_vec(y, TRUE)
if ((attr(out, "test") == "clean") & (!isTRUE(convert))) x
if (isTRUE(convert)) out <- type.convert(out, as.is = TRUE)
if (isTRUE(relist)) {
out <- split(out, factor(rep.int(seq.int(length(x)), lengths(x))))
if (is.null(names(x))) unname(out) else `names<-`(out, names(x))
@mrdwab
mrdwab / cSplit_fread_tests.R
Last active March 10, 2018 11:39
Using `fread` as the workhorse for `cSplit`.
dt1 <- fread("V1 V2 V3
x b;c;d 1
y d;ef 2
z d;ef 3
m tmp 4
n tmp 5
n x;yz 5")
dt1[4, V2:=''] # this record will be lost because V2 value is empty string
dt1[5, V2:=NA_character_] # NA value is processed correctly
@mrdwab
mrdwab / SO48607092.R
Created February 11, 2018 05:00
Benchmarks for https://stackoverflow.com/q/48607092/1270695
library(tidyverse)
library(data.table)
library(microbenchmark)
set.seed(1)
s <- sample(5, 10000, TRUE)
Sample <- rep(seq_along(s), s)
df <- data.frame(Sample,
motif = sample(LETTERS[1:10], length(Sample), TRUE),
chromosome = sample(2, length(Sample), TRUE))
@mrdwab
mrdwab / html5-video-presentation.html
Created April 23, 2017 11:30 — forked from slhck/html5-video-presentation.html
html5-video-presentation
<html>
<head>
<script src="https://code.jquery.com/jquery-2.1.3.min.js"></script>
<style>
video {
width: 100%;
height: auto;
}
</style>
</head>
@mrdwab
mrdwab / SO43350554.R
Created April 12, 2017 02:43
Output comparison and timings for different approaches posted at Q#43350554 at Stack Overflow.
# https://stackoverflow.com/questions/43350554/r-filling-in-empty-variables
fun1 <- function() {
apply(t(df), 2, function(x) {
conds <- rowSums(cbind(x, dplyr::lag(x), dplyr::lead(x)), na.rm = T)==2
x[conds] <- 1
x
}) %>% t()
}
@mrdwab
mrdwab / keybase.md
Created June 15, 2016 03:53

Keybase proof

I hereby claim:

  • I am mrdwab on github.
  • I am anandakpec (https://keybase.io/anandakpec) on keybase.
  • I have a public key whose fingerprint is DA48 E710 3EDA 383B F911 85F4 95AD 8366 3CB7 5B67

To claim this, I am signing this object:

@mrdwab
mrdwab / server.R
Last active March 1, 2016 16:19
KoBo Data Viewer (Shiny)
# server.R
library(shiny)
shinyServer(function(input, output) {
## Start by creating a reactive version of the dataset listing. This
## will then let us access the data for use in dynamically creating
## the listing of the available datasets. We only need the "id"
## and "title" datasets.
@mrdwab
mrdwab / kobo_time_parser.R
Last active February 28, 2016 09:34
kobo_time_parser_UTC <- function(instring) {
tmp <- gsub("\\.\\d{3}|:", "", instring)
tmp <- chartr(" ", "0", format(tmp, justify = "left", width = 22))
as.POSIXct(strptime(tmp, format = "%Y-%m-%dT%H%M%S%z", tz = "UTC"))
}
kobo_time_parser <- function(indatetime, timezone = Sys.timezone()) {
format(kobo_time_parser_UTC(indatetime), tz = timezone, usetz = TRUE)
}
@mrdwab
mrdwab / stratified.R
Created February 21, 2016 12:11
Possible rewrite of `stratified`. Not considerably faster, but this seems to be easier to follow by refactoring the code.
## Helper functions. Won't bother exporting.
dt_check <- function(indt) {
if (!is.data.table(indt)) as.data.table(indt) else indt
}
g_s <- function(indt, group) indt[, .N, by = group]
g_n <- function(indt, group, size) indt[, list(ss = size), by = group]
g_f <- function(indt, group, size) indt[, list(ss = ceiling(.N * size)), by = group]
g_l <- function(indt, group, size) setnames(data.table(names(size), unname(size)), c(group, "ss"))[]
g_sel <- function(indt, select) {
if (is.null(names(select))) {
@mrdwab
mrdwab / meltList.R
Created February 18, 2016 11:38
See: http://stackoverflow.com/q/35456914/1270695
meltList <- function(inlist) {
require(data.table)
f <- function(l) {
names(l) <- seq_along(l)
lapply(l, function(x) {
x <- setNames(x, seq_along(x))
if(is.list(x)) f(x) else x
})
}
temp <- unlist(f(inlist))