annotate src/lib/Utility.R @ 8:e9677425c6c3 default tip

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