Rainy Day Codings

ウクレレやギターのようなコードを弾く弦楽器では同じコードを弾くのにも何通りもの押さえ方が存在します。

ウクレレで C のコード（C, E, G の3音）を鳴らす場合を例にとりましょう。ウクレレには4本の弦があり、何も押さえない状態では1弦から4弦まで順に A, E, C, G の4つの音を出します。A の音はCコードの構成音ではないので1弦の3フレットを押さえます。これにより1弦から出る音は A から3つ (A->Bb->B->C) シャープした C の音になって C, E, C, G の音が出るわけです。

一方で1弦7フレットを押さえても C のコードと見なせます。A から7つ分シャープすると A->Bb->B->C->C#->D->Eb->E となり、鳴る音は E, E, C, G となります。これも C, E, G で構成されるのでCのコードと言えるのです。

このような何通りもの押さえかたは一番高い音を何にしたいかといった理由などで使い分けますが、市販の教則本等のコード一覧に押さえ方としても載っているのはそのうちの代表的な1つか、コードブック的なもので各々3つくらいです。タブ譜などを見ながら押さえ方の難しいコードが出てきて「もうちょっと楽な押さえ方はないのか？」というときに自分で編み出すのはなかなか大変ですので自動で計算するプログラムを OCaml で書いてみました。

まずは型定義です。音名をヴァリアント型で定義します。

type tone = C | Db | D | Eb | E | F | Gb | G | Ab | A | Bb | B

これは整数で表現したほうが演算（シャープするとかフラットするとか）ができていいという考え方もあるかもしれませんが、今回のプログラムでは特に不要だったのでヴァリアント型にしました。異名同音（C#とDbとか）はすべてフラットのほうの書き方にしていますが、これはヴァリアント型のコンストラクタに記号が使えないためです。

次にいくつかタイプエイリアスを定義します。

type chord = tone list
type position = tone * int
type string_ = position list
type form = position list
type state = form * string_ list

実を言うと実際に後で型注釈とかをして使うわけではないのですが、一応気分の問題で定義しておきました。コード chord は音名を集めたものです。ポジション position は何フレット目を押さえると何の音が出るかを示しています。弦 string_ はポジションを1列に並べたものです。フォーム form は各弦のどのポジションを押さえてコードを鳴らすかを表現します（要素数4つのリストです）。state がよくわからないと思いますが、これは後で説明します。以下、型を説明するときはこれらを使います。

次にウクレレの4つの弦を表現するデータを定義します。

let rec iota m n = if m = n then [n] else m :: iota (m + 1) n
let a_string = List.combine [A; Bb; B; C; Db; D; Eb; E; F; Gb; G; Ab] (iota 0 11)
let e_string = List.combine [E; F; Gb; G; Ab; A; Bb; B; C; Db; D; Eb] (iota 0 11)
let c_string = List.combine [C; Db; D; Eb; E; F; Gb; G; Ab; A; Bb; B] (iota 0 11)
let g_string = List.combine [G; Ab; A; Bb; B; C; Db; D; Eb; E; F; Gb] (iota 0 11)
let strings = [a_string; e_string; c_string; g_string]

これは以下のような構造を作っています。(note * int) list list は気分としては string_ list です。

# strings;;
- : (note * int) list list =
[[(A, 0); (Bb, 1); (B, 2); (C, 3); (Db, 4); (D, 5); (Eb, 6); (E, 7); (F, 8); (Gb, 9); (G, 10); (Ab, 11)];
 [(E, 0); (F, 1); (Gb, 2); (G, 3); (Ab, 4); (A, 5); (Bb, 6); (B, 7); (C, 8); (Db, 9); (D, 10); (Eb, 11)];
 [(C, 0); (Db, 1); (D, 2); (Eb, 3); (E, 4); (F, 5); (Gb, 6); (G, 7); (Ab, 8); (A, 9); (Bb, 10); (B, 11)];
 [(G, 0); (Ab, 1); (A, 2); (Bb, 3); (B, 4); (C, 5); (Db, 6); (D, 7); (Eb, 8); (E, 9); (F, 10); (Gb, 11)]]

ここでは11フレットまでしか用意しませんでしたが、もちろんもっと用意してもかまいません。

