annotate galaxy_micropita/src/breadcrumbs/scripts/scriptBiplotTSV.R @ 3:8fb4630ab314 draft default tip

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