How to direct system output to a variable in R

For people familiar with Linux/Unix/Mac command line, we all know that there are many system commands that can save our day. One of the most encountered problems is to get the number of lines/words in a large file. Here I’m talking about tens of millions record and above. There are many ways to do it: the easiest way to do it is to ‘

There are many ways to do it: the easiest way to do it is to ‘readLines’ to get all the lines and count the shape. But this will be impossible if your memory won’t allow it. But in Linux platform, you can easily do it by call ‘wc -l filename.txt’.

In R environment, you can excecute all the system command by calling  ‘system()’. In this example, system(“wc -l filename.txt”) to show the number of lines. Here is the original quesiton: how do I assign the output to a variable?

It won’t work if you just do:

varName <- system(“wc -l filename.txt”)

But here is the trick:

varName <- system(“wc -l filename.txt”, intern = TRUE)

Bingo.

For more information on the most frequently used Linux command, refer to 50 Most Commonly Used Linux Command with Example.

 

Automate tabular financial datatable into vectorized sequential data

A lot of times, we receive time-related data in a table format and we want convert it into a simple data format with one column of datetime and the other as value. See this sample table:1

Now we want to convert this dataset into another format which can be easier to visulize and convert to other data structure like xts or timeSeries object. The converted data will be like:

2

Let’s look at a sample unemployment rate from Depart of labor.

sampleData <- read.csv(‘table_date.csv’)
sampleData

3

Method in R, there are two common ways to do it, first:

tableDataFlat <- as.vector(t(sampleData[1:nrow(sampleData),2:ncol(sampleData)]))
dates <- seq.Date(as.Date(‘2005-01-01’),as.Date(‘2017-12-01′),’month’)
newTS <- data.frame(dates=dates,value=tableDataFlat)
head(newTS)

4

the second way in R:

tableDataFlat <- c(t(as.matrix(sampleData[1:nrow(sampleData),2:ncol(sampleData)])))
newTS <- data.frame(dates=dates,value=tableDataFlat)
head(newTS)

Now we can do visualization and analysis more conveniently.

plot(newTS)

5

Method in Python:

In python, it is even more simple. Flatten the data matrix by using:

import numpy as np
import pandas as pd
df = pd.read_csv(‘table_date.csv’)
data = df.values
data_flat = data.flatten()
dates = pd.date_range(start = ‘2005-01-01’, end = ‘2017-12-01′,freq=’M’)
new_df = pd.Dataframe({date:dates,value:data_flat})
new_df.set_index(date)

All about *apply family in R

R has many *apply functions which are very helpful to simplify our code. The *apply functions are all covered in dplyr package but it is still good to know the differences and how to use it. It is just too convenient to ignore them.

First, the following Mnemonics gives you an overview of what each *apply function do in general.

Mnemonics

  • lapply is a list apply which acts on a list or vector and returns a list.
  • sapply is a simple lapply (function defaults to returning a vector or matrix when possible)
  • vapply is a verified apply (allows the return object type to be prespecified)
  • rapply is a recursive apply for nested lists, i.e. lists within lists
  • tapply is a tagged apply where the tags identify the subsets
  • apply is generic: applies a function to a matrix’s rows or columns (or, more generally, to dimensions of an array)

Example:

apply
For sum/mean of each row/columns, there are more optimzed function: colMeans, rowMeans, colSums, rowSums.While using apply to dataframe, it will automatically coerce it to a matrix.

# Two dimensional matrix# Two dimensional matrix
myMetric <- matrix(floor(runif(15,0,100)),5,3)
myMetric
# apply min to rows
apply(myMetric,1,min)
# apply min to columns
apply(myMetric,2,min)

[,1] [,2] [,3]
[1,] 28 22 6
[2,] 31 75 80
[3,] 7 88 96
[4,] 15 70 27
[5,] 74 84 12 //
[1] 6 31 7 15 12 //
[1] 7 22 6 //

lapply
For list vector, it applies the function to each element in it. lapply is the workhorse under all * apply functions. The most fundamental one.