ユーティリティ関数として (A, 0) などのポジションと [C; E; G] というコードが与えられたときに A がコード [C; E; G] の構成音かどうかを判定する関数を用意しておきます。position -> chord -> bool です。

let is_chord_tone (tone, _) chord = List.mem tone chord

今回のコード探索プログラムは「クロージャを作成して、そのクロージャを呼び出すたびにコードフォームの候補を次々返してくれる」というものにします。そのクロージャは unit -> form で、呼び出す度に [(G, 0); (C, 0); (E, 0); (C, 3)] とか [(G, 0); (C, 0); (E, 0); (E, 7)] を返してくれるイメージです。

クロージャを作り出すための関数を次のように定義しました。

let create_form_finder strings chord_to_find filters =
  let agenda = Queue.create () in 
  let rec find () =
    let state = Queue.take agenda in
    match state with
    | (form, []) -> if List.for_all (fun p -> p form) filters then form else find ()
    | (form, (position :: string) :: strings) ->
        if (is_chord_tone position chord_to_find) then
          (Queue.push (position :: form, strings) agenda;
           Queue.push (form, string :: strings) agenda;
           find ())
        else
          (Queue.push (form, string :: strings) agenda;
           find ())
    | (_, [] :: _) -> find ()
  in
  Queue.push ([], strings) agenda;
  find

まず引数です。

let create_form_finder strings chord_to_find filters =

strings : string_ list には先ほど定義した strings を与えます。変則チューニングにも対応できるように引数にしました。chord_to_find : chord は見つけたいコードです。filters : (form -> bool) list は検索するコードフォームをフィルタリングする条件を与えます。複数指定できるようにリストにしました。

  let agenda = Queue.create () in

agenda : state Queue.t には探索中の状態が入ります。state は type state = form * string_ list と定義しましたが「これまでに押さえたポジション * まだ押さえていない弦」という意味になります。

  let rec find () =
    let state = Queue.take agenda in
    match state with

コード探索クロージャの中ではまず agenda から状態をひとつとって、その状態の内容で進み方を決めます。

まず「すでに全ての弦を押さえていて、コードフォームになっている」という場合です。

    | (form, []) -> if List.for_all (fun p -> p form) filters then form else find ()

この場合、フィルタリング条件を適用して OK だったらコードフォームを返します。だめだったら探索を続けます。

次のケースはまだ全ての弦を押さえていない途中のケースです。

    | (form, (position :: string) :: strings) ->

このケースは「残りの最初の弦の一番低いポジション」がコードの構成音かどうかで場合分けします。

        if (is_chord_tone position chord_to_find) then
          (Queue.push (position :: form, strings) agenda;
           Queue.push (form, string :: strings) agenda;
           find ())

構成音だった場合「そのポジションを押さえる」か「そのポジションは押さえずにもっと高いポジションを押さえるか」という2通りの行き先があります。これは先の C コードの例で言うと1弦3フレットが構成音だけど3フレットを押さえるか、もっと先（7フレット）を押さえるかというようなことです。1つ目の push は押さえるほうの分岐で、フォームにポジションを追加して残りの弦を減らします。2つ目の push は押さえない判断で、フォームはそのままで弦の最低ポジションを捨てます（次のフレットが次回 agenda から取られるときの最低ポジションになります）。

        else
          (Queue.push (form, string :: strings) agenda;
           find ())

構成音ではなかった場合はフォームはそのままで弦の最低ポジションを捨てます。

    | (_, [] :: _) -> find ()

今回の定義では各弦について11フレット目までしかポジションを定義していないので、最低ポジションを捨て続けて11フレットまでを使い切ったら「詰み」になります。

  in
  Queue.push ([], strings) agenda;
  find

初期状態として「まだどこも押さえていなくて4弦すべて残っている状態」をキューに入れ、クロージャを返しています。

とりあえずこの状態で使ってみましょう。

# let find = create_form_finder strings [C; E; G] [];;
val find : unit -> (note * int) list = <fun>
# find ();;
- : (note * int) list = [(G, 0); (C, 0); (E, 0); (C, 3)]
# find ();;
- : (note * int) list = [(G, 0); (C, 0); (G, 3); (C, 3)]
# find ();;
- : (note * int) list = [(G, 0); (E, 4); (E, 0); (C, 3)]
# find ();;
- : (note * int) list = [(G, 0); (C, 0); (E, 0); (E, 7)]

