2021年9月22日: Tcl、lapply、mapcar、maplist、filter

# 2021-09-22: Tcl、lapply、mapcar、maplist、filter

2021年9月22日 22時44分

Tcl で高階関数を使いやすくしてみた。

## <code>lapply</code>

最近の Tcl 言語だと <code>apply</code>[^tcl-apply] と無名関数を使えるけど、Tcl の <code>apply</code> は、Common Lisp でいうところの <code>funcall</code> で、パラメーターをリストオブジェクトで与えられなくて不便なことがあるから、リストオブジェクトでパラメーターを与える <code>lapply</code> を考えてみた。

ただし次の拡張をした。

<dl>
<dt>コマンド名を指定できるように
<dd><code>apply</code> は第1引数とで与えられるのは無名関数つまり <code>{{<var>arg<sub>0</sub></var> <var>arg<sub>1</sub></var> <var>arg<sub>2</sub></var> <var>&hellip;</var>} {<var>&hellip; 本体定義 &hellip;</var>}}</code> の形のものだけで、既存のコマンド名をそのまま与えることができなくてすごく不便。だから<code>lapply</code>では第1引数（<code><var>lambda</var></code>）にコマンド名を与えられると、それを内部的に無名関数の形式に変換する処理を前のほうに追加することにした。
<dt>引数形式の拡張
<dd>そしてついでに Scheme の <code>apply</code> 手続きに似せて、引数の形式を拡張して、<code>(lapply <var>lambda</var> <var>arg<sub>0</sub></var> <var>arg<sub>1</sub></var> &hellip; <var>restArgsList</var>)</code> の形式を受け入れるようにした。
</dl>

```tcl:
proc lapply {lambda argslist args} \
  {
  # lambdaにコマンド名を指定された場合にlambdaを無名関数に変換する
  if {[llength $lambda] == 1} \
    {set lambda [format {{args} {apply [list {} [concat {%s} $args]]}} $lambda]}

  # 引数形式の拡張
  if {0 < [llength $args]} \
    {set argslist [concat $argslist [lrange $args 0 end-1] [lindex $args end]]}

  # 機能の核の部分
  apply [list {} [concat [list apply $lambda] $argslist]]
  }
```

### 使用例

<code>tclsh</code> での実行例。

```
% lapply puts [list -nonewline Hello]
Hello%
```

```
% lapply puts -nonewline [list Hello]
Hello%
```

```
% lapply list a b c [list d e f] [list g h i]
a b c {d e f} g h i
%
```

## <code>mapcar</code>

使うことが多い Scheme SRFI-1 にある <code>map</code>[^srfi-1-map] を定義してみた。だけど名前は Common Lisp 由来の <code>mapcar</code> にした。（<code>maplist</code> とか他のも作るから。）<code><var>lambda</var></code> としては無名関数の他に既存のコマンド名をそのまま与えることができるよおにした。

```tcl:
proc mapcar {lambda args} \
  {
  # lambdaにコマンド名を指定された場合にlambdaを無名関数に変換する
  if {[llength $lambda] == 1} \
    {set lambda [format {{args} {apply [list {} [concat {%s} $args]]}} $lambda]}

  # 機能の核の部分
  set products [list]
  while {0 < [llength $args]} \
    {
    set command [list apply $lambda]
    set args_next [list]
    foreach a $args \
      {
      if {[llength $a] == 0} {return $products}
      lappend command [lindex $a 0]
      lappend args_next [lrange $a 1 end]
      }
    lappend products [apply [list {} $command]]
    set args $args_next
    }
  return $products
  }
```

### 使用例

<code>tclsh</code> での実行例。

```
% set matrix [list [list a11 a12 a13] [list a21 a22 a23]]
{a11 a12 a13} {a21 a22 a23}
% proc car {l} {lindex $l 0}
% proc cdr {l} {lrange $l 1 end}
% mapcar car $matrix
a11 a21
% mapcar cdr $matrix
{a12 a13} {a22 a23}
```

```
% mapcar list [list a alpha] [list b bravo] [list c charlie]
{a b c} {alpha bravo charlie}
%
```

```
% set matrix_transpose [lapply mapcar list $matrix]
{a11 a21} {a12 a22} {a13 a23}
%
```

Scheme SRFI-1 の <code>map</code> と同じで、出力は一番短いリストの長さになる。

```
% mapcar list [list a b c d e] [list 1 2 3] [list A B C D E F G H I]
{a 1 A} {b 2 B} {c 3 C}
%
```

より現実的な例として表データを扱うものを考えてみるた。ここでは2020年12月の日経平均株価の末日から4日前までの5日間の終値の平均値を求める例ね。

