読者です 読者をやめる 読者になる 読者になる

Mukku John Blog

取り組んでいること を つらつら と

Rプログラミング入門 15回目

Rプログラミング入門

この記事の続き。
mukkujohn.hatenablog.com

if~elseを利用して、score関数を作る。

おさらい

関数を作る際に、???にならないために。

  1. 複雑な問題を単純な問題に分割する
  2. 具体例を使う
  3. 文章で書いてから、Rに変換する

(プログラム書き初めはこうだったかなぁ。もう10年以上前だ。しかもC。*1


というわけで、
シンボルから賞金を算出するscore関数について考えます。

複雑な問題は、賞金を算出する過程ですかね。

それを、単純な問題に分割し、具体例にすると。

  1. 3つのシンボルがすべて同じかどうか
  2. シンボルに対応する賞金をルックアップする
  3. シンボルがすべてバーかどうか
  4. 賞金に5ドルを割り当てる
  5. チェリーの数を数える
  6. チェリーの数から賞金を計算する
  7. ダイヤの数を数える
  8. ダイヤの数に合わせて賞金を調整する

そして、順次的なステップ並列するケースを意識して。

1 -> true -> 7 -> 8
1 -> false -> 3 -> true -> 4 -> 7 -> 8
1 -> false -> 3 -> false -> 5 -> 6 -> 7 -> 8

上記の日本語を、下記に、R語に変換しながら埋めます。

score <- function(symbols) {

    # 賞金計算

    prize
}

埋めた結果がこちら。

score <- function(symbols){
  # 1 の条件で使う 
  same <- length(unique(symbols)) == 1
  # 3 の条件で使う
  bars <- symbols %in% c("B","BB","BBB")
 
  # 1.3つのシンボルがすべて同じかどうか
  if(same){
    payouts <- c("DD" = 100, "7" = 80, "BBB" = 40, "BB" = 25, "B" = 10,"C" = 10, "0" = 0)
    # 2.シンボルに対応する賞金をルックアップする
    prize <- unname(payouts[symbols[1]])
  # 3.シンボルがすべてバーかどうか
  }else if(all(bars)){
    # 4.賞金に5ドルを割り当てる
    prize <- 5
  # 上記以外
  }else{
    # 5.チェリーの数を数える
    cherries <- sum(symbols == "C")
    # 6.チェリーの数から賞金を計算する
    prize <- c(0, 2, 5)[cherries + 1]
  }

  # 7.ダイヤの数を数える
  diamonds <- sum(symbols == "DD")
  # 8.ダイヤの数に合わせて賞金を調整する
  prize * 2 ^ diamonds
}

上記で利用していて、今まで触れてこなかった関数の説明を。
まずは、この部分。

# 1 の条件で使う 
  same <- length(unique(symbols)) == 1
  • unique関数

引数に指定したアトミックベクトルに含まれている要素を集約してくれます。

  • length関数

引数に指定したアトミックベクトルの要素数を返してくれます。

それぞれの関数の動作はこちら。

> symbols <- c("B","C","D")
> unique(symbols)
[1] "B" "C" "D"
> length(symbols)
[1] 3
> symbols <- c("B","B","D")
> unique(symbols)
[1] "B" "D"
> length(symbols)
[1] 3
> symbols <- c("B","B","B")
> unique(symbols)
[1] "B"
> length(symbols)
[1] 3

なので、上記の2関数をまとめて利用すると、
アトミックベクトル内の同じ要素の個数が取得できます。

> symbols <- c("B","C","D")
> length(unique(symbols))
[1] 3
> symbols <- c("B","B","D")
> length(unique(symbols))
[1] 2
> symbols <- c("B","B","B")
> length(unique(symbols))
[1] 1

つまり、集約したアトミックベクトルの要素数が1つなら全部同じシンボルです。

次に、ここ。

    payouts <- c("DD" = 100, "7" = 80, "BBB" = 40, "BB" = 25, "B" = 10,"C" = 10, "0" = 0)
    # 2.シンボルに対応する賞金をルックアップする
    prize <- unname(payouts[symbols[1]])

payoutsオブジェクトは、名前属性がついたdouble型のベクトルです。

> typeof(payouts)
[1] "double"
> names(payouts)
[1] "DD"  "7"   "BBB" "BB"  "B"   "C"   "0" 

この名前属性つきのベクトルは、添え字に名前が利用できます。
こんな感じですね。

> payouts["DD"]
 DD 
100 
> payouts["7"]
 7 
80 
> payouts["BBB"]
BBB 
 40

返されたオブジェクトには、名前がついてきてしまい賞金計算には邪魔ですので、
unname関数で値だけにします。

> unname(payouts["DD"])
[1] 100
> unname(payouts["7"])
[1] 80
> unname(payouts["BBB"])
[1] 40

上記を利用して、
全て同じ要素のsymbolsオブジェクトの1番目の要素の値を利用して、
payoutsオブジェクトから、該当する賞金を取得しています。

    # 2.シンボルに対応する賞金をルックアップする
    prize <- unname(payouts[symbols[1]])

他は、今まで触れてきた内容ですね。

関数を作ったので、テストをします。

> symbols <- c("0","0","0")
> score(symbols)
[1] 0
> symbols <- c("7","7","7")
> score(symbols)
[1] 80
> symbols <- c("B","BB","BBB")
> score(symbols)
[1] 5
> symbols <- c("C","0","0")
> score(symbols)
[1] 2
> symbols <- c("C","C","0")
> score(symbols)
[1] 5

次にダイヤを含む場合。

> symbols <- c("C","DD","0")
> score(symbols)
[1] 4
> symbols <- c("C","DD","DD")
> score(symbols)
[1] 8
> symbols <- c("DD","DD","DD")
> score(symbols)
[1] 800

まぁよさそうです。

最後に、部分部分で作成した、get_symbols関数とscore関数をまとめます。

play <- function(){
  #1.シンボルを取得する
  symbols <- get_symbols()
  #2.シンボルを表示する
  print(symbols)
  #3.賞金を計算する
  score(symbols)
}

なかなか、賞金は手に入らないです。

> play()
[1] "BBB" "7"   "0"  
[1] 0
> play()
[1] "B"   "BBB" "0"  
[1] 0
> play()
[1] "B" "0" "0"
[1] 0
> play()
[1] "BBB" "B"   "0"  
[1] 0
> play()
[1] "BB" "BB" "B" 
[1] 5
> play()
[1] "BB" "0"  "0" 
[1] 0

*1:C → JAVAVB.NET → その他いろいろ