Mercurial > repos > george-weingart > maaslin

annotate maaslin-4450aa4ecc84/src/lib/Utility.R @ 1:a87d5a5f2776

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded the version running on the prod server
author george-weingart
date Sun, 08 Feb 2015 23:08:38 -0500
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
1
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
1 #####################################################################################
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
2 #Copyright (C) <2012>
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
3 #
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
4 #Permission is hereby granted, free of charge, to any person obtaining a copy of
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
5 #this software and associated documentation files (the "Software"), to deal in the
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
6 #Software without restriction, including without limitation the rights to use, copy,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
7 #modify, merge, publish, distribute, sublicense, and/or sell copies of the Software,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
8 #and to permit persons to whom the Software is furnished to do so, subject to
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
9 #the following conditions:
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
10 #
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
11 #The above copyright notice and this permission notice shall be included in all copies
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
12 #or substantial portions of the Software.
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
13 #
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
14 #THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
15 #INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
16 #PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
17 #HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
18 #OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
19 #SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
20 #
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
21 # This file is a component of the MaAsLin (Multivariate Associations Using Linear Models),
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
22 # authored by the Huttenhower lab at the Harvard School of Public Health
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
23 # (contact Timothy Tickle, ttickle@hsph.harvard.edu).
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
24 #####################################################################################
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
25
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
26 inlinedocs <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
27 ##author<< Curtis Huttenhower <chuttenh@hsph.harvard.edu> and Timothy Tickle <ttickle@hsph.harvard.edu>
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
28 ##description<< Collection of minor utility scripts
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
29 ) { return( pArgs ) }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
30
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
31 #source("Constants.R")
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
32
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
33 funcRename <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
34 ### Modifies labels for plotting
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
35 ### If the name is not an otu collapse to the last two clades
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
36 ### Otherwise use the most terminal clade
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
37 astrNames
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
38 ### Names to modify for plotting
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
39 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
40 astrRet <- c()
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
41 for( strName in astrNames )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
42 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
43 astrName <- strsplit( strName, c_cFeatureDelimRex )[[1]]
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
44 i <- length( astrName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
45 if( ( astrName[i] == c_strUnclassified ) || !is.na( as.numeric( astrName[i] ) ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
46 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
47 strRet <- paste( astrName[( i - 1 ):i], collapse = c_cFeatureDelim )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
48 } else {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
49 strRet <- astrName[i]
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
50 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
51 astrRet <- c(astrRet, strRet)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
52 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
53 return( astrRet )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
54 ### List of modified names
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
55 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
56
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
57 funcBonferonniCorrectFactorData <- function
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
58 ### Bonferroni correct for factor data
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
59 (dPvalue,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
60 ### P-value to correct
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
61 vsFactors,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
62 ### Factors of the data to correct
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
63 fIgnoreNAs = TRUE
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
64 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
65 vsUniqueFactors = unique( vsFactors )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
66 if( fIgnoreNAs ){ vsUniqueFactors = setdiff( vsUniqueFactors, c("NA","na","Na","nA") ) }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
67 return( dPvalue * max( 1, ( length( vsUniqueFactors ) - 1 ) ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
68 ### Numeric p-value that is correct for levels (excluding NA levels)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
69 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
70
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
71 funcCalculateTestCounts <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
72 ### Calculates the number of tests used in inference
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
73 iDataCount,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
74 asMetadata,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
75 asForced,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
76 asRandom,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
77 fAllvAll
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
78 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
79 iMetadata = length(asMetadata)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
80 iForced = length(setdiff(intersect( asForced, asMetadata ), asRandom))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
81 iRandom = length(intersect( asRandom, asMetadata ))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
82 if(fAllvAll)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
83 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
84 #AllvAll flow formula
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
85 return((iMetadata-iForced-iRandom) * iDataCount)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
86 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
87
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
88 #Normal flow formula
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
89 return((iMetadata-iRandom) * iDataCount)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
90 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
91
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
92 funcGetRandomColors=function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
93 #Generates a given number of random colors
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
94 tempNumberColors = 1
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
95 ### Number of colors to generate
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
96 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
97 adRet = c()
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
98 return(sapply(1:tempNumberColors, function(x){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
99 adRGB <- ( runif( 3 ) * 0.66 ) + 0.33
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
100 adRet <- c(adRet, rgb( adRGB[1], adRGB[2], adRGB[3] ))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
101 }))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
102 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
103
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
104 funcCoef2Col <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
105 ### Searches through a dataframe and looks for a column that would match the coefficient
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
106 ### by the name of the column or the column name and level appended together.
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
107 strCoef,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
108 ### String coefficient name
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
109 frmeData,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
110 ### Data frame of data
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
111 astrCols = c()
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
112 ### Column names of interest (if NULL is given, all column names are inspected).
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
113 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
114 #If the coefficient is the intercept there is no data column to return so return null
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
115 if( strCoef %in% c("(Intercept)", "Intercept") ) { return( NULL ) }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
116 #Remove ` from coefficient
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
117 strCoef <- gsub( "`", "", strCoef )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
118
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
119 #If the coefficient name is not in the data frame
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
120 if( !( strCoef %in% colnames( frmeData ) ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
121 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
122 fHit <- FALSE
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
123 #If the column names are not provided, use the column names of the dataframe.
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
124 if( is.null( astrCols ) ){astrCols <- colnames( frmeData )}
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
125
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
126 #Search through the different column names (factors)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
127 for( strFactor in astrCols )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
128 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
129 #Select a column, if it is not a factor or does not begin with the factor's name then skip
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
130 adCur <- frmeData[,strFactor]
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
131 if( ( class( adCur ) != "factor" ) ||
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
132 ( substr( strCoef, 1, nchar( strFactor ) ) != strFactor ) ) { next }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
133
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
134 #For the factors, create factor-level name combinations to read in factors
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
135 #Then check to see the factor-level combination is the coefficient of interest
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
136 #If it is then store that factor as the coefficient of interest
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
137 #And break
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
138 for( strValue in levels( adCur ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
139 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
140 strCur <- paste( strFactor, strValue, sep = c_sFactorNameSep )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
141 if( strCur == strCoef )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
142 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
143 strCoef <- strFactor
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
144 fHit <- TRUE
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
145 break
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
146 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
147 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
148
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
149 #If the factor was found, return
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
150 if( fHit ){break }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
151 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
152 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
153
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
154 #If the original coefficient or the coefficient factor combination name are in the
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
155 #data frame, return the name. Otherwise return NA.
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
156 return( ifelse( ( strCoef %in% colnames( frmeData ) ), strCoef, NA ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
157 ### Coefficient name
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
158 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
159
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
160 funcColToMFAValue = function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
161 ### Given a column name, return the MFA values that could be associated with the name
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
162 lsColNames,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
163 ### String list of column names (as you would get from names(dataframe))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
164 dfData
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
165 ### Data frame of data the column names refer to
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
166 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
167 lsMFAValues = c()
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
168
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
169 for(sColName in lsColNames)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
170 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
171 axCur = dfData[[sColName]]
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
172
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
173 if(is.logical(axCur)){axCur=as.factor(axCur)}
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
174 if(is.factor(axCur))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
175 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
176 lsLevels = levels(axCur)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
177 if((length(lsLevels)==2) && (!is.na(as.numeric(lsLevels[1]))) && (!is.na(as.numeric(lsLevels[2]))))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
178 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
179 lsMFAValues = c(lsMFAValues,paste(sColName,lsLevels[1],sep=c_sMFANameSep1),paste(sColName,lsLevels[2],sep=c_sMFANameSep1))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
180 }else{
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
181 for(sLevel in levels(axCur))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
182 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
183 lsMFAValues = c(lsMFAValues,sLevel)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
184 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
185 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
186 } else {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
187 lsMFAValues = c(lsMFAValues,sColName)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
188 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
189 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
190 return(setdiff(lsMFAValues,c("NA",NA)))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
191 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
192
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
193 funcMFAValue2Col = function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
194 ### Given a value in a column, the column name is returned.
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
195 xValue,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
196 dfData,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
197 aiColumnIndicesToSearch = NULL
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
198 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
199 lsColumnNames = names(dfData)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
200
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
201 if(is.null(aiColumnIndicesToSearch))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
202 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
203 aiColumnIndicesToSearch = c(1:dim(dfData)[2])
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
204 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
205
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
206 # Could be the column name
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
207 if(xValue %in% lsColumnNames){return(xValue)}
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
208
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
209 # Could be the column name and value
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
210 iValueLength = length(xValue)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
211 for( iColIndex in c(1:length(lsColumnNames) ))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
212 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
213 adCur = dfData[[lsColumnNames[iColIndex]]]
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
214 if(is.factor(adCur))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
215 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
216 for(strValue in levels(adCur))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
217 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
218 strCurVersion1 <- paste( lsColumnNames[iColIndex], strValue, sep = c_sMFANameSep1 )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
219 strCurVersion2 <- paste( lsColumnNames[iColIndex], strValue, sep = c_sMFANameSep2 )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
220 if((xValue == strCurVersion1) || (xValue == strCurVersion2)){return(lsColumnNames[iColIndex])}
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
221 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
222 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
223 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
224
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
225 # Could be the value
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
226 for(iColIndex in aiColumnIndicesToSearch)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
227 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
228 if(xValue %in% dfData[[lsColumnNames[iColIndex]]]){return(lsColumnNames[iColIndex])}
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
229 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
230 return(NULL)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
231 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
232
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
233 funcColorHelper <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
234 ### Makes sure the max is max and the min is min, and dmed is average
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
235 dMax = 1,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
236 ### Max number
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
237 dMin = -1,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
238 ### Min number
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
239 dMed = NA
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
240 ### Average value
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
241 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
242 #Make sure max is max and min is min
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
243 vSort = sort(c(dMin,dMax))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
244 return( list( dMin = vSort[1], dMax = vSort[2], dMed = ifelse((is.na(dMed)), (dMin+dMax)/2.0, dMed ) ))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
245 ### List of min, max and med numbers
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
246 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
247
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
248 funcColor <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
249 ### Generate a color based on a number that is forced to be between a min and max range.
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
250 ### The color is based on how far the number is from the center of the given range
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
251 ### From red to green (high) are produced with default settings
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
252 dX,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
253 ### Number from which to generate the color
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
254 dMax = 1,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
255 ### Max possible value
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
256 dMin = -1,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
257 ### Min possible value
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
258 dMed = NA,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
259 ### Central value if you don't want to be the average
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
260 adMax = c(1, 1, 0),
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
261 ### Is used to generate the color for the higher values in the range, this can be changed to give different colors set to green
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
262 adMin = c(0, 0, 1),
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
263 ### Is used to generate the color for the lower values in the range, this can be changed to give different colors set to red
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
264 adMed = c(0, 0, 0)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
265 ### Is used to generate the color for the central values in the range, this can be changed to give different colors set to black
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
266 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
267 lsTmp <- funcColorHelper( dMax, dMin, dMed )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
268 dMax <- lsTmp$dMax
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
269 dMin <- lsTmp$dMin
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
270 dMed <- lsTmp$dMed
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
271 if( is.na( dX ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
272 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
273 dX <- dMed
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
274 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
275 if( dX > dMax )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
276 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
277 dX <- dMax
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
278 } else if( dX < dMin )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
279 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
280 dX <- dMin }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
281 if( dX < dMed )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
282 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
283 d <- ( dMed - dX ) / ( dMed - dMin )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
284 adCur <- ( adMed * ( 1 - d ) ) + ( adMin * d )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
285 } else {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
286 d <- ( dMax - dX ) / ( dMax - dMed )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
287 adCur <- ( adMed * d ) + ( adMax * ( 1 - d ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
288 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
289 return( rgb( adCur[1], adCur[2], adCur[3] ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
290 ### RGB object
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
291 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
292
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
293 funcColors <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
294 ### Generate a range of colors
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
295 dMax = 1,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
296 ### Max possible value
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
297 dMin = -1,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
298 ### Min possible value
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
299 dMed = NA,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
300 ### Central value if you don't want to be the average
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
301 adMax = c(1, 1, 0),
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
302 ### Is used to generate the color for the higher values in the range, this can be changed to give different colors set to green
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
303 adMin = c(0, 0, 1),
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
304 ### Is used to generate the color for the lower values in the range, this can be changed to give different colors set to red
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
305 adMed = c(0, 0, 0),
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
306 ### Is used to generate the color for the central values in the range, this can be changed to give different colors set to black
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
307 iSteps = 64
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
308 ### Number of intermediary colors made in the range of colors
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
309 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
310 lsTmp <- funcColorHelper( dMax, dMin, dMed )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
311 dMax <- lsTmp$dMax
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
312 dMin <- lsTmp$dMin
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
313 dMed <- lsTmp$dMed
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
314 aRet <- c ()
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
315 for( dCur in seq( dMin, dMax, ( dMax - dMin ) / ( iSteps - 1 ) ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
316 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
317 aRet <- c(aRet, funcColor( dCur, dMax, dMin, dMed, adMax, adMin, adMed ))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
318 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
319 return( aRet )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
320 ### List of colors
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
321 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
322
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
323 funcGetColor <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
324 ### Get a color based on col parameter
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
325 ) {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
326 adCol <- col2rgb( par( "col" ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
327 return( sprintf( "#%02X%02X%02X", adCol[1], adCol[2], adCol[3] ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
328 ### Return hexadecimal color
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
329 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
330
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
331 funcTrim=function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
332 ### Remove whitespace at the beginning or the end of a string
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
333 tempString
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
334 ### tempString String to be trimmed.
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
335 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
336 return(gsub("^\\s+|\\s+$","",tempString))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
337 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
338
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
339 funcWrite <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
340 ### Write a string or a table of data
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
341 ### This transposes a table before it is written
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
342 pOut,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
343 ### String or table to write
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
344 strFile
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
345 ### File to which to write
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
346 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
347 if(!is.na(strFile))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
348 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
349 if( length( intersect( class( pOut ), c("character", "numeric") ) ) )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
350 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
351 write.table( t(pOut), strFile, quote = FALSE, sep = c_cTableDelimiter, col.names = FALSE, row.names = FALSE, na = "", append = TRUE )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
352 } else {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
353 capture.output( print( pOut ), file = strFile, append = TRUE )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
354 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
355 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
356 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
357
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
358 funcWriteTable <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
359 ### Log a table to a file
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
360 frmeTable,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
361 ### Table to write
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
362 strFile,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
363 ### File to which to write
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
364 fAppend = FALSE
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
365 ### Append when writing
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
366 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
367 if(!is.na(strFile))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
368 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
369 write.table( frmeTable, strFile, quote = FALSE, sep = c_cTableDelimiter, na = "", col.names = NA, append = fAppend )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
370 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
371 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
372
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
373 funcWriteQCReport <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
374 ### Write out the quality control report
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
375 strProcessFileName,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
376 ### File name
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
377 lsQCData,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
378 ### List of QC data generated by maaslin to be written
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
379 liDataDim,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
380 ### Dimensions of the data matrix
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
381 liMetadataDim
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
382 ### Dimensions of the metadata matrix
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
383 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
384 unlink(strProcessFileName)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
385 funcWrite( paste("Initial Metadata Matrix Size: Rows ",liMetadataDim[1]," Columns ",liMetadataDim[2],sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
386 funcWrite( paste("Initial Data Matrix Size: Rows ",liDataDim[1]," Columns ",liDataDim[2],sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
387 funcWrite( paste("\nInitial Data Count: ",length(lsQCData$aiDataInitial),sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
388 funcWrite( paste("Initial Metadata Count: ",length(lsQCData$aiMetadataInitial),sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
389 funcWrite( paste("Data Count after preprocess: ",length(lsQCData$aiAfterPreprocess),sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
390 funcWrite( paste("Removed for missing metadata: ",length(lsQCData$iMissingMetadata),sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
391 funcWrite( paste("Removed for missing data: ",length(lsQCData$iMissingData),sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
392 funcWrite( paste("Number of data with outliers: ",length(which(lsQCData$aiDataSumOutlierPerDatum>0)),sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
393 funcWrite( paste("Number of metadata with outliers: ",length(which(lsQCData$aiMetadataSumOutlierPerDatum>0)),sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
394 funcWrite( paste("Metadata count which survived clean: ",length(lsQCData$aiMetadataCleaned),sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
395 funcWrite( paste("Data count which survived clean: ",length(lsQCData$aiDataCleaned),sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
396 funcWrite( paste("\nBoostings: ",lsQCData$iBoosts,sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
397 funcWrite( paste("Boosting Errors: ",lsQCData$iBoostErrors,sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
398 funcWrite( paste("LMs with no terms suriving boosting: ",lsQCData$iNoTerms,sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
399 funcWrite( paste("LMs performed: ",lsQCData$iLms,sep=""), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
400 if(!is.null(lsQCData$lsQCCustom))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
401 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
402 funcWrite("Custom preprocess QC data: ", strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
403 funcWrite(lsQCData$lsQCCustom, strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
404 } else {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
405 funcWrite("No custom preprocess QC data.", strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
406 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
407 funcWrite( "\n#Details###########################", strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
408 funcWrite("\nInitial Data Count: ", strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
409 funcWrite(lsQCData$aiDataInitial, strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
410 funcWrite("\nInitial Metadata Count: ", strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
411 funcWrite(lsQCData$aiMetadataInitial, strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
412 funcWrite("\nData Count after preprocess: ", strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
413 funcWrite(lsQCData$aiAfterPreprocess, strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
414 funcWrite("\nRemoved for missing metadata: ", strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
415 funcWrite(lsQCData$iMissingMetadata, strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
416 funcWrite("\nRemoved for missing data: ", strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
417 funcWrite(lsQCData$iMissingData, strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
418 funcWrite("\nDetailed outlier indices: ", strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
419 for(sFeature in names(lsQCData$liOutliers))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
420 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
421 funcWrite(paste("Feature",sFeature,"Outlier indice(s):", paste(lsQCData$liOutliers[[sFeature]],collapse=",")), strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
422 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
423 funcWrite("\nMetadata which survived clean: ", strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
424 funcWrite(lsQCData$aiMetadataCleaned, strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
425 funcWrite("\nData which survived clean: ", strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
426 funcWrite(lsQCData$aiDataCleaned, strProcessFileName )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
427 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
428
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
429 funcLMToNoNAFormula <-function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
430 lMod,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
431 frmeTmp,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
432 adCur
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
433 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
434 dfCoef = coef(lMod)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
435 astrCoefNames = setdiff(names(dfCoef[as.vector(!is.na(dfCoef))==TRUE]),"(Intercept)")
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
436 astrPredictors = unique(as.vector(sapply(astrCoefNames,funcCoef2Col, frmeData=frmeTmp)))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
437 strFormula = paste( "adCur ~", paste( sprintf( "`%s`", astrPredictors ), collapse = " + " ), sep = " " )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
438 return(try( lm(as.formula( strFormula ), data=frmeTmp )))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
439 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
440
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
441 funcFormulaStrToList <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
442 #Takes a lm or mixed model formula and returns a list of covariate names in the formula
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
443 strFormula
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
444 #Formula to extract covariates from
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
445 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
446 #Return list
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
447 lsRetComparisons = c()
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
448
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
449 #If you get a null or na just return
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
450 if(is.null(strFormula)||is.na(strFormula)){return(lsRetComparisons)}
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
451
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
452 #Get test comparisons (predictor names from formula string)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
453 asComparisons = gsub("`","",setdiff(unlist(strsplit(unlist(strsplit(strFormula,"~"))[2]," ")),c("","+")))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
454
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
455 #Change metadata in formula to univariate comparisons
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
456 for(sComparison in asComparisons)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
457 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
458 #Removed random covariate formating
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
459 lsParse = unlist(strsplit(sComparison, "[\\(\\|\\)]", perl=FALSE))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
460 lsRetComparisons = c(lsRetComparisons,lsParse[length(lsParse)])
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
461 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
462 return(lsRetComparisons)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
463 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
464
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
465 funcFormulaListToString <- function(
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
466 # Using covariate and random covariate names, creates a lm or mixed model formula
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
467 # returns a vector of c(strLM, strMixedModel), one will be NA given the existance of random covariates.
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
468 # On error c(NA,NA) is given
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
469 astrTerms,
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
470 #Fixed covariates or all covariates if using an lm
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
471 astrRandomCovariates = NULL
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
472 #Random covariates for a mixed model
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
473 ){
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
474 strRetLMFormula = NA
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
475 strRetMMFormula = NA
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
476
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
477 #If no covariates return NA
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
478 if(is.null(astrTerms)){return(c(strRetLMFormula, strRetMMFormula))}
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
479
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
480 #Get fixed covariates
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
481 astrFixedCovariates = setdiff(astrTerms,astrRandomCovariates)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
482
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
483 #If no fixed coavariates return NA
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
484 # Can not run a model with no fixed covariate, restriction of lmm
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
485 if(length(astrFixedCovariates)==0){return(c(strRetLMFormula, strRetMMFormula))}
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
486
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
487 # Fixed Covariates
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
488 strFixedCovariates = paste( sprintf( "`%s`", astrFixedCovariates ), collapse = " + " )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
489
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
490 #If random covariates, set up a formula for mixed models
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
491 if(length(astrRandomCovariates)>0)
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
492 {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
493 #Format for lmer
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
494 #strRetFormula <- paste( "adCur ~ ", paste( sprintf( "(1|`%s`))", intersect(astrRandomCovariates, astrTerms)), collapse = " + " ))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
495 #Format for glmmpql
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
496 strRandomCovariates = paste( sprintf( "1|`%s`", setdiff(astrRandomCovariates, astrTerms)), collapse = " + " )
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
497 strRetMMFormula <- paste( "adCur ~ ", strFixedCovariates, " + ", strRandomCovariates, sep="")
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
498 } else {
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
499 #This is either the formula for all covariates in an lm or fixed covariates in the lmm
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
500 strRetLMFormula <- paste( "adCur ~ ", strFixedCovariates, sep="")
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
501 }
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
502 return(c(strRetLMFormula, strRetMMFormula))
a87d5a5f2776 Uploaded the version running on the prod server
george-weingart
parents:
diff changeset
503 }