1弦3フレットを押さえる C や 1弦7フレットを押さえる C を見つけてくれています。一方で2つ目の結果のように C と G だけで E が入っていないフォームも結果に含まれています。「完全なコード」だけを検出するように追加条件を指定したいと思います。

let is_complete_chord chord form = 
  let tone_included tone = List.exists (fun (t, _) -> t = tone) form in
  List.for_all tone_included chord

これを指定すると次のような結果になります。

# let find = create_form_finder strings [C; E; G] [is_complete_chord [C; E; G]];;
val find : unit -> (note * int) list = <fun>
# find ();;
- : (note * int) list = [(G, 0); (C, 0); (E, 0); (C, 3)]
# find ();;
- : (note * int) list = [(G, 0); (E, 4); (E, 0); (C, 3)]
# find ();;
- : (note * int) list = [(G, 0); (C, 0); (E, 0); (E, 7)]

不完全なコードを除外してくれるようになりました。なお「最初から不完全なコードを除外するように create_chord_finder を書けばいいのでは？」と思うかもしれませんが、ウクレレでは不完全なコードを使うことも結構あるため（例えば D7=D+F#+A+C のコードに対して A+F#+C+A で押さえることも多い）、追加条件で指定する仕様にしました。

ところで、コード検出を続行すると次のようなフォームを検出します。

# find ();;
- : (note * int) list = [(G, 0); (G, 7); (E, 0); (C, 3)]
# find ();;
- : (note * int) list = [(G, 0); (E, 4); (G, 3); (C, 3)]
# find ();;
- : (note * int) list = [(G, 0); (C, 0); (G, 3); (E, 7)]
# find ();;
- : (note * int) list = [(G, 0); (C, 0); (E, 0); (G, 10)]
# find ();;
- : (note * int) list = [(C, 5); (G, 7); (E, 0); (C, 3)]
# find ();;
- : (note * int) list = [(E, 9); (C, 0); (G, 3); (C, 3)]

3フレット目と9フレット目を同時に押さえるというのは無理ですね。3と7もすこし遠いかもしれません。押弦している最低フレットと最高フレットの差を3フレットまでに限定してみます。

let is_possible_form form =
  let non_open = List.filter (fun (_, fret) -> fret <> 0) form in
  match non_open with
  | [] -> true
  | _ :: [] -> true
  | (_, fret) :: ps ->
      let (min_, max_) =
        List.fold_left
          (fun (min_, max_) (_, fret) -> (min min_ fret, max max_ fret))
          (fret, fret)
          ps
      in
      (max_ - min_) < 4

この条件を追加すると11フレット目までの全ての C コードは以下のとおりとなります。

# let find = create_form_finder strings [C; E; G] [is_complete_chord [C; E; G]; is_possible_form];;
val find : unit -> (note * int) list = <fun>
# find ();;
- : (note * int) list = [(G, 0); (C, 0); (E, 0); (C, 3)]
# find ();;
- : (note * int) list = [(G, 0); (E, 4); (E, 0); (C, 3)]
# find ();;
- : (note * int) list = [(G, 0); (C, 0); (E, 0); (E, 7)]
# find ();;
- : (note * int) list = [(G, 0); (E, 4); (G, 3); (C, 3)]
# find ();;
- : (note * int) list = [(G, 0); (C, 0); (E, 0); (G, 10)]
# find ();;
- : (note * int) list = [(C, 5); (E, 4); (G, 3); (C, 3)]
# find ();;
- : (note * int) list = [(G, 0); (C, 0); (C, 8); (E, 7)]
# find ();;
- : (note * int) list = [(C, 5); (G, 7); (E, 0); (E, 7)]
# find ();;
- : (note * int) list = [(E, 9); (C, 0); (E, 0); (G, 10)]
# find ();;
- : (note * int) list = [(G, 0); (G, 7); (C, 8); (E, 7)]
# find ();;
- : (note * int) list = [(C, 5); (G, 7); (C, 8); (E, 7)]
# find ();;
- : (note * int) list = [(E, 9); (C, 0); (C, 8); (G, 10)]
# find ();;
- : (note * int) list = [(E, 9); (G, 7); (C, 8); (E, 7)]
# find ();;
- : (note * int) list = [(E, 9); (G, 7); (C, 8); (G, 10)]
# find ();;
Exception: Queue.Empty.