x <- list(a = runif(5,0,1), b = seq(1:10), c = seq(10:100))
lapply(x, FUN = mean)

# Result

$a
[1] 0.4850281

$b
[1] 5.5

$c
[1] 46

sapply
sapply is doing the similar to lapply, it is just the output different. It simplifies the output to a vector rather than a list.

x <- list(a = runif(5,0,1), b = seq(1:10), c = seq(10:100))
sapply(x, FUN = mean)

a                 b                  c
0.2520706 5.5000000 46.0000000

vapply – similar to sapply, just speed faster.

rapply
This is a recursive apply, especially useful for a nested list structure. For example:

#Append ! to string, otherwise increment
myFun <- function(x){
if (is.character(x)){
return(paste(x,”!”,sep=””))
}
else{
return(x + 1)
}
}

#A nested list structure
l <- list(a = list(a1 = “Boo”, b1 = 2, c1 = “Eeek”),
b = 3, c = “Yikes”,
d = list(a2 = 1, b2 = list(a3 = “Hey”, b3 = 5)))

#Result is named vector, coerced to character
rapply(l,myFun)

#Result is a nested list like l, with values altered
rapply(l, myFun, how = “replace”)

a.a1 a.b1 a.c1 b c d.a2 d.b2.a3 d.b2.b3
“Boo!” “3” “Eeek!” “4” “Yikes!” “2” “Hey!” “6”

[1] “break”
$a
$a$a1
[1] “Boo!”

$a$b1
[1] 3

$a$c1
[1] “Eeek!”

 

$b
[1] 4

$c
[1] “Yikes!”

$d
$d$a2
[1] 2

$d$b2
$d$b2$a3
[1] “Hey!”

$d$b2$b3
[1] 6

tapply
For when you want to apply a function to subsets of a vector and the subsets are defined by some other vector, usually a factor.

tapply is similar in spirit to the split-apply-combine functions that are common in R (aggregate, by, avg, ddply, etc.)

x <- 1:20
y = factor(rep(letters[1:5], each = 4))
tapply(x,y,sum)

a b c d e
10 26 42 58 74

mapply and map
For when you have several data structures (e.g. vectors, lists) and you want to apply a function to the 1st elements of each, and then the 2nd elements of each, etc., coercing the result to a vector/array as in sapply.

**Map** is a wrapper to mapply with SIMPLIFY = FALSE, so it will be guaranteed to return a list.

mapply(sum, 1:5, 1:10,1:20)
mapply(rep, 1:4, 4:1)

[1] 3 6 9 12 15 13 16 19 22 25 13 16 19 22 25 23 26 29 32 35
[[1]]
[1] 1 1 1 1

[[2]]
[1] 2 2 2

[[3]]
[1] 3 3

[[4]]
[1] 4

 

This post is compiled from stackoverflow’s top answers.

A better view of this is to look at the R Notebook I’ve created: https://rpubs.com/euler-tech/292794

How to use customized function for any Pipe operator %>% in R

For advanced R programmer or Python (spark) machine learning engineer, you probably have heard or used at least once pipeline for your data or model work flow. The concept of pipeline is derived from Unix/Linux shell command. A pipeline is a sequence of processes chained together by their standard streams so that the output of each process (stdout) feeds directly as input (stdin) to the next one, for example: ls -l | grep key
less. Since the debut of one of the greatest R package ‘magrittr‘, pipeline has been one of my favorite thing in data engineering.

As we know, the way pipeline requires you to pass the whole output from previous command [process] to next one. Here comes a problem when you want use some basic/simple R command for just a particular column in the data object. For example, if I have a dataset ‘babynames’ and I want to round the ‘prop’ column to 3 digits. What will happen if I do this:

library(babynames)
library(dplyr)
library(magrittr)

babynames %>%
round(‘prop’) %>%
head

It gives me an error:

