『スパース推定100問 with R』 問題コード

第6章　行列分解

80

svd.r <- function(z, r) {
  n <- min(nrow(z), ncol(z))
  ss <- svd(z) 
  return(ss$u %*% diag(c(ss$d[1:r], rep(0, n - r))) %*% ## 空欄(1) ##)
}

## r を 2 以上に限定するなら以下でもよい。R言語の仕様で，行列とベクトルは違う扱いになる。
svd.r <- function(z, r) {
  ss <- svd(z)
  return(ss$u[, 1:r] %*% diag(ss$d[1:r]) %*% ## 空欄(2) ##)
}

m <- 100
n <- 80
z <- matrix(rnorm(m * n), nrow = m) 
F.norm <- NULL
for (r in 1:n) {
  m <- svd.r(z, r)
  F.norm <- c(F.norm, norm(z - m, "F"))
}
plot(1:n, F.norm, type = "l", xlab = "階数", ylab = "Frobenius ノルム")

81

library(jpeg)

image <- readJPEG('lion.jpg')
rank.seq <- c(2, 5, 10, 20, 50, 100)
mat <- array(0, dim = c(nrow(image), ncol(image), 3))
for (j in rank.seq) {
  for (i in 1:3)
    mat[, , i] <- svd.r(image[, , i], j)
  writeJPEG(mat, paste("compressed/lion_compressed", "_svd_rank_", j, ".jpg', sep="))
}

82

library(jpeg)

mat.r <- function(z, mask, r) {
  z <- as.matrix(z)
  min <- Inf
  m <- nrow(z)
  n <- ncol(z)
  for (j in 1:5) {
    guess <- matrix(rnorm(m * n), nrow = m)
    for (i in 1:10)
      guess <- svd.r(mask * z + (1 - mask) * guess, r)
    value <- norm(mask * (z - guess), "F")
    if (value < min) {
      min.mat <- ## 空欄(1) ##
      min <- ## 空欄(2) ##
    }
  }
  return(min.mat)
}

image <- readJPEG('lion.jpg')
m <- nrow(image)
n <- ncol(image)
mask <- matrix(rbinom(m * n, 1, 0.5), nrow = m)
rank.seq <- c(2, 5, 10, 20, 50, 100)
mat <- array(0, dim = c(nrow(image), ncol(image), 3))
for (j in rank.seq) {
  for (i in 1:3)
    mat[, , i] <- mat.r(image[, , i], mask, j)
  writeJPEG(mat, paste("compressed/lion_compressed", "_mat_rank_", j, ".jpg', sep="))
}

87

soft.svd <- function(lambda, z) {
  n <- ncol(z)
  ss <- svd(z)
  dd <- pmax(ss$d - lambda, 0)
  return(## 空欄 ##)
}

library(jpeg)

mat.lasso <- function(lambda, z, mask) {
  z <- as.matrix(z)
  m <- nrow(z)
  n <- ncol(z)
  guess <- matrix(rnorm(m * n), nrow = m)
  for (i in 1:20)
    guess <- soft.svd(lambda, mask * z + (1 - mask) * guess)
  return(guess)
}

image <- readJPEG('lion.jpg')
m <- nrow(image[, , 1])
n <- ncol(image[, , 1])
p <- 0.5
lambda <- 0.5
mat <- array(0, dim = c(m, n, 3))
mask <- matrix(rbinom(m * n, 1, p), ncol = n)
for (i in 1:3)
  mat[, , i] <- mat.lasso(lambda, image[, , i], mask)
writeJPEG(mat, paste("compressed/lion_compressed", "_mat_soft.jpg', sep="))