if (!require(keras3))
{
install.packages("keras3")
library(keras3)
install_keras()
}
## 要求されたパッケージ keras3 をロード中です
if (!require(plotly)) install.packages("plotly")
## 要求されたパッケージ plotly をロード中です
## 要求されたパッケージ ggplot2 をロード中です
##
## 次のパッケージを付け加えます: 'plotly'
## 以下のオブジェクトは 'package:ggplot2' からマスクされています:
##
## last_plot
## 以下のオブジェクトは 'package:stats' からマスクされています:
##
## filter
## 以下のオブジェクトは 'package:graphics' からマスクされています:
##
## layout
set.seed(5)
n <- 24*7*2
x <- 1:n
x2 <- x^2
x3 <- 100*sin(2*pi*x/24)
f <- function(x) 100 + 0.1*x + 0.02*x2 + x3
y <- f(x) + rnorm(n, sd = 5)
d <- data.frame(y, x, x2, x3)
d
ii <- 1:(24*11)
d.tr <- d[ ii, ]
d.te <- d[-ii, ]
vline <- list(type = "line",
line = list(color = "blue", dash = "dash"),
x0 = ii[length(ii)], x1 = ii[length(ii)],
y0 = 0, y1 = max(d$y))
plot_ly(type = "scatter", mode = "markers") |>
add_trace(x = d$x, y = d$y, mode = 'markers', name = "観測値") |>
add_trace(x = x, y = f(x), mode = 'lines', name = "真値") |>
layout(title = "青破線の左側：訓練領域，右側：予測領域", shapes = list(vline))
FML <- vector("list", 4)
FML[[1]] <- formula("y ~ x")
FML[[2]] <- formula("y ~ x + x2")
FML[[3]] <- formula("y ~ x + x2 + x3")
FML[[4]] <- formula("y ~ poly(x, 4)")
ID.MODEL <- 3
x.tr <- model.matrix(FML[[ID.MODEL]], d.tr)
x.te <- model.matrix(FML[[ID.MODEL]], d.te)
nc <- ncol(x.tr)
me.tr <- apply(x.tr, 2, mean)
sd.tr <- apply(x.tr, 2, sd)
x.tr <- scale(x.tr, center = me.tr, scale = sd.tr)
x.te <- scale(x.te, center = me.tr, scale = sd.tr)
x.tr[, 1] <- 1
x.te[, 1] <- 1
model <-
keras_model_sequential(input_shape = c(nc)) |>
layer_dense(units = nc*2, activation = "relu") |>
layer_dense(units = nc*4, activation = "relu") |>
layer_dense(units = nc*2, activation = "relu") |>
layer_dense(units = 1, activation = "linear")
summary(model)
## Model: "sequential"
## ┌───────────────────────────────────┬──────────────────────────┬───────────────
## │ Layer (type) │ Output Shape │ Param #
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ dense (Dense) │ (None, 8) │ 40
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ dense_1 (Dense) │ (None, 16) │ 144
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ dense_2 (Dense) │ (None, 8) │ 136
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ dense_3 (Dense) │ (None, 1) │ 9
## └───────────────────────────────────┴──────────────────────────┴───────────────
## Total params: 329 (1.29 KB)
## Trainable params: 329 (1.29 KB)
## Non-trainable params: 0 (0.00 B)
compile(model,
loss = "mse",
optimizer = optimizer_adam(learning_rate = 0.1),
metrics = c("mean_absolute_error"))
callbacks <- list(
callback_early_stopping(patience = 20, monitor = "val_loss"),
callback_model_checkpoint(filepath = "bestmodel.keras",
monitor = "val_loss", save_best_only = T),
callback_reduce_lr_on_plateau(monitor = "val_loss",
factor = 0.1, patience = 5)
)
fit.dp <- fit(model,
x.tr,
d.tr$y,
verbose = 0,
batch_size = 2^6,
epochs = 100,
validation_split = 0.2,
callbacks = callbacks)
plot(fit.dp)
yhat <- predict(model, x.te)
## 3/3 - 0s - 48ms/step
fit <- lm(FML[[ID.MODEL]], data = d.tr)
yhat.lm <- predict(fit, newdata = d.te)
plot_ly(type = "scatter", mode = "markers") |>
add_trace(x = d$x, y = d$y, mode = "markers", name = "観測値") |>
add_trace(x = d.te$x, y = yhat, mode = "markers", name = "予測値（DNN）") |>
add_trace(x = d.te$x, y = yhat.lm, mode = "lines", name = "予測値（重回帰）") |>
layout(shapes = list(vline))
get.accuracy <- function(yhat, y)
{
data.frame(MBE = mean(yhat - y),
MAE = mean(abs(yhat - y)),
MAPE = mean(abs((yhat - y) / y)) * 100,
RMSE = sqrt(mean((yhat - y)^2))
)
}
get.accuracy(yhat = yhat, y = d.te$y)
evaluate(model, x.te, d.te$y)
## 3/3 - 0s - 17ms/step - loss: 53072.0352 - mean_absolute_error: 221.5419
## $loss
## [1] 53072.04
##
## $mean_absolute_error
## [1] 221.5419
get.accuracy(yhat = yhat.lm, y = d.te$y)
d <- read.csv('https://stats.dip.jp/01_ds/data/real_estate_price.csv')
n <- nrow(d)
summary(d)
## id yr yrs_old m_sta
## Min. : 1.0 Min. :2012 Min. : 0.000 Min. : 23.38
## 1st Qu.:104.2 1st Qu.:2012 1st Qu.: 9.025 1st Qu.: 289.32
## Median :207.5 Median :2013 Median :16.100 Median : 492.23
## Mean :207.5 Mean :2013 Mean :17.713 Mean :1083.89
## 3rd Qu.:310.8 3rd Qu.:2013 3rd Qu.:28.150 3rd Qu.:1454.28
## Max. :414.0 Max. :2013 Max. :43.800 Max. :6488.02
## nstores lat lon price
## Min. : 0.000 Min. :24.93 Min. :121.5 Min. : 7.60
## 1st Qu.: 1.000 1st Qu.:24.96 1st Qu.:121.5 1st Qu.: 27.70
## Median : 4.000 Median :24.97 Median :121.5 Median : 38.45
## Mean : 4.094 Mean :24.97 Mean :121.5 Mean : 37.98
## 3rd Qu.: 6.000 3rd Qu.:24.98 3rd Qu.:121.5 3rd Qu.: 46.60
## Max. :10.000 Max. :25.01 Max. :121.6 Max. :117.50
set.seed(7)
ii <- sample(1:n, size = floor(0.8*n))
d.tr <- d[ ii, -1]
d.te <- d[-ii, -1]
d.tr
vline <- list(type = "line",
line = list(color = "blue", dash = "dash"),
x0 = ii[length(ii)], x1 = ii[length(ii)],
y0 = 0, y1 = max(d$y))
## Warning in max(d$y): max の引数に有限な値がありません: -Inf を返します
plot_ly(type = "scatter", mode = "markers") |>
add_trace(x = d$x, y = d$y, mode = 'markers', name = "観測値") |>
add_trace(x = x, y = f(x), mode = 'lines', name = "真値") |>
layout(title = "青破線の左側：訓練領域，右側：予測領域", shapes = list(vline))
FML <- vector("list", 4)
FML[[1]] <- formula("y ~ x")
FML[[2]] <- formula("y ~ x + x2")
FML[[3]] <- formula("y ~ x + x2 + x3")
FML[[4]] <- formula("y ~ poly(x, 4)")
ID.MODEL <- 3
x.tr <- model.matrix(FML[[ID.MODEL]], d.tr)
x.te <- model.matrix(FML[[ID.MODEL]], d.te)
nc <- ncol(x.tr)
me.tr <- apply(x.tr, 2, mean)
sd.tr <- apply(x.tr, 2, sd)
x.tr <- scale(x.tr, center = me.tr, scale = sd.tr)
x.te <- scale(x.te, center = me.tr, scale = sd.tr)
x.tr[, 1] <- 1
x.te[, 1] <- 1
model <-
keras_model_sequential(input_shape = c(nc)) |>
layer_dense(units = nc*2, activation = "relu") |>
layer_dense(units = nc*4, activation = "relu") |>
layer_dense(units = nc*2, activation = "relu") |>
layer_dense(units = 1, activation = "linear")
summary(model)
## Model: "sequential_1"
## ┌───────────────────────────────────┬──────────────────────────┬───────────────
## │ Layer (type) │ Output Shape │ Param #
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ dense_4 (Dense) │ (None, 8) │ 40
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ dense_5 (Dense) │ (None, 16) │ 144
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ dense_6 (Dense) │ (None, 8) │ 136
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ dense_7 (Dense) │ (None, 1) │ 9
## └───────────────────────────────────┴──────────────────────────┴───────────────
## Total params: 329 (1.29 KB)
## Trainable params: 329 (1.29 KB)
## Non-trainable params: 0 (0.00 B)
compile(model,
loss = "mse",
optimizer = optimizer_adam(learning_rate = 0.1),
metrics = c("mean_absolute_error"))
d <- dataset_fashion_mnist()
str(d)
## List of 2
## $ train:List of 2
## ..$ x: int [1:60000, 1:28, 1:28] 0 0 0 0 0 0 0 0 0 0 ...
## ..$ y: int [1:60000(1d)] 9 0 0 3 0 2 7 2 5 5 ...
## $ test :List of 2
## ..$ x: int [1:10000, 1:28, 1:28] 0 0 0 0 0 0 0 0 0 0 ...
## ..$ y: int [1:10000(1d)] 9 2 1 1 6 1 4 6 5 7 ...
d <- dataset_fashion_mnist()
str(d)
## List of 2
## $ train:List of 2
## ..$ x: int [1:60000, 1:28, 1:28] 0 0 0 0 0 0 0 0 0 0 ...
## ..$ y: int [1:60000(1d)] 9 0 0 3 0 2 7 2 5 5 ...
## $ test :List of 2
## ..$ x: int [1:10000, 1:28, 1:28] 0 0 0 0 0 0 0 0 0 0 ...
## ..$ y: int [1:10000(1d)] 9 2 1 1 6 1 4 6 5 7 ...
LAB.CLASS <- c('Tシャツ', 'ズボン', 'プルオーバ',
'ドレス', 'コート', 'サンダル',
'シャツ', 'スニーカー', '鞄', 'ブーツ')
(nclass <- length(LAB.CLASS))
## [1] 10
d.tr <- d$train
d.tr$fig <- d.tr$x / 255
d.tr$lab <- LAB.CLASS[d.tr$y + 1]
n.tr <- length(d.tr$lab)
d.te <- d$test
d.te$fig <- d.te$x / 255
d.te$lab <- LAB.CLASS[d.te$y + 1]
n.te <- length(d.te$lab)
(dx <- dim(d.tr$x)[2])
## [1] 28
(dy <- dim(d.tr$x)[3])
## [1] 28
draw.images <- function(d, i.fr, i.to,
labhat = NA, p = NA, is.pred = F)
{
par(mfrow = c(3, 6),
mar = c(4.5, 0, 1, 0) + 0.1,
cex.main = 0.9)
for (i in i.fr:i.to)
{
plot(NA, xlim = c(0, dx), ylim = c(0, dy), axes = F,
type = 'n', xlab = '', ylab = '',
main = paste('Fig.', i))
rasterImage(d$fig[i, , ], 0, 0, dx, dy)
mtext(d$lab[i], side = 1, line = 0.2, adj = 0.5)
if (is.pred)
{
mtext(labhat[i], side = 1, line = 1.4, adj = 0.5, col = 4)
mtext(sprintf('%3d%%', as.integer(p[i])),
col = 4, side = 1, line = 2.8, adj = 0.5)
}
}
}
draw.images(d.tr, i.fr = 1, i.to = 18)
clear_session()
model <- keras_model_sequential(input_shape = c(dx, dy)) |>
layer_flatten() |>
layer_dense(units = 128, activation = 'relu') |>
layer_dense(units = 64, activation = 'relu') |>
layer_dense(units = nclass, activation = 'softmax')
summary(model)
## Model: "sequential"
## ┌───────────────────────────────────┬──────────────────────────┬───────────────
## │ Layer (type) │ Output Shape │ Param #
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ flatten (Flatten) │ (None, 784) │ 0
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ dense (Dense) │ (None, 128) │ 100,480
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ dense_1 (Dense) │ (None, 64) │ 8,256
## ├───────────────────────────────────┼──────────────────────────┼───────────────
## │ dense_2 (Dense) │ (None, 10) │ 650
## └───────────────────────────────────┴──────────────────────────┴───────────────
## Total params: 109,386 (427.29 KB)
## Trainable params: 109,386 (427.29 KB)
## Non-trainable params: 0 (0.00 B)
compile(model,
loss = 'sparse_categorical_crossentropy',
optimizer = optimizer_adam(learning_rate = 0.001),
metrics = c('accuracy'))
options(digits = 2)
evaluate(model, d.te$x, d.te$y)
## 313/313 - 1s - 3ms/step - accuracy: 0.0928 - loss: 188.8618
## $accuracy
## [1] 0.093
##
## $loss
## [1] 189