babynames %>%
+ round(‘prop’) %>%
+ head
Error in Math.data.frame(list(year = c(1880, 1880, 1880, 1880, 1880, 1880, :
non-numeric variable in data frame: sexname

How am I going to fix it? The solution is simple, write a customized wrapper function to let it go with the flow. Here is the solution:

library(babynames)
library(dplyr)
library(magrittr)

myRound <- function(df,colname){
df[[colname]] <- round(df[[colname]], 3)
return(df)
}

babynames %>%
myRound(‘prop’) %>%
head

Now it works. Whooray!

year sex name n prop
<dbl> <chr> <chr> <int> <dbl>
1 1880 F Mary 7065 0.072
2 1880 F Anna 2604 0.027
3 1880 F Emma 2003 0.021
4 1880 F Elizabeth 1939 0.020
5 1880 F Minnie 1746 0.018
6 1880 F Margaret 1578 0.016

Why it works?

The way pipeline works are like going through a multiple-stage filter for a signal, it can only take the whole object as input instead part of it. So the wrapper function operates as a buffer function within the pipeline.

 

Proposing a new metric for assessing missing data (Porosity Score) – Original

0.1 Introduction

When it comes to exploratory data analysis, we’ll often encounter data series with missing values. But the challenge is that how do we decide which time series to keep and how to score them. The most simple way to do is to compute the total percentage of the missing data. But this has a big flaw that it can’t differentiate the quality of the time series when they have the same amount of missing data points but positioned differently.

Let’s take a look at the following two data vectors: [NA,1,NA,1,NA,1,NA,1] and [1,1,1,1,NA,NA,NA,NA].

The recovery rate for these two vectors is different. The first time series is more often considered easier to impute, a.k.a estimate missing values. Because of the differences in these two series, I have come up with another method to score the quality of the series: porosity score. The concept is derived from environmental physics. What this does is to compute an adjusted porosity score of the time series vector by considering how the missing/bad data is positioned, the size of each block of missing data and adjust their impact on the overall dataset. Whether it is all discrete or continuously positioned every k index.

The porosity score proposed here will penalize the missing data block by its size. The bigger continuous hole it has, the worse the data is.

0.2 Define function

The function is defined below as PorosityScore. By default, the function will return a PorosityScore with penalty turned on. This is recommended metric. What this means is that it penalize each block of missing data differently. For example, the penalty weight for a missing block size of 4 will be 4 while it will be 1 for block size 1. This makes sense because the bigger hole you have, the worse data it should be.

# This function  is intended to compute the porosity of a time series vector.
# The computed porosicy(completeness) can be then used to screen feature variables in a dataframe.
# This function find the blocks of mimssing data and track the size of each block
#
# Input: Time Sereis Vector
#        tolerance: default 1 discrete missing value
#        Missing Value: NA or 0 or user specified (e.g. -99999 )
#        batch: when used in apply function, set it to TRUE and only adjuested.porosity will be generated. 
# Output: A list contains:
#         1. total.porosity.score (0-1) 
#         2. adjusted.porosity.score  (0-1) 
#         3. score with penalty (recommended) (0 - length(tsIn)^2) 
#         4. missing.blocksize
#         adjusted and penlty is used to control what type of output will be provided when run using apply function.
#
# e.g.
# > a <-  c(1,2,NA,3,NA,NA,4,5,6,7,8,NA,9,10,NA,NA)
# > result <- Porosity(a,tolerance = 2)
# > result$adjusted.porosity.score
# > result$total.porosity.score
#
# for dataframe usage. e.g. apply(dfIn,2,PorosityScore,tolerance=0,batch=TRUE, adjusted = FALSE, penalty = TRUE)

PorosityScore<- function(tsIn,tolerance =0,missingValue = NA,batch = FALSE, adjusted = FALSE, penalty = TRUE){
  #tsIn <- c(1,2,NA,3,NA,NA,4,5,6,7,8,NA,9,10,NA,NA)
  
  mVal = -99999999.9999 
  if(is.na(missingValue)) {
    tsIn[is.na(tsIn)] <- mVal
  }else{
    mVal = missingValue
  }
  idx <- which(tsIn == mVal )
  # Compute the total sparsity of the data
  totalPorosity <- length(idx) / length(tsIn)
  
  result <- list() 
  
  count <- 0
  i = 1
  while(i <= length(tsIn)) {
    if(tsIn[i] == mVal){
      count <-  count + 1
    }else{
      if(count !=0){
        result <- append(result,count)
        }
      count <- 0
    } 
    
    i <-  i +1
  } 
  
  if(count !=0) {
    result <- append(result,count)
  } 
  
  if(length(result) ==0){
      adjPorosity <- 0
      PenaltyPorosity <- 0
      blockSizeVec <- NA
      sprintf("The average porosity is: %5.1f.", mean(blockSizeVec))
      sprintf("The total and adjusted porosity score is:(%5.1f , %5.1f)", totalPorosity,adjPorosity)
      resultlist <-  list("total.porosity.score" =  totalPorosity ,"adjusted.porosity.score" = adjPorosity, 
                 "PenaltyPorosity"=PenaltyPorosity, "missing.blocksize" = blockSizeVec) 
  }else{
      # convert it to a vector
      blockSizeVec <- sapply(result,sum) # Map OF number of missing value in each missing blocks
     # If the spacing of the missing data is continous (>1), bad (e.g. [2,3,3,4,4,1,1,5,6,6])
      AvgPorosity <- mean(blockSizeVec)                            # The smaller,  the better
     # adjusted porosity score
      resVecAdj <- blockSizeVec[blockSizeVec>tolerance] 
      adjPorosity <- sum(resVecAdj)/length(tsIn) 
      PenaltyPorosity <- sum(blockSizeVec*resVecAdj)
      sprintf("The average porosity is: %5.1f.", mean(blockSizeVec))
      sprintf("The total and adjusted porosity score is:(%5.1f , %5.1f)", totalPorosity,adjPorosity)
      resultlist <-  list("total.porosity.score" =  totalPorosity ,"adjusted.porosity.score" = adjPorosity, 
                 "PenaltyPorosity"=PenaltyPorosity, "missing.blocksize" = blockSizeVec) 
  }
  
 if(batch) {
  # for using with apply function 
  # only return adjusted porosity since total porosity is too easy to compute
   if(adjusted){
     return(adjPorosity)
   }
   if(penalty){
     return(PenaltyPorosity)    
   }
 }else{
    return(resultlist) 
 }  
}

0.3 Example

Let’s look at the example

# use it with single vector
 print("dataset one")
## [1] "dataset one"
 a <-  c(1,2,NA,3,NA,NA,4,5,6,7,8,NA,9,10,NA,NA)
 result <- PorosityScore(a)
 print(result)
## $total.porosity.score
## [1] 0.375
## 
## $adjusted.porosity.score
## [1] 0.375
## 
## $PenaltyPorosity
## [1] 10
## 
## $missing.blocksize
## [1] 1 2 1 2
 #print("data set one")
 #print(result$adjusted.porosity.score)
 #print(result$total.porosity.score)
 #print(result$PenaltyPorosity)
 print("dataset two")
## [1] "dataset two"
 a2 <-  c(1,NA,2,3,4,NA,4,NA,6,NA,8,NA,9,10,NA)
 result2 <- PorosityScore(a2)
 print(result2)
## $total.porosity.score
## [1] 0.4
## 
## $adjusted.porosity.score
## [1] 0.4
## 
## $PenaltyPorosity
## [1] 6
## 
## $missing.blocksize
## [1] 1 1 1 1 1 1
#print(result2$adjusted.porosity.score)
#print(result2$total.porosity.score)
#print(result2$PenaltyPorosity)
# how to use it with a dataframe
#dfIn <- as.data.frame(matrix(5,5,2))
#results <- apply(dfIn,2,PorosityScore,tolerance=1,batch=TRUE, adjusted = FALSE, penalty = TRUE)

0.4 Conclusion

As we can see that the function can successfully distinguish time series with different missing patterns. In the above example, the first vector has a greater porosity score with a penalty. We can use this score to filter out numeric features with missing data by rank them.