Peter M. Groen / openbr

Commit ab99a82033af9e248e685b29acb80084753caa6f

Authored by Ben Klein
1 parent 4dd80ff8

Start moving R code to plot_utils.R

Inline Side-by-side
Showing 2 changed files with 182 additions and 181 deletions
openbr/core/plot.cpp
  View file @ab99a82
... ... @@ -68,7 +68,7 @@ struct RPlot
68 68  
69 69 Pivot major, minor;
70 70  
71   - RPlot(QStringList files, const File &destination, bool isEvalFormat = true)
  71 + RPlot(QStringList files, const File &destination)
72 72 {
73 73 if (files.isEmpty()) qFatal("Empty file list.");
74 74 qSort(files.begin(), files.end(), sortFiles);
... ... @@ -83,13 +83,9 @@ struct RPlot
83 83 bool success = file.open(QFile::WriteOnly);
84 84 if (!success) qFatal("Failed to open %s for writing.", qPrintable(file.fileName()));
85 85  
86   - file.write("# Load libraries\n"
87   - "library(ggplot2)\n"
88   - "library(gplots)\n"
89   - "library(reshape)\n"
90   - "library(scales)\n"
91   - "\n"
92   - "# Read CSVs\n"
  86 + // Copy plot_utils.R into output script with source()
  87 + file.write(qPrintable(QString("source(\"%1\")\n\n").arg(Globals->sdkPath + "/share/openbr/plotting/plot_utils.R")));
  88 + file.write("# Read CSVs\n"
93 89 "data <- NULL\n");
94 90  
95 91 // Read files and retrieve pivots
... ... @@ -123,8 +119,6 @@ struct RPlot
123 119 }
124 120  
125 121 const QString &smooth = destination.get<QString>("smooth", "");
126   - confidence = destination.get<float>("confidence", 95) / 100.0;
127   -
128 122 major.smooth = !smooth.isEmpty() && (major.header == smooth) && (major.size > 1);
129 123 minor.smooth = !smooth.isEmpty() && (minor.header == smooth) && (minor.size > 1);
130 124 if (major.smooth) major.size = 1;
... ... @@ -132,68 +126,9 @@ struct RPlot
132 126 if (major.size < minor.size)
133 127 std::swap(major, minor);
134 128  
  129 + confidence = destination.get<float>("confidence", 95) / 100.0;
135 130 ncol = destination.get<int>("ncol", major.size > 1 ? major.size : (minor.header.isEmpty() ? major.size : minor.size));
136 131 flip = minor.header == "Algorithm";
137   - // Format data
138   - if (isEvalFormat)
139   - file.write(qPrintable(QString("\n"
140   - "# Split data into individual plots\n"
141   - "plot_index = which(names(data)==\"Plot\")\n"
142   - "Metadata <- data[grep(\"Metadata\",data$Plot),-c(1)]\n"
143   - "IM <- data[grep(\"IM\",data$Plot),-c(1)]\n"
144   - "GM <- data[grep(\"GM\",data$Plot),-c(1)]\n"
145   - "DET <- data[grep(\"DET\",data$Plot),-c(1)]\n"
146   - "IET <- data[grep(\"IET\",data$Plot),-c(1)]\n"
147   - "FAR <- data[grep(\"FAR\",data$Plot),-c(1)]\n"
148   - "FRR <- data[grep(\"FRR\",data$Plot),-c(1)]\n"
149   - "SD <- data[grep(\"SD\",data$Plot),-c(1)]\n"
150   - "TF <- data[grep(\"TF\",data$Plot),-c(1)]\n"
151   - "FT <- data[grep(\"FT\",data$Plot),-c(1)]\n"
152   - "CT <- data[grep(\"CT\",data$Plot),-c(1)]\n"
153   - "BC <- data[grep(\"BC\",data$Plot),-c(1)]\n"
154   - "TS <- data[grep(\"TS\",data$Plot),-c(1)]\n"
155   - "CMC <- data[grep(\"CMC\",data$Plot),-c(1)]\n"
156   - "FAR$Error <- \"FAR\"\n"
157   - "FRR$Error <- \"FRR\"\n"
158   - "ERR <- rbind(FAR, FRR)\n"
159   - "rm(data, FAR, FRR)\n"
160   - "\n"
161   - "# Format data\n"
162   - "Metadata$Y<-factor(Metadata$Y, levels=c(\"Genuine\",\"Impostor\",\"Ignored\",\"Gallery\",\"Probe\"))\n"
163   - "IM$Y <- as.character(IM$Y)\n"
164   - "GM$Y <- as.character(GM$Y)\n"
165   - "DET$Y <- as.numeric(as.character(DET$Y))\n"
166   - "IET$Y <- as.numeric(as.character(IET$Y))\n"
167   - "ERR$Y <- as.numeric(as.character(ERR$Y))\n"
168   - "SD$Y <- as.factor(unique(as.character(SD$Y)))\n"
169   - "TF$Y <- as.numeric(as.character(TF$Y))\n"
170   - "FT$Y <- as.numeric(as.character(FT$Y))\n"
171   - "CT$Y <- as.numeric(as.character(CT$Y))\n"
172   - "BC$Y <- as.numeric(as.character(BC$Y))\n"
173   - "TS$Y <- as.character(TS$Y)\n"
174   - "CMC$Y <- as.numeric(as.character(CMC$Y))\n"
175   - "\n"
176   - "if (%1) {\n\tsummarySE <- function(data=NULL, measurevar, groupvars=NULL, na.rm=FALSE, conf.interval=%3, .drop=TRUE) {\n\t\t"
177   - "require(plyr)\n\n\t\tlength2 <- function (x, na.rm=FALSE) {\n\t\t\tif (na.rm) sum(!is.na(x))\n\t\t\telse length(x)"
178   - "\n\t\t}\n\n\t\tdatac <- ddply(data, groupvars, .drop=.drop, .fun = function(xx, col) {\n\t\t\t"
179   - "c(N=length2(xx[[col]], na.rm=na.rm), mean=mean(xx[[col]], na.rm=na.rm), sd=sd(xx[[col]], na.rm=na.rm))\n\t\t\t},"
180   - "\n\t\t\tmeasurevar\n\t\t)\n\n\t\tdatac <- rename(datac, c(\"mean\" = measurevar))\n\t\tdatac$se <- datac$sd / sqrt(datac$N)"
181   - "\n\t\tciMult <- qt(conf.interval/2 + .5, datac$N-1)\n\t\tdatac$ci <- datac$se * ciMult\n\n\t\t"
182   - "datac$upper <- if(datac[, measurevar] + datac$ci < 1) (datac[, measurevar] + datac$ci) else 1\n\t\t"
183   - "datac$lower <- if(datac[, measurevar] - datac$ci > 0) (datac[, measurevar] - datac$ci) else 0\n\n\t\treturn(datac)\n\t}\n\t"
184   - "DET <- summarySE(DET, measurevar=\"Y\", groupvars=c(\"%2\", \"X\"))\n\t"
185   - "IET <- summarySE(IET, measurevar=\"Y\", groupvars=c(\"%2\", \"X\"))\n\t"
186   - "CMC <- summarySE(CMC, measurevar=\"Y\", groupvars=c(\"%2\", \"X\"))\n\t"
187   - "ERR <- summarySE(ERR, measurevar=\"X\", groupvars=c(\"Error\", \"%2\", \"Y\"))\n\t"
188   - "TF <- summarySE(TF, measurevar=\"Y\", groupvars=c(\"%2\", \"X\"))\n\t"
189   - "FT <- summarySE(FT, measurevar=\"Y\", groupvars=c(\"%2\", \"X\"))\n\t"
190   - "CT <- summarySE(CT, measurevar=\"Y\", groupvars=c(\"%2\", \"X\"))\n}\n\n"
191   - "# Code to format FAR values\n"
192   - "far_names <- list('0.001'=\"FAR = 0.1%\", '0.01'=\"FAR = 1%\")\n"
193   - "far_labeller <- function(variable,value) { return(far_names[as.character(value)]) }\n"
194   - "\n").arg((major.smooth || minor.smooth) ? "TRUE" : "FALSE",
195   - major.size > 1 ? major.header : (minor.header.isEmpty() ? major.header : minor.header),
196   - QString::number(confidence))));
197 132  
198 133 // Open output device
199 134 file.write(qPrintable(QString("\n"
... ... @@ -205,77 +140,6 @@ struct RPlot
205 140 "# Write figures\n");
206 141 }
207 142  
208   - void plotMetadata(bool csv)
209   - {
210   - file.write(qPrintable(QString("# Code to format TAR@FAR table\n"
211   - "algs <- unique(%4)\n"
212   - "algs <- algs[!duplicated(algs)]\n"
213   - "mat <- matrix(%1,nrow=6,ncol=length(algs),byrow=FALSE)\n"
214   - "colnames(mat) <- algs \n"
215   - "rownames(mat) <- c(\"FAR = 1e-06\", \"FAR = 1e-05\", \"FAR = 1e-04\", \"FAR = 1e-03\", \"FAR = 1e-02\", \"FAR = 1e-01\")\n"
216   - "TFtable <- as.table(mat)\n"
217   - "\n"
218   - "# Code to format FAR@TAR table\n"
219   - "mat <- matrix(%2,nrow=6,ncol=length(algs),byrow=FALSE)\n"
220   - "colnames(mat) <- algs \n"
221   - "rownames(mat) <- c(\"TAR = 0.40\", \"TAR = 0.50\", \"TAR = 0.65\", \"TAR = 0.75\", \"TAR = 0.85\", \"TAR = 0.95\")\n"
222   - "FTtable <- as.table(mat)\n"
223   - "\n"
224   - "# Code to format CMC Table\n"
225   - "mat <- matrix(%3,nrow=6,ncol=length(algs),byrow=FALSE)\n"
226   - "colnames(mat) <- algs \n"
227   - "rownames(mat) <- c(\"Rank 1\", \"Rank 5\", \"Rank 10\", \"Rank 20\", \"Rank 50\", \"Rank 100\")\n"
228   - "CMCtable <- as.table(mat)\n"
229   - "\n"
230   - "# Code to format Template Size Table\n"
231   - "if (nrow(TS) != 0) {\n\t"
232   - "mat <- matrix(TS$Y,nrow=1,ncol=length(algs),byrow=FALSE)\n\t"
233   - "colnames(mat) <- algs\n\t"
234   - "rownames(mat) <- c(\"Template Size (bytes):\")\n\t"
235   - "TStable <- as.table(mat)\n}"
236   - "\n").arg((major.smooth || minor.smooth) && confidence != 0 ? "paste(as.character(round(TF$Y, 3)), round(TF$ci, 3), sep=\"\\u00b1\")" : "TF$Y",
237   - (major.smooth || minor.smooth) && confidence != 0 ? "paste(as.character(round(FT$Y, 3)), round(FT$ci, 3), sep=\"\\u00b1\")" : "FT$Y",
238   - (major.smooth || minor.smooth) && confidence != 0 ? "paste(as.character(round(CT$Y, 3)), round(CT$ci, 3), sep=\"\\u00b1\")" : "CT$Y",
239   - (major.size > 1 && minor.size > 1) && !(major.smooth || minor.smooth) ? QString("paste(TF$%1, TF$%2, sep=\"_\")").arg(major.header, minor.header)
240   - : QString("TF$%1").arg(major.size > 1 ? major.header : (minor.header.isEmpty() ? major.header : minor.header)))));
241   -
242   - file.write("\n# Write metadata table\n");
243   - QString textplot = "MT <- as.data.frame(Metadata[c(1,2,3,4,5),])\n"
244   - "par(mfrow=c(4,1))\n"
245   - "plot.new()\n"
246   - "print(title(paste(\"%1 - %2\",date(),sep=\"\\n\")))\n"
247   - "mat <- matrix(MT$X[c(1,2)],ncol=2)\n"
248   - "colnames(mat) <- c(\"Gallery\", \"Probe\")\n"
249   - "imageTable <- as.table(mat)\n"
250   - "print(textplot(imageTable,show.rownames=FALSE))\n"
251   - "print(title(\"Images\"))\n"
252   - "mat <- matrix(MT$X[c(3,4,5)],ncol=3)\n"
253   - "colnames(mat) <- c(\"Genuine\", \"Impostor\", \"Ignored\")\n"
254   - "matchTable <- as.table(mat)\n"
255   - "print(textplot(matchTable,show.rownames=FALSE))\n"
256   - "print(title(\"Matches\"))\n"
257   - "plot.new()\n"
258   - "print(title(\"Gallery * Probe = Genuine + Impostor + Ignored\"))\n";
259   - file.write(qPrintable(textplot.arg(PRODUCT_NAME, PRODUCT_VERSION)));
260   -
261   - if (csv)
262   - textplot = QString("write.csv(TFtable,file=\"%1_TF.csv\")\n"
263   - "write.csv(FTtable,file=\"%1_FT.csv\")\n"
264   - "write.csv(CMCtable,file=\"%1_CMC.csv\")\n\n").arg(basename);
265   - else
266   - textplot = "plot.new()\n"
267   - "print(textplot(TFtable))\n"
268   - "print(title(\"Table of True Accept Rates at various False Accept Rates\"))\n"
269   - "print(textplot(FTtable))\n"
270   - "print(title(\"Table of False Accept Rates at various True Accept Rates\"))\n"
271   - "print(textplot(CMCtable))\n"
272   - "print(title(\"Table of retrieval rate at various ranks\"))\n"
273   - "if (nrow(TS) != 0) {\n\t"
274   - "print(textplot(TStable, cex=1.15))\n\t"
275   - "print(title(\"Template Size by Algorithm\"))\n}\n\n";
276   - file.write(qPrintable(textplot));
277   - }
278   -
279 143 void qplot(QString geom, QString data, bool flipY, File opts)
280 144 {
281 145 file.write(qPrintable(QString("qplot(X, %1, data=%2, geom=\"%3\", main=\"%4\"").arg(flipY ? "1-Y" : "Y", data, geom, opts.get<QString>("title", "")) +
... ... @@ -315,6 +179,25 @@ bool Plot(const QStringList &amp;files, const File &amp;destination, bool show)
315 179 qDebug("Plotting %d file(s) to %s", files.size(), qPrintable(destination));
316 180  
317 181 RPlot p(files, destination);
  182 + p.file.write("\nevalFormatting()\n\n");
  183 +
  184 + // Set variables in R
  185 + p.file.write(qPrintable(QString("basename <- \"%1\"\n").arg(p.basename)));
  186 + p.file.write(qPrintable(QString("errBars <- %1\n").arg((p.major.smooth || p.minor.smooth) && p.confidence != 0 ? "TRUE" : "FALSE")));
  187 + p.file.write(qPrintable(QString("csv <- %1\n").arg(destination.getBool("csv") ? "TRUE" : "FALSE")));
  188 + p.file.write(qPrintable(QString("algs <- %1\n").arg((p.major.size > 1 && p.minor.size > 1) && !(p.major.smooth || p.minor.smooth) ? QString("paste(TF$%1, TF$%2, sep=\"_\")").arg(p.major.header, p.minor.header)
  189 + : QString("TF$%1").arg(p.major.size > 1 ? p.major.header : (p.minor.header.isEmpty() ? p.major.header : p.minor.header)))));
  190 + p.file.write("algs <- algs[!duplicated(algs)]\n");
  191 +
  192 + if (p.major.smooth || p.minor.smooth) {
  193 + QString groupvar = p.major.size > 1 ? p.major.header : (p.minor.header.isEmpty() ? p.major.header : p.minor.header);
  194 + foreach(const QString &type, QStringList() << "DET" << "IET" << "CMC" << "TF" << "FT" << "CT") {
  195 + p.file.write(qPrintable(QString("%1 <- summarySE(%1, measurevar=\"Y\", groupvars=c(\"%2\", \"X\"), conf.interval=%3)"
  196 + "\n").arg(type, groupvar, QString::number(p.confidence))));
  197 + }
  198 + p.file.write(qPrintable(QString("%1 <- summarySE(%1, measurevar=\"X\", groupvars=c(\"Error\", \"%2\", \"Y\"), conf.interval=%3)"
  199 + "\n\n").arg("ERR", groupvar, QString::number(p.confidence))));
  200 + }
318 201  
319 202 // Use a br::file for simple storage of plot options
320 203 QMap<QString,File> optMap;
... ... @@ -333,8 +216,23 @@ bool Plot(const QStringList &amp;files, const File &amp;destination, bool show)
333 216 }
334 217  
335 218 // optional plot metadata and accuracy tables
336   - if (destination.getBool("metadata", true))
337   - p.plotMetadata(destination.getBool("csv", false));
  219 + if (destination.getBool("metadata", true)) {
  220 + p.file.write("\n# Write metadata table\n");
  221 + p.file.write(qPrintable(QString("plotMetadata(data=data, title=\"%1 - %2\")\n").arg(PRODUCT_NAME, PRODUCT_VERSION)));
  222 +
  223 + if (!destination.getBool("csv")) p.file.write("plot.new()\n");
  224 + QString table = "plotTable(data=%1, name=%2, labels=%3)\n";
  225 + p.file.write(qPrintable(table.arg("TF", "\"Table of True Accept Rates at various False Accept Rates\"",
  226 + "c(\"FAR = 1e-06\", \"FAR = 1e-05\", \"FAR = 1e-04\", \"FAR = 1e-03\", \"FAR = 1e-02\", \"FAR = 1e-01\")")));
  227 + p.file.write(qPrintable(table.arg("FT", "\"Table of False Accept Rates at various True Accept Rates\"",
  228 + "c(\"TAR = 0.40\", \"TAR = 0.50\", \"TAR = 0.65\", \"TAR = 0.75\", \"TAR = 0.85\", \"TAR = 0.95\")")));
  229 + p.file.write(qPrintable(table.arg("CT", "\"Table of retrieval rate at various ranks\"",
  230 + "c(\"Rank 1\", \"Rank 5\", \"Rank 10\", \"Rank 20\", \"Rank 50\", \"Rank 100\")")));
  231 + p.file.write(qPrintable(table.arg("TS", "\"Template Size by Algorithm\"",
  232 + "c(\"Template Size (bytes):\")")));
  233 + p.file.write("\n");
  234 + }
  235 +
338 236 p.qplot("line", "DET", true, optMap["rocOptions"]);
339 237 p.qplot("line", "DET", false, optMap["detOptions"]);
340 238 p.qplot("line", "IET", false, optMap["ietOptions"]);
... ... @@ -361,12 +259,7 @@ bool Plot(const QStringList &amp;files, const File &amp;destination, bool show)
361 259 ((p.flip ? p.minor.size : p.major.size) > 1 ? QString(" + facet_wrap(~ %1, scales=\"free_x\")").arg(p.flip ? p.minor.header : p.major.header) : QString()) +
362 260 QString(" + theme(aspect.ratio=1)\n\n")));
363 261  
364   - p.file.write(qPrintable(QString("if (nrow(IM) != 0) {\n\tlibrary(jpeg)\n\tlibrary(png)\n\tlibrary(grid)\n\t") +
365   - QString("multiplot <- function(..., plotlist=NULL, cols) {\n\t") +
366   - QString("\trequire(grid)\n\n\t\t# Make a list from the ... arguments and plotlist\n\t\tplots <- c(list(...), plotlist)\n") +
367   - QString("\t\tnumPlots = length(plots)\n\n\t\t# Make the panel\n\t\tplotCols = cols\n\t\tplotRows = ceiling(numPlots/plotCols)\n\n") +
368   - QString("\t\t# Set up the page\n\t\tgrid.newpage()\n\t\tpushViewport(viewport(layout = grid.layout(plotRows, plotCols)))\n\t\tvplayout <- function(x, y)\n\t\t\tviewport(layout.pos.row = x, layout.pos.col = y)\n\n") +
369   - QString("\t\t# Make each plot, in the correct location\n\t\tfor (i in 1:numPlots) {\n\t\t\tcurRow = ceiling(i/plotCols)\n\t\t\tcurCol = (i-1) %% plotCols + 1\n\t\t\tprint(plots[[i]], vp = vplayout(curRow, curCol))\n\t\t}\n\t}\n\n")));
  262 + p.file.write(qPrintable(QString("if (nrow(IM) != 0) {\n\tlibrary(jpeg)\n\tlibrary(png)\n\tlibrary(grid)\n\t")));
370 263  
371 264 p.file.write(qPrintable(QString("\t# Print impostor matches above the EER\n\tfor (i in 1:nrow(IM)) {\n\t\tscore <- IM[i,1]\n\t\tfiles <- IM[i,2]\n\t\talg <- IM[i,3]\n\t\tfiles <- unlist(strsplit(files, \"[:]\"))\n\n\t\text1 <- unlist(strsplit(files[2], \"[.]\"))[2]\n\t\text2 <- unlist(strsplit(files[4], \"[.]\"))[2]\n\t\t") +
372 265 QString("if (ext1 == \"jpg\" || ext1 == \"JPEG\" || ext1 == \"jpeg\" || ext1 == \"JPG\") {\n\t\t\timg1 <- readJPEG(files[2])\n\t\t} else if (ext1 == \"PNG\" || ext1 == \"png\") {\n\t\t\timg1 <- readPNG(files[2])\n\t\t} else if (ext1 == \"TIFF\" || ext1 == \"tiff\" || ext1 == \"TIF\" || ext1 == \"tif\") {\n\t\t\timg1 <- readTIFF(files[2])\n\t\t} else {\n\t\t\tnext\n\t\t}\n\t\tif (ext2 == \"jpg\" || ext2 == \"JPEG\" || ext2 == \"jpeg\" || ext2 == \"JPG\") {\n\t\t\timg2 <- readJPEG(files[4])\n\t\t} ") +
... ... @@ -420,7 +313,7 @@ bool filesHaveSinglePoint(const QStringList &amp;files) {
420 313 bool PlotDetection(const QStringList &files, const File &destination, bool show)
421 314 {
422 315 qDebug("Plotting %d detection file(s) to %s", files.size(), qPrintable(destination));
423   - RPlot p(files, destination, false);
  316 + RPlot p(files, destination);
424 317  
425 318 // Use a br::file for simple storage of plot options
426 319 QMap<QString,File> optMap;
... ... @@ -478,7 +371,7 @@ bool PlotDetection(const QStringList &amp;files, const File &amp;destination, bool show)
478 371 bool PlotLandmarking(const QStringList &files, const File &destination, bool show)
479 372 {
480 373 qDebug("Plotting %d landmarking file(s) to %s", files.size(), qPrintable(destination));
481   - RPlot p(files, destination, false);
  374 + RPlot p(files, destination);
482 375  
483 376 p.file.write(qPrintable(QString("# Split data into individual plots\n"
484 377 "plot_index = which(names(data)==\"Plot\")\n"
... ... @@ -494,14 +387,6 @@ bool PlotLandmarking(const QStringList &amp;files, const File &amp;destination, bool sho
494 387 "rm(data)\n"
495 388 "\n")));
496 389  
497   - p.file.write(qPrintable(QString("summarySE <- function(data=NULL, measurevar, groupvars=NULL, na.rm=FALSE, conf.interval=.95, .drop=TRUE) {\n\t"
498   - "require(plyr)\n\n\tlength2 <- function (x, na.rm=FALSE) {\n\t\tif (na.rm) sum(!is.na(x))\n\t\telse length(x)"
499   - "\n\t}\n\n\tdatac <- ddply(data, groupvars, .drop=.drop, .fun = function(xx, col) {\n\t\t"
500   - "c(N=length2(xx[[col]], na.rm=na.rm), mean=mean(xx[[col]], na.rm=na.rm), sd=sd(xx[[col]], na.rm=na.rm))\n\t\t},"
501   - "\n\t\tmeasurevar\n\t)\n\n\tdatac <- rename(datac, c(\"mean\" = measurevar))\n\tdatac$se <- datac$sd / sqrt(datac$N)"
502   - "\n\tciMult <- qt(conf.interval/2 + .5, datac$N-1)\n\tdatac$ci <- datac$se * ciMult\n\n\treturn(datac)\n}\n")));
503   -
504   -
505 390 p.file.write(qPrintable(QString("\nreadData <- function(data) {\n\texamples <- list()\n"
506 391 "\tfor (i in 1:nrow(data)) {\n"
507 392 "\t\tpath <- data[i,1]\n"
... ... @@ -525,27 +410,7 @@ bool PlotLandmarking(const QStringList &amp;files, const File &amp;destination, bool sho
525 410  
526 411 p.file.write(qPrintable(QString("\nlibrary(jpeg)\n"
527 412 "library(png)\n"
528   - "library(grid)\n"
529   - "multiplot <- function(..., plotlist=NULL, cols) {\n"
530   - "\trequire(grid)\n"
531   - "\t# Make a list from the ... arguments and plotlist\n"
532   - "\tplots <- c(list(...), plotlist)\n"
533   - "\tnumPlots = length(plots)\n"
534   - "\t# Make the panel\n"
535   - "\tplotCols = cols\n"
536   - "\tplotRows = ceiling(numPlots/plotCols)\n"
537   - "\t# Set up the page\n"
538   - "\tgrid.newpage()\n"
539   - "\tpushViewport(viewport(layout = grid.layout(plotRows, plotCols)))\n"
540   - "\tvplayout <- function(x, y)\n"
541   - "\tviewport(layout.pos.row = x, layout.pos.col = y)\n"
542   - "\t# Make each plot, in the correct location\n"
543   - "\tfor (i in 1:numPlots) {\n"
544   - "\t\tcurRow = ceiling(i/plotCols)\n"
545   - "\t\tcurCol = (i-1) %% plotCols + 1\n"
546   - "\t\tprint(plots[[i]], vp = vplayout(curRow, curCol))\n"
547   - "\t}\n"
548   - "}\n")));
  413 + "library(grid)\n")));
549 414  
550 415 p.file.write(qPrintable(QString("\nplotImage <- function(image, title=NULL, label=NULL) { \n"
551 416 "\tp <- qplot(1:10, 1:10, geom=\"blank\") + annotation_custom(rasterGrob(image$image), xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) + theme(axis.line=element_blank(), axis.title.y=element_blank(), axis.text.x=element_blank(), axis.text.y=element_blank(), line=element_blank(), axis.ticks=element_blank(), panel.background=element_blank()) + labs(title=title) + xlab(label)\n"
... ... @@ -599,7 +464,7 @@ bool PlotMetadata(const QStringList &amp;files, const QString &amp;columns, bool show)
599 464 {
600 465 qDebug("Plotting %d metadata file(s) for columns %s", files.size(), qPrintable(columns));
601 466  
602   - RPlot p(files, "PlotMetadata", false);
  467 + RPlot p(files, "PlotMetadata");
603 468 foreach (const QString &column, columns.split(";"))
604 469 p.file.write(qPrintable(QString("qplot(%1, %2, data=data, geom=\"violin\", fill=%1) + coord_flip() + theme_minimal()\nggsave(\"%2.pdf\")\n").arg(p.major.header, column)));
605 470 return p.finalize(show);
... ...
share/openbr/plotting/plot_utils.R 0 → 100644
  View file @ab99a82
  1 +# Load libraries
  2 +library("ggplot2")
  3 +library("gplots")
  4 +library("reshape")
  5 +library("scales")
  6 +
  7 +# Code to format FAR values
  8 +far_names <- list('0.001'="FAR = 0.1%", '0.01'="FAR = 1%")
  9 +far_labeller <- function(variable,value) { return(far_names[as.character(value)]) }
  10 +
  11 +plotMetadata <-function(data, title) {
  12 + MT <- as.data.frame(Metadata[c(1, 2, 3, 4, 5),])
  13 + par(mfrow=c(4, 1))
  14 + plot.new()
  15 + print(title(paste(title, date(), sep="\n")))
  16 + mat <- matrix(MT$X[c(1, 2)], ncol=2)
  17 + colnames(mat) <- c("Gallery", "Probe")
  18 + imageTable <- as.table(mat)
  19 + print(textplot(imageTable, show.rownames=FALSE))
  20 + print(title("Images"))
  21 + mat <- matrix(MT$X[c(3, 4, 5)], ncol=3)
  22 + colnames(mat) <- c("Genuine", "Impostor", "Ignored")
  23 + matchTable <- as.table(mat)
  24 + print(textplot(matchTable, show.rownames=FALSE))
  25 + print(title("Matches"))
  26 + plot.new()
  27 + print(title("Gallery * Probe = Genuine + Impostor + Ignored"))
  28 +}
  29 +
  30 +plotTable <- function(data, name, labels) {
  31 + if (nrow(data) == 0) return()
  32 + if (errBars) {
  33 + input = paste(as.character(round(data$Y, 3)), round(data$ci, 3), sep="\u00b1")
  34 + } else {
  35 + input = data$Y
  36 + }
  37 + mat <- matrix(input, nrow=length(labels), ncol=length(algs), byrow=FALSE)
  38 + colnames(mat) <- algs
  39 + rownames(mat) <- labels
  40 + table <- as.table(mat)
  41 + if (csv) {
  42 + write.csv(table, file=paste(paste(basename, deparse(substitute(data)), sep="_"), ".csv", sep=""))
  43 + } else {
  44 + print(textplot(table))
  45 + print(title(name))
  46 + }
  47 +}
  48 +
  49 +evalFormatting <- function() {
  50 + # Split data into individual plots
  51 + plot_index <<- which(names(data)=="Plot")
  52 + Metadata <<- data[grep("Metadata",data$Plot),-c(1)]
  53 + IM <<- data[grep("IM",data$Plot),-c(1)]
  54 + GM <<- data[grep("GM",data$Plot),-c(1)]
  55 + DET <<- data[grep("DET",data$Plot),-c(1)]
  56 + IET <<- data[grep("IET",data$Plot),-c(1)]
  57 + FAR <- data[grep("FAR",data$Plot),-c(1)]
  58 + FRR <- data[grep("FRR",data$Plot),-c(1)]
  59 + SD <<- data[grep("SD",data$Plot),-c(1)]
  60 + TF <<- data[grep("TF",data$Plot),-c(1)]
  61 + FT <<- data[grep("FT",data$Plot),-c(1)]
  62 + CT <<- data[grep("CT",data$Plot),-c(1)]
  63 + BC <<- data[grep("BC",data$Plot),-c(1)]
  64 + TS <<- data[grep("TS",data$Plot),-c(1)]
  65 + CMC <<- data[grep("CMC",data$Plot),-c(1)]
  66 + FAR$Error <- "FAR"
  67 + FRR$Error <- "FRR"
  68 + ERR <<- rbind(FAR, FRR)
  69 +
  70 + # Format data
  71 + Metadata$Y<-factor(Metadata$Y, levels=c("Genuine", "Impostor", "Ignored", "Gallery", "Probe"))
  72 + IM$Y <<- as.character(IM$Y)
  73 + GM$Y <<- as.character(GM$Y)
  74 + DET$Y <<- as.numeric(as.character(DET$Y))
  75 + IET$Y <<- as.numeric(as.character(IET$Y))
  76 + ERR$Y <<- as.numeric(as.character(ERR$Y))
  77 + SD$Y <<- as.factor(unique(as.character(SD$Y)))
  78 + TF$Y <<- as.numeric(as.character(TF$Y))
  79 + FT$Y <<- as.numeric(as.character(FT$Y))
  80 + CT$Y <<- as.numeric(as.character(CT$Y))
  81 + BC$Y <<- as.numeric(as.character(BC$Y))
  82 + TS$Y <<- as.character(TS$Y)
  83 + CMC$Y <<- as.numeric(as.character(CMC$Y))
  84 +}
  85 +
  86 +summarySE <- function(data=NULL, measurevar, groupvars=NULL, na.rm=FALSE, conf.interval=0.95, .drop=TRUE) {
  87 + require(plyr)
  88 +
  89 + length2 <- function (x, na.rm=FALSE) {
  90 + if (na.rm) sum(!is.na(x))
  91 + else length(x)
  92 + }
  93 +
  94 + datac <- ddply(data, groupvars, .drop=.drop, .fun = function(xx, col) {
  95 + c(N=length2(xx[[col]], na.rm=na.rm), mean=mean(xx[[col]], na.rm=na.rm), sd=sd(xx[[col]], na.rm=na.rm))
  96 + },
  97 + measurevar
  98 + )
  99 +
  100 + datac <- rename(datac, c("mean" = measurevar))
  101 + datac$se <- datac$sd / sqrt(datac$N)
  102 + ciMult <- qt(conf.interval/2 + .5, datac$N-1)
  103 + datac$ci <- datac$se * ciMult
  104 +
  105 + datac$upper <- if(datac[, measurevar] + datac$ci < 1) (datac[, measurevar] + datac$ci) else 1
  106 + datac$lower <- if(datac[, measurevar] - datac$ci > 0) (datac[, measurevar] - datac$ci) else 0
  107 +
  108 + return(datac)
  109 +}
  110 +
  111 +plotLine <- function(data=NULL, x=X, y=Y, options=list()) {
  112 + p <- qplot(x, y, data=data, geom="line")
  113 + return(p)
  114 +}
  115 +
  116 +multiplot <- function(..., plotlist=NULL, cols) {
  117 + require(grid)
  118 + # Make a list from the ... arguments and plotlist
  119 + plots <- c(list(...), plotlist)
  120 + numPlots = length(plots)
  121 + # Make the panel
  122 + plotCols = cols
  123 + plotRows = ceiling(numPlots/plotCols)
  124 + # Set up the page
  125 + grid.newpage()
  126 + pushViewport(viewport(layout = grid.layout(plotRows, plotCols)))
  127 + vplayout <- function(x, y)
  128 + viewport(layout.pos.row = x, layout.pos.col = y)
  129 + # Make each plot, in the correct location
  130 + for (i in 1:numPlots) {
  131 + curRow = ceiling(i/plotCols)
  132 + curCol = (i-1) %% plotCols + 1
  133 + print(plots[[i]], vp = vplayout(curRow, curCol))
  134 + }
  135 +}
  136 +
... ...