Problemy z zapisywaniem wykresu sieci neuronowej przy użyciu pakietu Neuralnet - R

Question

Używam pakietu neuralnet w R, jednak mam problemy z zapisaniem wydruku na dysk.

data(iris) 
attach(iris) 
library(neuralnet) 

nn <- neuralnet(as.numeric(Species) ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width, data = iris) 

png("test.png") 
plot(nn) 
dev.off() 

próbowali referen do manual, w sekcji plot.nn() mówi:

file  a character string naming the plot to write to. If not stated, 
the plot will not be saved. 

Jednak robią następujące plony nie ważne działka zbawiony

png("test.png") 
plot(nn, file = "test.png") 
dev.off() 

Platforma:

Mac OSX 10.7.3 

wersja

R:

platform  x86_64-apple-darwin11.3.0  
arch   x86_64      
os    darwin11.3.0     
system   x86_64, darwin11.3.0   
status          
major   2        
minor   15.1       
year   2012       
month   06       
day   22       
svn rev  59600       
language  R        
version.string R version 2.15.1 (2012-06-22) 
nickname  Roasted Marshmallows 

Uwaga: R został zainstalowany przez DarwinPorts

Answer 1

Po rozmowie z Frauke Guenther (opiekuna neuralnet), wyjaśnia problem leży neuralnet „s zdolność do działki więcej niż jednej sieci neuronowej w tym samym czasie.

plot(..., file = "") powinien zapisać plik na dysku, jednak nie wydaje się działać poprawnie, poprawka zostanie poprawione wkrótce do samego opakowania, jednak za średniego czasu ona uprzejmości szybki plot.nn() poprawki, które pozwalają na zapisz działkę na dysku.

plot.nn <- 
function (x, rep = NULL, x.entry = NULL, x.out = NULL, radius = 0.15, 
    arrow.length = 0.2, intercept = TRUE, intercept.factor = 0.4, 
    information = TRUE, information.pos = 0.1, col.entry.synapse = "black", 
    col.entry = "black", col.hidden = "black", col.hidden.synapse = "black", 
    col.out = "black", col.out.synapse = "black", col.intercept = "blue", 
    fontsize = 12, dimension = 6, show.weights = TRUE, file = NULL, 
    ...) 
{ 
    net <- x 
    if (is.null(net$weights)) 
     stop("weights were not calculated") 
    if (!is.null(file) && !is.character(file)) 
     stop("'file' must be a string") 
    if (is.null(rep)) { 
     for (i in 1:length(net$weights)) { 
      if (!is.null(file)) 
       file.rep <- paste(file, ".", i, sep = "") 
      else file.rep <- NULL 
      #dev.new() 
      plot.nn(net, rep = i, x.entry, x.out, radius, arrow.length, 
       intercept, intercept.factor, information, information.pos, 
       col.entry.synapse, col.entry, col.hidden, col.hidden.synapse, 
       col.out, col.out.synapse, col.intercept, fontsize, 
       dimension, show.weights, file.rep, ...) 
     } 
    } 
    else { 
     if (is.character(file) && file.exists(file)) 
      stop(sprintf("%s already exists", sQuote(file))) 
     result.matrix <- t(net$result.matrix) 
     if (rep == "best") 
      rep <- as.integer(which.min(result.matrix[, "error"])) 
     if (rep > length(net$weights)) 
      stop("'rep' does not exist") 
     weights <- net$weights[[rep]] 
     if (is.null(x.entry)) 
      x.entry <- 0.5 - (arrow.length/2) * length(weights) 
     if (is.null(x.out)) 
      x.out <- 0.5 + (arrow.length/2) * length(weights) 
     width <- max(x.out - x.entry + 0.2, 0.8) * 8 
     radius <- radius/dimension 
     entry.label <- net$model.list$variables 
     out.label <- net$model.list$response 
     neuron.count <- array(0, length(weights) + 1) 
     neuron.count[1] <- nrow(weights[[1]]) - 1 
     neuron.count[2] <- ncol(weights[[1]]) 
     x.position <- array(0, length(weights) + 1) 
     x.position[1] <- x.entry 
     x.position[length(weights) + 1] <- x.out 
     if (length(weights) > 1) 
      for (i in 2:length(weights)) { 
       neuron.count[i + 1] <- ncol(weights[[i]]) 
       x.position[i] <- x.entry + (i - 1) * (x.out - 
        x.entry)/length(weights) 
      } 
     y.step <- 1/(neuron.count + 1) 
     y.position <- array(0, length(weights) + 1) 
     y.intercept <- 1 - 2 * radius 
     information.pos <- min(min(y.step) - 0.1, 0.2) 
     if (length(entry.label) != neuron.count[1]) { 
      if (length(entry.label) < neuron.count[1]) { 
       tmp <- NULL 
       for (i in 1:(neuron.count[1] - length(entry.label))) { 
        tmp <- c(tmp, "no name") 
       } 
       entry.label <- c(entry.label, tmp) 
      } 
     } 
     if (length(out.label) != neuron.count[length(neuron.count)]) { 
      if (length(out.label) < neuron.count[length(neuron.count)]) { 
       tmp <- NULL 
       for (i in 1:(neuron.count[length(neuron.count)] - 
        length(out.label))) { 
        tmp <- c(tmp, "no name") 
       } 
       out.label <- c(out.label, tmp) 
      } 
     } 
     grid.newpage() 
     pushViewport(viewport(name = "plot.area", width = unit(dimension, 
      "inches"), height = unit(dimension, "inches"))) 
     for (k in 1:length(weights)) { 
      for (i in 1:neuron.count[k]) { 
       y.position[k] <- y.position[k] + y.step[k] 
       y.tmp <- 0 
       for (j in 1:neuron.count[k + 1]) { 
        y.tmp <- y.tmp + y.step[k + 1] 
        result <- calculate.delta(c(x.position[k], 
        x.position[k + 1]), c(y.position[k], y.tmp), 
        radius) 
        x <- c(x.position[k], x.position[k + 1] - result[1]) 
        y <- c(y.position[k], y.tmp + result[2]) 
        grid.lines(x = x, y = y, arrow = arrow(length = unit(0.15, 
        "cm"), type = "closed"), gp = gpar(fill = col.hidden.synapse, 
        col = col.hidden.synapse, ...)) 
        if (show.weights) 
        draw.text(label = weights[[k]][neuron.count[k] - 
         i + 2, neuron.count[k + 1] - j + 1], x = c(x.position[k], 
         x.position[k + 1]), y = c(y.position[k], 
         y.tmp), xy.null = 1.25 * result, color = col.hidden.synapse, 
         fontsize = fontsize - 2, ...) 
       } 
       if (k == 1) { 
        grid.lines(x = c((x.position[1] - arrow.length), 
        x.position[1] - radius), y = y.position[k], 
        arrow = arrow(length = unit(0.15, "cm"), 
         type = "closed"), gp = gpar(fill = col.entry.synapse, 
         col = col.entry.synapse, ...)) 
        draw.text(label = entry.label[(neuron.count[1] + 
        1) - i], x = c((x.position - arrow.length), 
        x.position[1] - radius), y = c(y.position[k], 
        y.position[k]), xy.null = c(0, 0), color = col.entry.synapse, 
        fontsize = fontsize, ...) 
        grid.circle(x = x.position[k], y = y.position[k], 
        r = radius, gp = gpar(fill = "white", col = col.entry, 
         ...)) 
       } 
       else { 
        grid.circle(x = x.position[k], y = y.position[k], 
        r = radius, gp = gpar(fill = "white", col = col.hidden, 
         ...)) 
       } 
      } 
     } 
     out <- length(neuron.count) 
     for (i in 1:neuron.count[out]) { 
      y.position[out] <- y.position[out] + y.step[out] 
      grid.lines(x = c(x.position[out] + radius, x.position[out] + 
       arrow.length), y = y.position[out], arrow = arrow(length = unit(0.15, 
       "cm"), type = "closed"), gp = gpar(fill = col.out.synapse, 
       col = col.out.synapse, ...)) 
      draw.text(label = out.label[(neuron.count[out] + 
       1) - i], x = c((x.position[out] + radius), x.position[out] + 
       arrow.length), y = c(y.position[out], y.position[out]), 
       xy.null = c(0, 0), color = col.out.synapse, fontsize = fontsize, 
       ...) 
      grid.circle(x = x.position[out], y = y.position[out], 
       r = radius, gp = gpar(fill = "white", col = col.out, 
        ...)) 
     } 
     if (intercept) { 
      for (k in 1:length(weights)) { 
       y.tmp <- 0 
       x.intercept <- (x.position[k + 1] - x.position[k]) * 
        intercept.factor + x.position[k] 
       for (i in 1:neuron.count[k + 1]) { 
        y.tmp <- y.tmp + y.step[k + 1] 
        result <- calculate.delta(c(x.intercept, x.position[k + 
        1]), c(y.intercept, y.tmp), radius) 
        x <- c(x.intercept, x.position[k + 1] - result[1]) 
        y <- c(y.intercept, y.tmp + result[2]) 
        grid.lines(x = x, y = y, arrow = arrow(length = unit(0.15, 
        "cm"), type = "closed"), gp = gpar(fill = col.intercept, 
        col = col.intercept, ...)) 
        xy.null <- cbind(x.position[k + 1] - x.intercept - 
        2 * result[1], -(y.tmp - y.intercept + 2 * 
        result[2])) 
        if (show.weights) 
        draw.text(label = weights[[k]][1, neuron.count[k + 
         1] - i + 1], x = c(x.intercept, x.position[k + 
         1]), y = c(y.intercept, y.tmp), xy.null = xy.null, 
         color = col.intercept, alignment = c("right", 
         "bottom"), fontsize = fontsize - 2, ...) 
       } 
       grid.circle(x = x.intercept, y = y.intercept, 
        r = radius, gp = gpar(fill = "white", col = col.intercept, 
        ...)) 
       grid.text(1, x = x.intercept, y = y.intercept, 
        gp = gpar(col = col.intercept, ...)) 
      } 
     } 
     if (information) 
      grid.text(paste("Error: ", round(result.matrix[rep, 
       "error"], 6), " Steps: ", result.matrix[rep, 
       "steps"], sep = ""), x = 0.5, y = information.pos, 
       just = "bottom", gp = gpar(fontsize = fontsize + 
        2, ...)) 
     popViewport() 
     if (!is.null(file)) { 
      weight.plot <- recordPlot() 
      save(weight.plot, file = file) 
     } 
    } 
} 
calculate.delta <- 
function (x, y, r) 
{ 
    delta.x <- x[2] - x[1] 
    delta.y <- y[2] - y[1] 
    x.null <- r/sqrt(delta.x^2 + delta.y^2) * delta.x 
    if (y[1] < y[2]) 
     y.null <- -sqrt(r^2 - x.null^2) 
    else if (y[1] > y[2]) 
     y.null <- sqrt(r^2 - x.null^2) 
    else y.null <- 0 
    c(x.null, y.null) 
} 
draw.text <- 
function (label, x, y, xy.null = c(0, 0), color, alignment = c("left", 
    "bottom"), ...) 
{ 
    x.label <- x[1] + xy.null[1] 
    y.label <- y[1] - xy.null[2] 
    x.delta <- x[2] - x[1] 
    y.delta <- y[2] - y[1] 
    angle = atan(y.delta/x.delta) * (180/pi) 
    if (angle < 0) 
     angle <- angle + 0 
    else if (angle > 0) 
     angle <- angle - 0 
    if (is.numeric(label)) 
     label <- round(label, 5) 
    pushViewport(viewport(x = x.label, y = y.label, width = 0, 
     height = , angle = angle, name = "vp1", just = alignment)) 
    grid.text(label, x = 0, y = unit(0.75, "mm"), just = alignment, 
     gp = gpar(col = color, ...)) 
    popViewport() 
} 

wklej powyższy kod na swojej R interaktywny szybkiego i kiedy chcesz zapisać wykres wykonaj następujące czynności:

png("test.png") 
plot(nn) 
dev.off() 

Answer 2

pakietu neuralnet używa grafiki siatki. Oznacza to, że musisz print swoich działek w trybie nieinteraktywnym.

Spróbuj tego:

png("iris.png") 
print(plot(nn)) 
dev.off()