反応性のある光沢のあるプロットの出力がありません

Question

ユーザーがアップロードした画像を取り込み、ユーザーが指定した数の主成分で圧縮された画像のプロットを返すShinyアプリケーションの初期の罠です。コードリサイクルhttps://ryancquan.com/blog/2014/10/07/image-compression-pca/

エラーは表示されませんが、プロットはmainPanelに表示されません。

ui.R

library(shiny) 

shinyUI(pageWithSidebar(
    headerPanel("PCA compression"), 
    sidebarPanel(
    fileInput('selfie', "SELECT PNG", accept=c('image/png')), 
    sliderInput("PCAdim", "Number of dimensions to be reduced to:", min=3, max=5, value = 4), 
    actionButton("exec", "EXECUTE") 
), 
    mainPanel(
    imageOutput('Image') 
) 
)) 

server.R

library(shiny) 

shinyServer(function(input, output, session) { 
    inFile <- reactive({ 
    inFile <- input$selfie 
    }) 
    PCAdim <- reactive({ 
    PCAdim <- input$PCAdim 
    }) 
    ProjectImage <- function(prcomp.obj, pc.num) { 
    # project image onto n principal components 
    scores <- prcomp.obj$x 
    loadings <- prcomp.obj$rotation 
    img.proj <- scores[, c(1:pc.num)] %*% t(loadings[, c(1:pc.num)]) 
    return(img.proj) 
    } 
    SplitImage <- function(rgb.array) { 
    # decompose image into RGB elements 
    rgb.list <- list() 
    for (i in 1:dim(rgb.array)[3]) { 
     rgb.list[[i]] <- rgb.array[, , i] 
    } 
    return(rgb.list) 
    } 
    ReduceDimsPNG <- function(png.file, pc.num, display.only=TRUE) { 
    # reduce dimensions of PNG image 
    rgb.array <- readPNG(png.file) 
    rgb.list <- SplitImage(rgb.array) 
    # apply pca and reproject onto new principal components 
    rgb.list <- lapply(rgb.list, prcomp, center=FALSE) 
    rgb.proj <- lapply(rgb.list, ProjectImage, pc.num=pc.num) 
    # restore original dimensions 
    restored.img <- abind(rgb.proj, along=3) 
    } 

    eventReactive(input$exec, { 
     output$Image <- renderImage({ 
     outfile <- tempfile(fileext='.png') 
     writePNG(ReduceDimsPNG(inFile(), PCAdim(), target = outfile)) 
     renderPlot(png(outfile)) 
     dev.off() 
     }) 
    }) 
}) 

Answer 1

問題に加えて@Jotaによって指摘、他の問題のカップルがあります：

• fileInputファイル名ではなくデータフレームを返します。したがって、ReduceDimsPNG(png.file = inFile(), ...)はエラーを生成します。
• かっこが間違って配置されています。ReduceDimsPNG(inFile(), PCAdim(), target = outfile))
• renderImageには、ファイル名を含むリストが返されます。 list(src = outfile, contentType = 'image/png', ...)

上記の問題を修正し、次の単一ファイルシャイニーアプリは、私のマシン上で動作します：

ui <- pageWithSidebar(
    headerPanel("PCA compression"), 
    sidebarPanel(
    fileInput('selfie', "SELECT PNG", accept=c('image/png')), 
    sliderInput("PCAdim", "Number of dimensions to be reduced to:", min=3, max=5, value = 4), 
    actionButton("exec", "EXECUTE") 
), 
    mainPanel(
    imageOutput('Image') 
) 
) 

server <- function(input, output, session) { 
    inFile <- reactive({ 
    inFile <- input$selfie 
    }) 
    PCAdim <- reactive({ 
    PCAdim <- input$PCAdim 
    }) 
    ProjectImage <- function(prcomp.obj, pc.num) { 
    # project image onto n principal components 
    scores <- prcomp.obj$x 
    loadings <- prcomp.obj$rotation 
    img.proj <- scores[, c(1:pc.num)] %*% t(loadings[, c(1:pc.num)]) 
    return(img.proj) 
    } 
    SplitImage <- function(rgb.array) { 
    # decompose image into RGB elements 
    rgb.list <- list() 
    for (i in 1:dim(rgb.array)[3]) { 
     rgb.list[[i]] <- rgb.array[, , i] 
    } 
    return(rgb.list) 
    } 
    ReduceDimsPNG <- function(png.file, pc.num, display.only=TRUE) { 
    # reduce dimensions of PNG image 
    rgb.array <- png::readPNG(png.file) 
    rgb.list <- SplitImage(rgb.array) 
    # apply pca and reproject onto new principal components 
    rgb.list <- lapply(rgb.list, prcomp, center=FALSE) 
    rgb.proj <- lapply(rgb.list, ProjectImage, pc.num=pc.num) 
    # restore original dimensions 
    restored.img <- abind::abind(rgb.proj, along=3) 
    } 

    img.array <- eventReactive(input$exec, { 
    ReduceDimsPNG(inFile()$datapath[1], PCAdim()) 
    }) 

    output$Image <- renderImage({ 
    outfile <- tempfile(fileext='.png') 
    png::writePNG(img.array(), target = outfile) 
    list(src = outfile, contentType = 'image/png')}, deleteFile = TRUE 
) 
} 

shinyApp(ui = ui, server = server)