mrdwab’s gists

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 / 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 / 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 / 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 / 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 / keybase.md

Created June 15, 2016 03:53

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 / 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 / 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 / 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 / meltList.R

Created February 18, 2016 11:38

See: http://stackoverflow.com/q/35456914/1270695

Ananda Mahto mrdwab