⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 summary.r

📁 这是个人脸识别程序
💻 R
字号:
# $masm/summary.R 1.4 milbo$ R program to plot model summary
#
# To generate the input data file ms.dat for this program:
#   cd masm\masm
#   del out\ms.dat
#   ms    -s "rowley-bioid" -S -m ../../stasm/stasm/data/model-1.asm -m ../../stasm/stasm/data/model-2.asm -r ../shape/84.shape -fb 1 -xi 0 /a1/faces/bioid/lpgm/b*.pgm
#   ms -v -s "vj-bioid"     -S -m ../../stasm/stasm/data/model-1.asm -m ../../stasm/stasm/data/model-2.asm -r ../shape/84.shape -fb 1 -xi 0 /a1/faces/bioid/lpgm/b*.pgm
#   ms -v -s "vj-ar"        -S -m ../../stasm/stasm/data/model-1.asm -m ../../stasm/stasm/data/model-2.asm -r ../shape/84.shape -fb 1 -xi 0 /a1/faces/ar/pgm/a*.pgm
#   ms -v -s "vj-xm2vts"    -S -m ../../stasm/stasm/data/model-1.asm -m ../../stasm/stasm/data/model-2.asm -r ../shape/84.shape -fb 1 -xi 0 /a1/faces/m2/pgm/m*.pgm
#
# Warning: this is raw research code -- expect it to be quite messy.

library(stats)
library(graphics)
dat.fname <- "./out/ms.dat"
ps.dir  <- "."  # postscript file directory
#ps.dir  <- ""  # use "" for no postscript file
xlim <- c(0, 0.15)
ime17 <- c(15,18,21,24,27,29,31,32,34,36,46,47,48,51,54,57,67)+1

plot.cr <- function()
{
    # Cristinacce CLM Fig 4c Feature Detection and Tracking with Constrained Local Models
    x <- c(.024, .03,  .035, .04,  .05,  .06,  .07,  .08,  .09,   .1,   .11,   .12,   .13,  .14,   .15)
    y <- c(0,    .015, .055, .135, .455, .685, .825, .885, .9055, .93,  .9405, .9555, .965, .9655, .975)
    lines(x=x, y=y, lty=2)
}

plot.one.cum <- function(model, fnames, mnames, me17s, dat, col)
{
    cat(model, ":\n")
    me17s.model <- me17s[mnames == model]
    iorder <- order(me17s.model, decreasing=TRUE)
    cat("   mean", mean(me17s.model), "median", median(me17s.model), "of", length(me17s.model), "\n")
    cat("   worst images", fnames[iorder[1:5]], "with me17s of", me17s[iorder[1:5]], "\n")
    cum <- ecdf(me17s.model)
    lines(cum, col.p=col, col.h=col, col.v=col, main="", xlim=xlim, verticals=TRUE, do.points=FALSE)
    cat("\n")
}
plot.cum <- function(caption, models, labels=NULL, fnames, mnames, me17s, dat, ps.fname, plot.cr=TRUE)
{
    if (nchar(ps.dir[1]) > 0) {
        ps.fname <- paste(ps.dir, "/", ps.fname, ".ps", sep="")
        cat("Plotting", dat.fname, "to", ps.fname, "\n")
        postscript(ps.fname, horizontal=FALSE, height=4, width=5, pointsize=10)
    }
    par(mar = c(4, 4, 2, 1))  # small margins and text to pack figs in
    par(mgp = c(2, 0.6, 0))   # flatten axis elements
    cat("\n", models[1], ":\n", sep="")
    me17s.model <- me17s[mnames == models[1]]
    if (length(me17s.model) < 10)
        warning("length(me17s.model) < 10")
    iorder <- order(me17s.model, decreasing=TRUE)
    cum <- ecdf(me17s.model)
    plot(cum, col.p="black", col.h="black", col.v="black", main="",
        xlab= "me17",
        ylab="proportion", xlim=xlim,
        verticals=TRUE, do.points=FALSE,
        xaxs="i", yaxs="i", col.01line = "white")

    if (plot.cr)
        plot.cr()

    abline(h=.5, lty="solid", col="gray")  # median line

    if(is.null(labels))
        labels <- models

    stopifnot(length(models) <= 6)
    # cols <- c("black", "gray", "pink", "lightblue4", "red", "green")
    cols <- c(1, "salmon", "slategray", 2, 3, 4)
    cols <- cols[1:length(models)]
    lty <- rep(1, length(models))
    plot.one.cum(models[1], fnames, mnames, me17s, dat, cols[1])    # replot over the median line
    for (i in 2:length(models))
        plot.one.cum(models[i], fnames, mnames, me17s, dat, cols[i])

    text(x=.06, y=.18, caption[1], pos=4)
    if(length(caption) >= 2)
        text(x=.06,   y=.12, caption[2], pos=4)
    if(length(caption) >= 3)
        text(x=.06,   y=.06, caption[3], pos=4)

    if (plot.cr) {
        cols = c(cols, 1)
        lty = c(lty, 2)
        labels = c(labels, "CLM Fig 4.c")
    }
    legend(x=.065, y=.56, labels, col=cols, text.col=cols, lty=lty, bg="White")

     # remove the dotted horizontal lines drawn by lines() at top and bottom of graph
     abline(h=0, col="black")
     abline(h=1, col="black")

    if (nchar(ps.dir[1]) > 0)
        dev.off()       # finish postscript
}
dat <- read.table(dat.fname, header=TRUE)
fnames <- as.character(dat[ , "File"])
mnames <- dat[ , "Model"]
me17s <- rowMeans(dat[, ime17+5])   # +5 skips first cols to get to data colums
stopifnot(length(me17s) == length(mnames))
plot.cum(
    caption = c("stasm version 0.3", "stacked model-1 and model-2", "Viola Jones detector"),
    models = c("vj-bioid", "vj-ar", "vj-xm2vts"),
    labels = c("BioID test set", "AR validation set", "XM2VTS training set"),
    fnames, mnames, me17s, dat, "stasm-summary")

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -