qdapTools (version 1.3.7)

v_outer: Vectorized Version of outer

Description

Vectorized outer.

Usage

v_outer(x, FUN, ...)
# S3 method for list
v_outer(x, FUN, ...)
# S3 method for data.frame
v_outer(x, FUN, ...)
# S3 method for matrix
v_outer(x, FUN, ...)

Value

Returns a matrix with the vectorized outer

function.

Arguments

x

A matrix, dataframe or equal length list of vectors.

FUN

A vectorized function.

...

Other arguments passed to the function supplied to FUN.

Author

Vincent Zoonekynd, eddi of stackoverflow.com, and Tyler Rinker <[e-mail]>.

References

https://stackoverflow.com/a/9917425/1000343
https://stackoverflow.com/q/23817341/1000343

See Also

outer, cor

Examples

#|------------------------------------------------------|
#|    SETTING UP VARIOUS FUNCTIONS THAT WILL BE USED    |
#|------------------------------------------------------|
pooled_sd <- function(x, y) {
    n1 <- length(x)
    n2 <- length(y)
    s1 <- sd(x)
    s2 <- sd(y)
    sqrt(((n1-1)*s1 + (n2-1)*s2)/((n1-1) + (n2-1)))
}

## Effect Size: Cohen's d 
cohens_d <- function(x, y) {
    (mean(y) - mean(x))/pooled_sd(x, y)
}


## Euclidean Distance
euc_dist <- function(x,y) sqrt(sum((x - y) ^ 2))

## Cosine similarity
cos_sim <- function(x, y) x %*% y / sqrt(x%*%x * y%*%y)

sum2 <- function(x, y) sum(x, y)
arbitrary <- function(x, y) round(sqrt(sum(x)) - sum(y), digits=1)
#--------------------------------------------------------#

## A data.frame
v_outer(mtcars, cor)
v_outer(mtcars, pooled_sd)
v_outer(mtcars[, 1:7], euc_dist)
v_outer(mtcars[, 1:7], sum2)
v_outer(mtcars[, 1:7], arbitrary)

## mtcars as a list
mtcars2 <- lapply(mtcars[, 1:7], "[")
v_outer(mtcars2, cor)
v_outer(mtcars2, cor,  method = "spearman")
v_outer(mtcars2, pooled_sd)
v_outer(split(mtcars[["mpg"]], mtcars[["carb"]]), cohens_d)
v_outer(split(CO2[["uptake"]], CO2[["Plant"]]), cohens_d)
print(v_outer(mtcars[, 1:7], pooled_sd), digits = 1)
print(v_outer(mtcars[, 1:7], pooled_sd), digits = NULL)
v_outer(mtcars2, euc_dist)
v_outer(mtcars2, sum2)
v_outer(mtcars2, arbitrary)

## A matrix
mat <- matrix(rbinom(500, 0:1, .45), ncol=10)
v_outer(mat, cos_sim)
v_outer(mat, euc_dist)
v_outer(mat, arbitrary)

if (FALSE) {
library(qdap)
wc3 <- function(x, y) sum(sapply(list(x, y), wc, byrow = FALSE))
L1 <- word_list(DATA$state, DATA$person)$cwl
(x <- v_outer(L1, wc3))
diag(x) <- (sapply(L1, length))
x

v_outer(with(DATA, wfm(state, person)), cos_sim)
with(DATA, Dissimilarity(state, person))
}