SCM

SCM Repository

[nbpmatching] Annotation of /pkg/R/utils.R
ViewVC logotype

Annotation of /pkg/R/utils.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 31 - (view) (download)

1 : beckca 14 # extra utility functions
2 :    
3 :     # list of names for created/fake elements found in matched dataset
4 :     created.names <- c("phantom", "ghost", "chameleon")
5 :    
6 : beckca 17 #'Get named sets of matches
7 :     #'
8 :     #'Create a factor variable using the names from a matched data set.
9 :     #'
10 :     #'Calculate a name for each pair by using the ID columns from the matched data
11 :     #'set. Return a factor of these named pairs.
12 :     #'
13 : beckca 31 #'@aliases get.sets get.sets,data.frame-method get.sets,nonbimatch-method
14 :     #'@param matches A data.frame or nonbimatch object. Contains information on
15 :     #'how to match the covariate data set.
16 : beckca 17 #'@param remove.unpaired A boolean value. The default is to remove elements
17 :     #'matched to phantom elements.
18 :     #'@param \dots Additional arguments, not used at this time.
19 :     #'@return a factor vector
20 :     #'@exportMethod get.sets
21 : beckca 20 #'@author Jake Bowers, \url{http://jakebowers.org/}, Cole Beck
22 : beckca 17 #'@examples
23 :     #'
24 :     #'df <- data.frame(id=LETTERS[1:25], val1=rnorm(25), val2=rnorm(25))
25 :     #'df.dist <- gendistance(df, idcol=1)
26 :     #'df.mdm <- distancematrix(df.dist)
27 :     #'df.match <- nonbimatch(df.mdm)
28 : beckca 31 #'get.sets(df.match)
29 : beckca 17 #'get.sets(df.match$matches)
30 :     #'# include the phantom match
31 :     #'get.sets(df.match$matches, FALSE)
32 :     #'
33 : beckca 14 setGeneric("get.sets", function(matches, remove.unpaired=TRUE, ...) standardGeneric("get.sets"))
34 :     setMethod("get.sets", "data.frame", function(matches, remove.unpaired=TRUE, ...) {
35 :     # thanks to Jake Bowers for providing this function
36 :     sets <- matches[,grep("ID", names(matches))]
37 :     f.sets <- apply(sets, MARGIN=1, FUN=function(x) paste(sort(x), collapse='-'))
38 :     names(f.sets) <- sets[,1]
39 :     if(remove.unpaired) f.sets <- f.sets[grep(paste(created.names, collapse="|"), f.sets, invert=TRUE)]
40 :     factor(f.sets)
41 :     })
42 :    
43 : beckca 31 setMethod("get.sets", "nonbimatch", function(matches, remove.unpaired=TRUE, ...) {
44 :     get.sets(matches$matches, remove.unpaired, ...)
45 :     })
46 :    
47 : beckca 17 #'Calculate scalar distance
48 :     #'
49 :     #'Calculate the scalar distance between elements of a matrix.
50 :     #'
51 :     #'Take the absolute difference between all elements in a vector, and return a
52 :     #'matrix of the distances.
53 :     #'
54 :     #'@aliases scalar.dist scalar.dist,vector-method
55 :     #'@param x A vector of numeric values.
56 :     #'@param \dots Additional arguments, not used at this time.
57 :     #'@return a matrix object
58 :     #'@exportMethod scalar.dist
59 : beckca 20 #'@author Jake Bowers, \url{http://jakebowers.org/}, Cole Beck
60 : beckca 17 #'@examples
61 :     #'
62 :     #'scalar.dist(1:10)
63 :     #'
64 : beckca 14 setGeneric("scalar.dist", function(x, ...) standardGeneric("scalar.dist"))
65 :     setMethod("scalar.dist", "vector", function(x, ...) {
66 :     # thanks to Jake Bowers for providing this function
67 :     if(!is.numeric(x)) stop("x should be numeric")
68 :     outer(x, x, FUN=function(i,j) abs(i-j))
69 :     })

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge