R: Vectorized Version of outer

v_outer {qdapTools} | R Documentation

## Vectorized Version of outer

### Description

Vectorized `outer`.

### Usage

    v_outer(x, FUN, ...)

    ## S3 method for class 'list'
    v_outer(x, FUN, ...)

    ## S3 method for class 'data.frame'
    v_outer(x, FUN, ...)

    ## S3 method for class 'matrix'
    v_outer(x, FUN, ...)

### Arguments

`x` | A `matrix`, `dataframe` or equal length `list` of vectors.
`FUN` | A vectorized function.
`...` | Other arguments passed to the function supplied to `FUN`.

### Value

Returns a matrix with the vectorized `outer` function.

### Author(s)

Vincent Zoonekynd, eddi of stackoverflow.com, and Tyler Rinker <tyler.rinker@gmail.com>.

### References

http://stackoverflow.com/a/9917425/1000343
http://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)

    ## Not run:
    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))

    ## End(Not run)

[Package qdapTools version 1.3.3 Index]