まずは表データ。日付、始値、高値、安値、終値の順番のレコードが並んだリスト。

```tcl:
# Date         Open         High         Low          Close
set nikkei225_2020Dec \
  {
  {2020/12/1   26624.19922  26852.16016  26618.39063  26787.53906}
  {2020/12/2   26884.99023  26889.90039  26695.2793   26800.98047}
  {2020/12/3   26740.30078  26868.08984  26719.23047  26809.36914}
  {2020/12/4   26697.25977  26799.83008  26646.08008  26751.24023}
  {2020/12/7   26894.25     26894.25     26500.32031  26547.43945}
  {2020/12/8   26380.32031  26523.30078  26327.08008  26467.08008}
  {2020/12/9   26526.33984  26826.7793   26520.59961  26817.93945}
  {2020/12/10  26688.5      26852.76953  26639.98047  26756.24023}
  {2020/12/11  26732.84961  26819.41016  26553.00977  26652.51953}
  {2020/12/14  26659.5293   26870.4707   26648.68945  26732.43945}
  {2020/12/15  26683.10938  26736.83984  26605.53906  26687.83984}
  {2020/12/16  26835.58984  26874.98047  26717.0293   26757.40039}
  {2020/12/17  26744.5      26843.05078  26676.2793   26806.66992}
  {2020/12/18  26775.5293   26824.28906  26707.30078  26763.39063}
  {2020/12/21  26834.09961  26905.66992  26533.63086  26714.41992}
  {2020/12/22  26559.33008  26639.99023  26361.66016  26436.39063}
  {2020/12/23  26580.42969  26585.21094  26414.74023  26524.78906}
  {2020/12/24  26635.10938  26764.5293   26605.25977  26668.34961}
  {2020/12/25  26708.09961  26716.60938  26638.2793   26656.60938}
  {2020/12/28  26691.28906  26854.0293   26664.59961  26854.0293}
  {2020/12/29  26936.38086  27602.51953  26921.14063  27568.15039}
  {2020/12/30  27559.09961  27572.57031  27338.56055  27444.16992}
  }

proc getDate  {r} {lindex $r 0}
proc getOpen  {r} {lindex $r 1}
proc getHigh  {r} {lindex $r 2}
proc getLow   {r} {lindex $r 3}
proc getClose {r} {lindex $r 4}
```

まずは年末の5日間のデータを求める。リストを逆順にして最初の5つを取ればよい。

```
% lrange [lreverse $nikkei225_2020Dec] 0 4
{2020/12/30  27559.09961  27572.57031  27338.56055  27444.16992} {2020/12/29  26936.38086  27602.51953  26921.14063  27568.15039} {2020/12/28  26691.28906  26854.0293   26664.59961  26854.0293} {2020/12/25  26708.09961  26716.60938  26638.2793   26656.60938} {2020/12/24  26635.10938  26764.5293   26605.25977  26668.34961}
%
```

こんな部分リストになるから、これらのそれぞれから <code>mapcar</code> を使って終値だけを抽出する。

```
% mapcar getClose [lrange [lreverse $nikkei225_2020Dec] 0 4]
27444.16992 27568.15039 26854.0293 26656.60938 26668.34961
%
```

最後にその平均値を求める。

```
% expr ([join [mapcar getClose [lrange [lreverse $nikkei225_2020Dec] 0 4]] +]) / 5
27038.26172
% 
```

## <code>maplist</code>

Common Lisp の <code>maplist</code> と同じ。これの実装は上の <code>mapcar</code> とは一行違うだけ。

```tcl:
proc maplist {lambda args} \
  {
  # lambdaにコマンド名を指定された場合にlambdaを無名関数に変換する
  if {[llength $lambda] == 1} \
    {set lambda [format {{args} {apply [list {} [concat {%s} $args]]}} $lambda]}

  # 機能の核の部分
  set products [list]
  while {0 < [llength $args]} \
    {
    set command [list apply $lambda]
    set args_next [list]
    foreach a $args \
      {
      if {[llength $a] == 0} {return $products}
      # ★★★ mapcar とは次の行だけが違う ★★★
      lappend command $a
      lappend args_next [lrange $a 1 end]
      }
    lappend products [apply [list {} $command]]
    set args $args_next
    }
  return $products
  }
```

### 使用例

<code>tclsh</code> での実行例。

```
% maplist list [list a b c d e] [list 1 2 3 4 5]
{{a b c d e} {1 2 3 4 5}} {{b c d e} {2 3 4 5}} {{c d e} {3 4 5}} {{d e} {4 5}} {e 5}
% 
```

