資料等::ランダムドットステレオグラム画像を作るRスクリプト

ランダムドットステレオグラム (random dot stereogram; RDS) のための画像を作るRスクリプトです。白黒のパターンの画像を用意してRコードを実行すると，黒い部分が浮き出て見えるランダムドットステレオグラム画像を生成できます。元画像を変えることで任意のRDS画像を作成できます。実行にはimagerパッケージが必要です。解説は時間があるときに加筆するかも。

↑左から順に，元画像・左目用画像・右目用画像。以下のコードを試す際は，一番左の画像を「circle.png」という名前で保存して同ディレクトリに入れておけばOK。

					library(imager)

# 設定 ----------------------------------------------------------------

dodge <- 10 # 両眼像差 (px)
imagefile <- "circle.png" # 元画像のパス

# 出力 --------------------------------------------------------------

set.seed(610)

# 元画像の読み込み
pattern <- load.image(imagefile) |> rm.alpha() |> grayscale()

# 画像のサイズを取得
w <- width(pattern)
h <- height(pattern)

# 後の処理のために背景を灰色に変える
pattern[pattern > 0.5] <- 0.75

# 図をランダムドットに変える
pattern[pattern <= 0.5] <- sample(c(0,1), length(pattern[pattern <= 0.5] ), TRUE)

# 図を左右にずらす
bg <- matrix(0.75, ncol = h, nrow = w) |> as.cimg()

pattern_r <- pattern |> 
  imsub(x > round(dodge)) |> 
  imdraw(im = bg, sprite = _, x = 0) # 右目用のパターン

pattern_l <- pattern |> 
  imsub(x < w - round(dodge)) |> 
  imdraw(im = bg, sprite = _, x = round(dodge)) # 左目用のパターン

#plot(pattern_l) # 確認用
#plot(pattern_r) # 確認用

# ランダムドットの背景に図を重ねる

image0 <- matrix(sample(c(0,1), w*h, TRUE), ncol = h, nrow = w) |> 
  as.cimg() # random dots

image_l <- image0
image_l[pattern_l != 0.75] <- pattern_l[pattern_l != 0.75]

image_r <- image0
image_r[pattern_r != 0.75] <- pattern_r[pattern_r != 0.75]

# 保存

imager::save.image(image_l,"image_l.png") # 左目用の画像
imager::save.image(image_r,"image_r.png") # 右目用の画像