annotate src/breadcrumbs/scripts/scriptBiplotTSV.R @ 3:b4cf8c75305b draft default tip

Pointing to the right root directory
author george-weingart
date Tue, 30 Aug 2016 13:10:34 -0400
parents 2f4f6f08c8c4
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
1 #!/usr/bin/env Rscript
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
2
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
3 library(vegan)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
4 library(optparse)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
5
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
6 funcGetCentroidForMetadatum <- function(
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
7 ### Given a binary metadatum, calculate the centroid of the samples associated with the metadata value of 1
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
8 # 1. Get all samples that have the metadata value of 1
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
9 # 2. Get the x and y coordinates of the selected samples
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
10 # 3. Get the median value for the x and ys
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
11 # 4. Return those coordinates as the centroid's X and Y value
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
12 vfMetadata,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
13 ### Logical or integer (0,1) vector, TRUE or 1 values indicate correspoinding samples in the
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
14 ### mSamplePoints which will be used to define the centroid
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
15 mSamplePoints
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
16 ### Coordinates (columns;n=2) of samples (rows) corresponding to the vfMetadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
17 ){
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
18 # Check the lengths which should be equal
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
19 if(length(vfMetadata)!=nrow(mSamplePoints))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
20 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
21 print(paste("funcGetCentroidForMetadata::Error: Should have received metadata and samples of the same length, received metadata length ",length(vfMetadata)," and sample ",nrow(mSamplePoints)," length.",sep=""))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
22 return( FALSE )
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
23 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
24
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
25 # Get all the samples that have the metadata value of 1
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
26 viMetadataSamples = which(as.integer(vfMetadata)==1)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
27
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
28 # Get the x and y coordinates for the selected samples
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
29 mSelectedPoints = mSamplePoints[viMetadataSamples,]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
30
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
31 # Get the median value for the x and the ys
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
32 if(!is.null(nrow(mSelectedPoints)))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
33 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
34 return( list(x=median(mSelectedPoints[,1],na.rm = TRUE),y=median(mSelectedPoints[,2],na.rm = TRUE)) )
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
35 } else {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
36 return( list(x=mSelectedPoints[1],y=mSelectedPoints[2]) )
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
37 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
38 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
39
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
40 funcGetMaximumForMetadatum <- function(
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
41 ### Given a continuous metadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
42 ### 1. Use the x and ys from mSamplePoints for coordinates and the metadata value as a height (z)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
43 ### 2. Use lowess to smooth the landscape
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
44 ### 3. Take the maximum of the landscape
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
45 ### 4. Return the coordiantes for the maximum as the centroid
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
46 vdMetadata,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
47 ### Continuous (numeric or integer) metadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
48 mSamplePoints
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
49 ### Coordinates (columns;n=2) of samples (rows) corresponding to the vfMetadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
50 ){
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
51 # Work with data frame
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
52 if(class(mSamplePoints)=="matrix")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
53 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
54 mSamplePoints = data.frame(mSamplePoints)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
55 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
56 # Check the lengths of the dataframes and the metadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
57 if(length(vdMetadata)!=nrow(mSamplePoints))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
58 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
59 print(paste("funcGetMaximumForMetadatum::Error: Should have received metadata and samples of the same length, received metadata length ",length(vdMetadata)," and sample ",nrow(mSamplePoints)," length.",sep=""))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
60 return( FALSE )
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
61 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
62
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
63 # Add the metadata value to the points
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
64 mSamplePoints[3] = vdMetadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
65 names(mSamplePoints) = c("x","y","z")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
66
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
67 # Create lowess to smooth the surface
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
68 # And calculate the fitted heights
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
69 # x = sample coordinate 1
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
70 # y = sample coordinate 2
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
71 # z = metadata value
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
72 loessSamples = loess(z~x*y, data=mSamplePoints, degree = 1, normalize = FALSE, na.action=na.omit)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
73
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
74 # Naively get the max
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
75 vdCoordinates = loessSamples$x[which(loessSamples$y==max(loessSamples$y)),]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
76 return(list(lsmod = loessSamples, x=vdCoordinates[1],y=vdCoordinates[2]))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
77 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
78
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
79 funcMakeShapes <- function(
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
80 ### Takes care of defining shapes for the plot
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
81 dfInput,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
82 ### Data frame of metadata measurements
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
83 sShapeBy,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
84 ### The metadata to shape by
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
85 sShapes,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
86 ### List of custom metadata (per level if factor).
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
87 ### Should correspond to the number of levels in shapeBy; the format is level:shape,level:shape for example HighLuminosity:14,LowLuminosity:2,HighPH:10,LowPH:18
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
88 cDefaultShape
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
89 ### Shape to default to if custom shapes are not used
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
90 ){
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
91 lShapes = list()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
92 vsShapeValues = c()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
93 vsShapeShapes = c()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
94 vsShapes = c()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
95 sMetadataId = sShapeBy
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
96
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
97 # Set default shape, color, and color ranges
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
98 if(!is.null(cDefaultShape))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
99 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
100 # Default shape should be an int for the int pch options
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
101 if(!is.na(as.integer(cDefaultShape)))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
102 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
103 cDefaultShape = as.integer(cDefaultShape)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
104 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
105 } else {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
106 cDefaultShape = 16
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
107 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
108
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
109 # Make shapes
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
110 vsShapes = rep(cDefaultShape,nrow(dfInput))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
111
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
112 if(!is.null(sMetadataId))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
113 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
114 if(is.null(sShapes))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
115 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
116 vsShapeValues = unique(dfInput[[sMetadataId]])
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
117 vsShapeShapes = 1:length(vsShapeValues)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
118 } else {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
119 # Put the markers in the order of the values)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
120 vsShapeBy = unlist(strsplit(sShapes,","))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
121 for(sShapeBy in vsShapeBy)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
122 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
123 vsShapeByPieces = unlist(strsplit(sShapeBy,":"))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
124 lShapes[vsShapeByPieces[1]] = as.integer(vsShapeByPieces[2])
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
125 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
126 vsShapeValues = names(lShapes)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
127 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
128
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
129 # Shapes in the correct order
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
130 if(!is.null(sShapes))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
131 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
132 vsShapeShapes = unlist(lapply(vsShapeValues,function(x) lShapes[[x]]))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
133 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
134 vsShapeValues = paste(vsShapeValues)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
135
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
136 # Make the list of shapes
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
137 for(iShape in 1:length(vsShapeValues))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
138 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
139 vsShapes[which(paste(dfInput[[sMetadataId]])==vsShapeValues[iShape])]=vsShapeShapes[iShape]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
140 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
141
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
142 # If they are all numeric characters, make numeric
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
143 viIntNas = which(is.na(as.integer(vsShapes)))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
144 viNas = which(is.na(vsShapes))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
145 if(length(setdiff(viIntNas,viNas))==0)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
146 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
147 vsShapes = as.integer(vsShapes)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
148 } else {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
149 print("funcMakeShapes::Error: Please supply numbers 1-25 for shape in the -y,--shapeBy option")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
150 vsShapeValues = c()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
151 vsShapeShapes = c()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
152 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
153 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
154 return(list(PlotShapes=vsShapes,Values=vsShapeValues,Shapes=vsShapeShapes,ID=sMetadataId,DefaultShape=cDefaultShape))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
155 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
156
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
157 ### Global defaults
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
158 c_sDefaultColorBy = NULL
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
159 c_sDefaultColorRange = "orange,cyan"
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
160 c_sDefaultTextColor = "black"
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
161 c_sDefaultArrowColor = "cyan"
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
162 c_sDefaultArrowTextColor = "Blue"
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
163 c_sDefaultNAColor = NULL
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
164 c_sDefaultShapeBy = NULL
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
165 c_sDefaultShapes = NULL
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
166 c_sDefaultMarker = "16"
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
167 c_fDefaultPlotArrows = TRUE
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
168 c_sDefaultRotateByMetadata = NULL
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
169 c_sDefaultResizeArrow = 1
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
170 c_sDefaultTitle = "Custom Biplot of Bugs and Samples - Metadata Plotted with Centroids"
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
171 c_sDefaultOutputFile = NULL
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
172
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
173 ### Create command line argument parser
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
174 pArgs <- OptionParser( usage = "%prog last_metadata input.tsv" )
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
175
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
176 # Selecting features to plot
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
177 pArgs <- add_option( pArgs, c("-b", "--bugs"), type="character", action="store", default=NULL, dest="sBugs", metavar="BugsToPlot", help="Comma delimited list of data to plot as text. To not plot metadata pass a blank or empty space. Bug|1,Bug|2")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
178 # The default needs to stay null for metadata or code needs to be changed in the plotting for a check to see if the metadata was default. Search for "#!# metadata default dependent"
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
179 pArgs <- add_option( pArgs, c("-m", "--metadata"), type="character", action="store", default=NULL, dest="sMetadata", metavar="MetadataToPlot", help="Comma delimited list of metadata to plot as arrows. To not plot metadata pass a blank or empty space. metadata1,metadata2,metadata3")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
180
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
181 # Colors
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
182 pArgs <- add_option( pArgs, c("-c", "--colorBy"), type="character", action="store", default=c_sDefaultColorBy, dest="sColorBy", metavar="MetadataToColorBy", help="The id of the metadatum to use to make the marker colors. Expected to be a continuous metadata.")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
183 pArgs <- add_option( pArgs, c("-r", "--colorRange"), type="character", action="store", default=c_sDefaultColorRange, dest="sColorRange", metavar="ColorRange", help=paste("Colors used to color the samples; a gradient will be formed between the color.Default=", c_sDefaultColorRange))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
184 pArgs <- add_option( pArgs, c("-t", "--textColor"), type="character", action="store", default=c_sDefaultTextColor, dest="sTextColor", metavar="TextColor", help=paste("The color bug features will be plotted with as text. Default =", c_sDefaultTextColor))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
185 pArgs <- add_option( pArgs, c("-a", "--arrowColor"), type="character", action="store", default=c_sDefaultArrowColor, dest="sArrowColor", metavar="ArrowColor", help=paste("The color metadata features will be plotted with as an arrow and text. Default", c_sDefaultArrowColor))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
186 pArgs <- add_option( pArgs, c("-w", "--arrowTextColor"), type="character", action="store", default=c_sDefaultArrowTextColor, dest="sArrowTextColor", metavar="ArrowTextColor", help=paste("The color for the metadata text ploted by the head of the metadata arrow. Default", c_sDefaultArrowTextColor))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
187 pArgs <- add_option(pArgs, c("-n","--plotNAColor"), type="character", action="store", default=c_sDefaultNAColor, dest="sPlotNAColor", metavar="PlotNAColor", help=paste("Plot NA values as this color. Example -n", c_sDefaultNAColor))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
188
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
189 # Shapes
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
190 pArgs <- add_option( pArgs, c("-y", "--shapeby"), type="character", action="store", default=c_sDefaultShapeBy, dest="sShapeBy", metavar="MetadataToShapeBy", help="The metadata to use to make marker shapes. Expected to be a discrete metadatum. An example would be -y Environment")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
191 pArgs <- add_option( pArgs, c("-s", "--shapes"), type="character", action="store", default=c_sDefaultShapes, dest="sShapes", metavar="ShapesForPlotting", help="This is to be used to specify the shapes to use for plotting. Can use numbers recognized by R as shapes (see pch). Should correspond to the number of levels in shapeBy; the format is level:shape,level:shape for example HighLuminosity:14,LowLuminosity:2,HighPH:10,LowPH:18 . Need to specify -y/--shapeBy for this option to work.")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
192 pArgs <- add_option( pArgs, c("-d", "--defaultMarker"), type="character", action="store", default=c_sDefaultMarker, dest="sDefaultMarker", metavar="DefaultColorMarker", help="Default shape for markers which are not otherwise indicated in --shapes, can be used for unspecified values or NA. Must not be a shape in --shapes.")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
193
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
194 # Plot manipulations
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
195 pArgs <- add_option( pArgs, c("-e","--rotateByMetadata"), type="character", action="store", default=c_sDefaultRotateByMetadata, dest="sRotateByMetadata", metavar="RotateByMetadata", help="Rotate the ordination by a metadata. Give both the metadata and value to weight it by. The larger the weight, the more the ordination is influenced by the metadata. If the metadata is continuous, use the metadata id; if the metadata is discrete, the ordination will be by one of the levels so use the metadata ID and level seperated by a '_'. Discrete example -e Environment_HighLumninosity,100 ; Continuous example -e Environment,100 .")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
196 pArgs <- add_option( pArgs, c("-z","--resizeArrow"), type="numeric", action="store", default=c_sDefaultResizeArrow, dest="dResizeArrow", metavar="ArrowScaleFactor", help="A constant to multiple the length of the arrow to expand or shorten all arrows together. This will not change the angle of the arrow nor the relative length of arrows to each other.")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
197 pArgs <- add_option( pArgs, c("-A", "--noArrows"), type="logical", action="store_true", default=FALSE, dest="fNoPlotMetadataArrows", metavar="DoNotPlotArrows", help="Adding this flag allows one to plot metadata labels without the arrows.")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
198
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
199 # Misc
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
200 pArgs <- add_option( pArgs, c("-i", "--title"), type="character", action="store", default=c_sDefaultTitle, dest="sTitle", metavar="Title", help="This is the title text to add to the plot.")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
201 pArgs <- add_option( pArgs, c("-o", "--outputfile"), type="character", action="store", default=c_sDefaultOutputFile, dest="sOutputFileName", metavar="OutputFile", help="This is the name for the output pdf file. If an output file is not given, an output file name is made based on the input file name.")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
202
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
203 funcDoBiplot <- function(
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
204 ### Perform biplot. Samples are markers, bugs are text, and metadata are text with arrows. Markers and bugs are dtermined usiing NMDS and Bray-Curtis dissimilarity. Metadata are placed on the ordination in one of two ways: 1. Factor data - for each level take the ordination points for the samples that have that level and plot the metadata text at the average orindation point. 2. For continuous data - make a landscape (x and y form ordination of the points) and z (height) as the metadata value. Use a lowess line to get the fitted values for z and take the max of the landscape. Plot the metadata text at that smoothed max.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
205 sBugs,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
206 ### Comma delimited list of data to plot as text. Bug|1,Bug|2
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
207 sMetadata,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
208 ### Comma delimited list of metadata to plot as arrows. metadata1,metadata2,metadata3.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
209 sColorBy = c_sDefaultColorBy,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
210 ### The id of the metadatum to use to make the marker colors. Expected to be a continuous metadata.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
211 sColorRange = c_sDefaultColorRange,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
212 ### Colors used to color the samples; a gradient will be formed between the color. Example orange,cyan
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
213 sTextColor = c_sDefaultTextColor,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
214 ### The color bug features will be plotted with as text. Example black
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
215 sArrowColor = c_sDefaultArrowColor,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
216 ### The color metadata features will be plotted with as an arrow and text. Example cyan
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
217 sArrowTextColor = c_sDefaultArrowTextColor,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
218 ### The color for the metadata text ploted by the head of the metadat arrow. Example Blue
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
219 sPlotNAColor = c_sDefaultNAColor,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
220 ### Plot NA values as this color. Example grey
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
221 sShapeBy = c_sDefaultShapeBy,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
222 ### The metadata to use to make marker shapes. Expected to be a discrete metadatum.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
223 sShapes = c_sDefaultShapes,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
224 ### This is to be used to specify the shapes to use for plotting. Can use numbers recognized by R as shapes (see pch). Should correspond to the number of levels in shapeBy; the format is level:shape,level:shape for example HighLuminosity:14,LowLuminosity:2,HighPH:10,LowPH:18 . Works with sShapesBy.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
225 sDefaultMarker = c_sDefaultMarker,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
226 ### The default marker shape to use if shapes are not otherwise indicated.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
227 sRotateByMetadata = c_sDefaultRotateByMetadata,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
228 ### Metadata and value to rotate by. example Environment_HighLumninosity,100
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
229 dResizeArrow = c_sDefaultResizeArrow,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
230 ### Scale factor to resize tthe metadata arrows
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
231 fPlotArrow = c_fDefaultPlotArrows,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
232 ### A flag which can be used to turn off arrow plotting.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
233 sTitle = c_sDefaultTitle,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
234 ### The title for the figure.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
235 sInputFileName,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
236 ### File to input (tsv file: tab seperated, row = sample file)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
237 sLastMetadata,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
238 ### Last metadata that seperates data and metadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
239 sOutputFileName = c_sDefaultOutputFile
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
240 ### The file name to save the figure.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
241 ){
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
242 # Define the colors
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
243 vsColorRange = c("blue","orange")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
244 if(!is.null(sColorRange))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
245 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
246 vsColorRange = unlist(strsplit(sColorRange,","))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
247 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
248 cDefaultColor = "grey"
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
249 if(!is.null(vsColorRange) && length(vsColorRange)>0)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
250 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
251 cDefaultColor = vsColorRange[1]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
252 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
253
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
254 # List of bugs to plot
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
255 # If there is a list it needs to be more than one.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
256 vsBugsToPlot = c()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
257 if(!is.null(sBugs))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
258 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
259 vsBugsToPlot = unlist(strsplit(sBugs,","))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
260 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
261 # Metadata to plot
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
262 vsMetadata = c()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
263 if(!is.null(sMetadata))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
264 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
265 vsMetadata = unlist(strsplit(sMetadata,","))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
266 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
267
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
268 ### Load table
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
269 dfInput = sInputFileName
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
270 if(class(sInputFileName)=="character")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
271 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
272 dfInput = read.table(sInputFileName, sep = "\t", header=TRUE)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
273 names(dfInput) = unlist(lapply(names(dfInput),function(x) gsub(".","|",x,fixed=TRUE)))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
274 row.names(dfInput) = dfInput[,1]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
275 dfInput = dfInput[-1]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
276 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
277
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
278 iLastMetadata = which(names(dfInput)==sLastMetadata)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
279 viMetadata = 1:iLastMetadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
280 viData = (iLastMetadata+1):ncol(dfInput)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
281
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
282 ### Dummy the metadata if discontinuous
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
283 ### Leave the continous metadata alone but include
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
284 listMetadata = list()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
285 vsRowNames = c()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
286 viContinuousMetadata = c()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
287 for(i in viMetadata)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
288 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
289 vCurMetadata = unlist(dfInput[i])
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
290 if(is.numeric(vCurMetadata)||is.integer(vCurMetadata))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
291 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
292 vCurMetadata[which(is.na(vCurMetadata))] = mean(vCurMetadata,na.rm=TRUE)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
293 listMetadata[[length(listMetadata)+1]] = vCurMetadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
294 vsRowNames = c(vsRowNames,names(dfInput)[i])
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
295 viContinuousMetadata = c(viContinuousMetadata,length(listMetadata))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
296 } else {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
297 vCurMetadata = as.factor(vCurMetadata)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
298 vsLevels = levels(vCurMetadata)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
299 for(sLevel in vsLevels)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
300 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
301 vNewMetadata = rep(0,length(vCurMetadata))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
302 vNewMetadata[which(vCurMetadata == sLevel)] = 1
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
303 listMetadata[[length(listMetadata)+1]] = vNewMetadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
304 vsRowNames = c(vsRowNames,paste(names(dfInput)[i],sLevel,sep="_"))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
305 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
306 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
307 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
308
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
309 # Convert to data frame
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
310 dfDummyMetadata = as.data.frame(sapply(listMetadata,rbind))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
311 names(dfDummyMetadata) = vsRowNames
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
312 iNumberMetadata = ncol(dfDummyMetadata)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
313
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
314 # Data to use in ordination in NMDS
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
315 dfData = dfInput[viData]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
316
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
317 # If rotating the ordination by a metadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
318 # 1. Add in the metadata as a bug
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
319 # 2. Multiply the bug by the weight
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
320 # 3. Push this through the NMDS
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
321 if(!is.null(sRotateByMetadata))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
322 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
323 vsRotateMetadata = unlist(strsplit(sRotateByMetadata,","))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
324 sMetadata = vsRotateMetadata[1]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
325 dWeight = as.numeric(vsRotateMetadata[2])
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
326 sOrdinationMetadata = dfDummyMetadata[sMetadata]*dWeight
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
327 dfData[sMetadata] = sOrdinationMetadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
328 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
329
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
330 # Run NMDS on bug data (Default B-C)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
331 # Will have species and points because working off of raw data
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
332 mNMDSData = metaMDS(dfData,k=2)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
333
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
334 ## Make shapes
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
335 # Defines thes shapes and the metadata they are based on
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
336 # Metadata to use as shapes
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
337 lShapeInfo = funcMakeShapes(dfInput=dfInput, sShapeBy=sShapeBy, sShapes=sShapes, cDefaultShape=sDefaultMarker)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
338
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
339 sMetadataShape = lShapeInfo[["ID"]]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
340 vsShapeValues = lShapeInfo[["Values"]]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
341 vsShapeShapes = lShapeInfo[["Shapes"]]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
342 vsShapes = lShapeInfo[["PlotShapes"]]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
343 cDefaultShape = lShapeInfo[["DefaultShape"]]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
344
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
345 # Colors
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
346 vsColors = rep(cDefaultColor,nrow(dfInput))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
347 vsColorValues = c()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
348 vsColorRBG = c()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
349 if(!is.null(sColorBy))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
350 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
351 vsColorValues = paste(sort(unique(unlist(dfInput[[sColorBy]])),na.last=TRUE))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
352 iLengthColorValues = length(vsColorValues)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
353
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
354 vsColorRBG = lapply(1:iLengthColorValues/iLengthColorValues,colorRamp(vsColorRange))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
355 vsColorRBG = unlist(lapply(vsColorRBG, function(x) rgb(x[1]/255,x[2]/255,x[3]/255)))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
356
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
357 for(iColor in 1:length(vsColorRBG))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
358 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
359 vsColors[which(paste(dfInput[[sColorBy]])==vsColorValues[iColor])]=vsColorRBG[iColor]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
360 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
361
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
362 #If NAs are seperately given color, then color here
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
363 if(!is.null(sPlotNAColor))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
364 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
365 vsColors[which(is.na(dfInput[[sColorBy]]))] = sPlotNAColor
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
366 vsColorRBG[which(vsColorValues=="NA")] = sPlotNAColor
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
367 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
368 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
369
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
370 # Reduce the bugs down to the ones in the list to be plotted
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
371 viBugsToPlot = which(row.names(mNMDSData$species) %in% vsBugsToPlot)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
372 viMetadataDummy = which(names(dfDummyMetadata) %in% vsMetadata)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
373
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
374 # Build the matrix of metadata coordinates
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
375 mMetadataCoordinates = matrix(rep(NA, iNumberMetadata*2),nrow=iNumberMetadata)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
376
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
377 for( i in 1:iNumberMetadata )
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
378 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
379 lxReturn = NA
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
380 if( i %in% viContinuousMetadata )
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
381 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
382 lxReturn = funcGetMaximumForMetadatum(dfDummyMetadata[[i]],mNMDSData$points)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
383 } else {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
384 lxReturn = funcGetCentroidForMetadatum(dfDummyMetadata[[i]],mNMDSData$points)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
385 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
386 mMetadataCoordinates[i,] = c(lxReturn$x,lxReturn$y)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
387 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
388 row.names(mMetadataCoordinates) = vsRowNames
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
389
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
390 #!# metadata default dependent
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
391 # Plot the biplot with the centroid constructed metadata coordinates
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
392 if( ( length( viMetadataDummy ) == 0 ) && ( is.null( sMetadata ) ) )
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
393 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
394 viMetadataDummy = 1:nrow(mMetadataCoordinates)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
395 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
396
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
397 # Plot samples
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
398 # Make output name
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
399 if(is.null(sOutputFileName))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
400 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
401 viPeriods = which(sInputFileName==".")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
402 if(length(viPeriods)>0)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
403 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
404 sOutputFileName = paste(OutputFileName[1:viPeriods[length(viPeriods)]],"pdf",sep=".")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
405 } else {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
406 sOutputFileName = paste(sInputFileName,"pdf",sep=".")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
407 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
408 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
409
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
410 pdf(sOutputFileName,useDingbats=FALSE)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
411 plot(mNMDSData$points, xlab=paste("NMDS1","Stress=",mNMDSData$stress), ylab="NMDS2", pch=vsShapes, col=vsColors)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
412 title(sTitle,line=3)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
413 # Plot Bugs
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
414 mPlotBugs = mNMDSData$species[viBugsToPlot,]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
415 if(length(viBugsToPlot)==1)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
416 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
417 text(x=mPlotBugs[1],y=mPlotBugs[2],labels=row.names(mNMDSData$species)[viBugsToPlot],col=sTextColor)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
418 } else if(length(viBugsToPlot)>1){
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
419 text(x=mPlotBugs[,1],y=mPlotBugs[,2],labels=row.names(mNMDSData$species)[viBugsToPlot],col=sTextColor)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
420 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
421
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
422 # Add alternative axes
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
423 axis(3, col=sArrowColor)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
424 axis(4, col=sArrowColor)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
425 box(col = "black")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
426
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
427 # Plot Metadata
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
428 if(length(viMetadataDummy)>0)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
429 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
430 if(fPlotArrow)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
431 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
432 # Plot arrows
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
433 for(i in viMetadataDummy)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
434 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
435 curCoordinates = mMetadataCoordinates[i,]
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
436 curCoordinates = curCoordinates * dResizeArrow
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
437 # Plot Arrow
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
438 arrows(0,0, curCoordinates[1] * 0.8, curCoordinates[2] * 0.8, col=sArrowColor, length=0.1 )
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
439 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
440 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
441 # Plot text
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
442 if(length(viMetadataDummy)==1)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
443 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
444 text(x=mMetadataCoordinates[viMetadataDummy,][1]*dResizeArrow*0.8, y=mMetadataCoordinates[viMetadataDummy,][2]*dResizeArrow*0.8, labels=row.names(mMetadataCoordinates)[viMetadataDummy],col=sArrowTextColor)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
445 } else {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
446 text(x=mMetadataCoordinates[viMetadataDummy,1]*dResizeArrow*0.8, y=mMetadataCoordinates[viMetadataDummy,2]*dResizeArrow*0.8, labels=row.names(mMetadataCoordinates)[viMetadataDummy],col=sArrowTextColor)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
447 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
448 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
449
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
450 sLegendText = c(paste(vsColorValues,sColorBy,sep="_"),paste(vsShapeValues,sMetadataShape,sep="_"))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
451 sLegendShapes = c(rep(cDefaultShape,length(vsColorValues)),vsShapeShapes)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
452 sLegendColors = c(vsColorRBG,rep(cDefaultColor,length(vsShapeValues)))
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
453 if(length(sLegendText)>0)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
454 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
455 legend("topright",legend=sLegendText,pch=sLegendShapes,col=sLegendColors)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
456 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
457
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
458 # Original biplot call if you want to check the custom ploting of the script
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
459 # There will be one difference where the biplot call scales an axis, this one does not. In relation to the axes, the points, text and arrows should still match.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
460 # Axes to the top and right are for the arrow, otherse are for markers and bug names.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
461 #biplot(mNMDSData$points,mMetadataCoordinates[viMetadataDummy,],xlabs=vsShapes,xlab=paste("MDS1","Stress=",mNMDSData$stress),main="Biplot function Bugs and Sampes - Metadata Plotted with Centroids")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
462 dev.off()
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
463 }
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
464
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
465 # This is the equivalent of __name__ == "__main__" in Python.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
466 # That is, if it's true we're being called as a command line script;
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
467 # if it's false, we're being sourced or otherwise included, such as for
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
468 # library or inlinedocs.
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
469 if( identical( environment( ), globalenv( ) ) &&
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
470 !length( grep( "^source\\(", sys.calls( ) ) ) )
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
471 {
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
472 lsArgs <- parse_args( pArgs, positional_arguments=TRUE )
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
473
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
474 print("lsArgs")
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
475 print(lsArgs)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
476
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
477 funcDoBiplot(
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
478 sBugs = lsArgs$options$sBugs,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
479 sMetadata = lsArgs$options$sMetadata,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
480 sColorBy = lsArgs$options$sColorBy,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
481 sColorRange = lsArgs$options$sColorRange,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
482 sTextColor = lsArgs$options$sTextColor,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
483 sArrowColor = lsArgs$options$sArrowColor,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
484 sArrowTextColor = lsArgs$options$sArrowTextColor,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
485 sPlotNAColor = lsArgs$options$sPlotNAColor,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
486 sShapeBy = lsArgs$options$sShapeBy,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
487 sShapes = lsArgs$options$sShapes,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
488 sDefaultMarker = lsArgs$options$sDefaultMarker,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
489 sRotateByMetadata = lsArgs$options$sRotateByMetadata,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
490 dResizeArrow = lsArgs$options$dResizeArrow,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
491 fPlotArrow = !lsArgs$options$fNoPlotMetadataArrows,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
492 sTitle = lsArgs$options$sTitle,
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
493 sInputFileName = lsArgs$args[2],
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
494 sLastMetadata = lsArgs$args[1],
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
495 sOutputFileName = lsArgs$options$sOutputFileName)
2f4f6f08c8c4 Uploaded
george-weingart
parents:
diff changeset
496 }