つぎに、日経平均株価の終値の5日移動平均（MA5）を考えてみる。これは <code>mapcar</code> でやったものを利用する。ただし移動平均値は年末最後の日から過去の方向に向かって求めていく。計算結果は毎日の日付とその日を含む5日移動平均値のリストとする。ただしデータは有限で、5日分のデータがそろわない12月1日から12月4日の期間については日付と <code>false</code> を計算結果とする。

```tcl:
set ma5s \
  [maplist \
    {{rs}
      {list \
        [getDate [lindex $rs 0]] \
        [expr {[llength $rs] < 5} ? false : ([join [mapcar getClose [lrange $rs 0 4]] +]) / 5]
      }
    } \
    [lreverse $nikkei225_2020Dec]]
```

これを表示するとこうなる。

```
% foreach ma5 $ma5s {puts $ma5}
2020/12/30 27038.26172
2020/12/29 26854.385548000002
2020/12/28 26628.033596
2020/12/25 26600.111719999997
2020/12/24 26621.467969999998
2020/12/23 26649.132032000005
2020/12/22 26695.654298
2020/12/21 26745.94414
2020/12/18 26749.548046
2020/12/17 26727.373826000003
2020/12/16 26717.287888000003
2020/12/15 26729.3957
2020/12/14 26685.243748
2020/12/11 26648.243748
2020/12/10 26667.987888000003
2020/12/9 26678.613670000002
2020/12/8 26675.221874
2020/12/7 26739.313669999996
2020/12/4 false
2020/12/3 false
2020/12/2 false
2020/12/1 false
%
```

これをもとの日付順にしつつ <code>false</code> の箇所を除外すると、こうなる。

```
% foreach ma5 [lreverse $ma5s] {if [lindex $ma5 1] {puts $ma5}}
2020/12/7 26739.313669999996
2020/12/8 26675.221874
2020/12/9 26678.613670000002
2020/12/10 26667.987888000003
2020/12/11 26648.243748
2020/12/14 26685.243748
2020/12/15 26729.3957
2020/12/16 26717.287888000003
2020/12/17 26727.373826000003
2020/12/18 26749.548046
2020/12/21 26745.94414
2020/12/22 26695.654298
2020/12/23 26649.132032000005
2020/12/24 26621.467969999998
2020/12/25 26600.111719999997
2020/12/28 26628.033596
2020/12/29 26854.385548000002
2020/12/30 27038.26172
%
```

## <code>filter</code>

Scheme の SRFI-1 の <code>filter</code>[^srfi-1-filter] と同じもの。第1引数 <code><var>pred</var></code> には述語の無名関数または既存のコマンド名、第2引数 <code><var>list</var></code> にはリストデータ指定する。

```tcl:
proc filter {pred list} \
  {
  # predにコマンド名を指定された場合にpredを無名関数に変換する
  if {[llength $pred] == 1} \
    {set pred [format {{args} {apply [list {} [concat {%s} $args]]}} $pred]}

  set product [list]
  foreach l $list \
    {if [apply $pred $l] {lappend product $l}}
  return $product
  }
```

### 使用例

<code>tclsh</code> での実行例。

```
% filter {{n} {expr $n % 2 == 0}} [list 0 1 2 3 4 5 6 7 8 9 10]
0 2 4 6 8 10
% proc evenp {n} {expr $n % 2 == 0}
% filter evenp [list 0 1 2 3 4 5 6 7 8 9 10]
0 2 4 6 8 10
% 
```

先ほどの日経平均株価の5日移動平均の計算結果から <code>false</code> のものを除外するコードはこおなる。（評価結果は載せないけど。）

```
filter {{r} {lindex $r 1}} [lreverse $ma5s]
```

## 終わりに

<code>map</code> と似てるけどリストを生成しない Scheme の <code>for-each</code>[^srfi-1-for-each] （Common Lisp でゆう <code>mapc</code>）とか、<code>fold</code>[^srfi-1-fold] とかいろんな高階関数をつくってみてもいいかもしれない。

[^tcl-apply]: https://www.tcl-lang.org/man/tcl/TclCmd/apply.htm
[^srfi-1-map]: https://srfi.schemers.org/srfi-1/srfi-1.html#map
[^srfi-1-for-each]: https://srfi.schemers.org/srfi-1/srfi-1.html#for-each
[^srfi-1-fold]: https://srfi.schemers.org/srfi-1/srfi-1.html#fold
[^srfi-1-filter]: https://srfi.schemers.org/srfi-1/srfi-1.html#filter