筆者いつもの各言語お遊び記事です（ひさしぶりですが）．他のプログラミング言語等や，既出言語のより~~面白い~~良い実装がありましたら，追加掲載や修正を行いますので，その際にはどしどしお寄せ下さい．

【関連記事】簡易LISP処理系の実装例【各言語版まとめ】，フィボナッチ数列を求めるワンライナー各言語まとめ，10行LISP評価器の実装例（各言語まとめ），『エラトステネスの篩』各言語記述例まとめ

前書き

今回は，抽象機械としてのタグシステム（Wikipedia）のうち，チューリング完全であることが証明されている，削除数2の2-タグシステムを各言語等で実装してみようというものです．実装といっても，文字列操作や連想配列が利用可能なプログラミング言語であれば，本体は2～3行程度で記述可能です．仕組みとしては，大まかには次の要素と手順で構成されています¹．

構成要素：キュー構造，記号群，生成規則
手順：
1. キューの先頭記号に対応する記号列をキューの最後尾に追加する．
2. キューの先頭記号を2つ削除する．
3. キューの記号が1つになれば停止し，そうでなければ1.に戻る．

＜具体例＞

記号群：a, b
生成規則：a -> b b a,  b -> a b
初期キュー記号列：a a a

実行例：（停止せず記号列が無限増大）
a a a
a b b a
b a b b a
b b a a b
a a b a b
b a b b b a
b b b a a b
b a a b a b
a b a b a b
a b a b b b a
a b b b a b b a
...

あるシステムがチューリング完全であることを（正確な証明以外で）示す際に，Brainf**kなど，チューリングマシンに基づく非常に簡潔なプログラミング言語のインタプリタをそのシステムで実装することがありますが，2-タグシステムの実装でも同様のことが可能です．

ただし，チューリングマシンとは異なる計算モデルであることもあって，現在主流のパラダイムとは全く異なるプログラミング（生成規則と初期値の設定）を行う必要があります．2-タグシステムについては，コラッツ数列と同等の計算を行う生成規則が知られていますので，今回の実装例ではそれを2-タグシステムで実行するプログラム相当の例としています．

＜コラッツ数列の計算例＞

記号群：a, b, c
生成規則：a -> b c,  b -> a,  c -> a a a
初期キュー記号列：a a a a a（aのみの記号列で数値を表す．この場合は5）

実行例：
a a a a a（5）
a a a b c
a b c b c
c b c b c
c b c a a a
c a a a a a a
a a a a a a a a（8）
a a a a a a b c
a a a a b c b c
a a b c b c b c
b c b c b c b c
b c b c b c a
b c b c a a
b c a a a
a a a a（4）
a a b c
b c b c
b c a
a a（2）
b c
a（1）

各言語等の実装例

今回の実装例は次の方針で作成しています．

生成規則を2-タグシステムで動かすプログラム相当の一部とみなすため，実装言語等による直接的な判断処理としない（配列やマップ，連想リストに相当するデータとして定義する）．
記号群は，文字でも数値でも良い（記号を配列の添字として使用して生成規則を実装したい場合は数値とする，など）．キュー構造も，文字列，配列，リストなどいずれを用いても良い．
可読性が著しく損なわれない程度に，より短く記述する（今回はcode golf的なものは考えていません^^;）．煩雑でなければ，汎用的なm-タグシステムとして実装しても良い．
プログラム例としてのコラッツ数列生成は5で行う（27が理想ですが，実装システムによっては大幅なリソース不足に…）．初期値5相当の出力はあってもなくても構わない．

なお，実行例では，特に断りがない限り，Debian GNU/Linux 11のシェル環境で確認しています．また，次の出力結果となるものについては記載を省略しています．

aaabc
abcbc
cbcbc
cbcaaa
caaaaaa
aaaaaaaa
aaaaaabc
aaaabcbc
aabcbcbc
bcbcbcbc
bcbcbca
bcbcaa
bcaaa
aaaa
aabc
bcbc
bca
aa
bc
a

Python 3

tagsystem.py

s = input().rstrip().split()
q, r = s[0], dict(zip(list(s[2]), s[3:]))
while q[1:]: q = q[int(s[1]):]+r[q[0]]; print(q)

Python 3.9.2

$ python3 tagsystem.py
aaaaa 2 abc bc a aaa（入力：初期文字列 削除数 記号群 規則1 規則2 ...）

※リスト内包表記（とappend等）のみの実装例
【参考】
https://qiita.com/KTakahiro1729/items/c9cb757473de50652374
https://qiita.com/t-sin/items/662b055447ec87476384

tagsystem_comprehension.py

s = input().rstrip().split()
q, r = [s[0]], dict(zip(list(s[2]), s[3:]))
[q.append(h[int(s[1]):]+r[h[0]]) for h in q if h[1:]]
[print(n) for n in q]

Python 3.9.2

$ python3 tagsystem_comprehension.py
aaaaa 2 abc bc a aaa（入力：初期文字列 削除数 記号群 規則1 規則2 ...）

Scheme

2ts-Collatz5.scm

(let loop ((q '(a a a a a)) (r '((a . (b c)) (b . (a)) (c . (a a a)))))
  (for-each display q) (newline)
  (if (not (null? (cdr q))) (loop (append (cddr q) (cdr (assq (car q) r))) r)))

Gauche 0.9.12

$ gosh 2ts-Collatz5.scm
aaaaa
（共通の出力結果）

Common Lisp

2ts-Collatz5.cl

(let ((q '(a a a a a)) (r '((a b c) (b a) (c a a a))))
  (loop while (not (null (cdr q))) do
    (setq q (append (cddr q) (cdr (assoc (car q) r))))
    (mapc (lambda (c) (format t "~(~a~)" c)) q) (terpri)))

SBCL 2.1.1

$ sbcl --script 2ts-Collatz5.cl

Emacs Lisp

2ts-Collatz5.el

(let ((q '(a a a a a)) (r '((a b c) (b a) (c a a a))))
  (while (cdr q)
    (setq q (append (cddr q) (cdr (assoc (car q) r))))
    (princ (mapconcat #'identity (mapcar (lambda (c) (symbol-name c)) q) ""))
    (terpri)))

GNU Emacs 27.1

$ emacs --quick --script 2ts-Collatz5.el

Clojure

2ts-Collatz5.clojure

(loop [r {'a '(b c) 'b '(a) 'c '(a a a)} q '(a a a a a)]
  (println (clojure.string/join (map name q)))
  (if (not (empty? (rest q)))
      (recur r (concat (rest (rest q)) (get r (first q))))))

Clojure 1.10.2

$ clojure 2ts-Collatz5.clojure
aaaaa
（共通の出力結果）

C

2ts-Collatz5.c

#include <stdio.h>
#include <string.h>

#define QMAX 16384
#define RMAX 16

int main(void)
{
  char q[QMAX];
  const int m = 2, qi = 5;
  const char r[][RMAX] = {"bc", "a", "aaa"};
  int i;

  for (i = 0; i < qi; i++) q[i] = 'a'; q[i] = '\0';

  while (strlen(q) > 1) {
    strcat(q, r[q[0]-'a']);
    for (i = 0; i <= strlen(q)-m; i++) q[i] = q[i+m];
    printf("%s\n", q);
  }

  return 0;
}

gcc 10.2.1

$ cc 2ts-Collatz5.c && ./a.out

C++

2ts-Collatz5.cpp

#include <iostream>
#include <string>
#include <map>
using namespace std;

int main()
{
  string q = "aaaaa";
  map<char, string> r; r['a'] = "bc"; r['b'] = "a"; r['c'] = "aaa";
  while (q.size() > 1) { q = q.substr(2) + r[q[0]]; cout << q << endl; }
}

gcc 10.2.1

$ c++ 2ts-Collatz5.cpp && ./a.out

Java

ttsCollatz5.java

import java.util.HashMap;
import java.util.Map;

public class ttsCollatz5 {
  public static void main(String[] args) {
    Map<Character, String> r = new HashMap<>();
    r.put('a', "bc"); r.put('b', "a"); r.put('c', "aaa");
    String q = "aaaaa";

    while (q.length() > 1) {
      q = q.substring(2)+r.get(q.charAt(0));
      System.out.println(q);
    }
  }
}

OpenJDK 11.0.16

$ javac ttsCollatz5.java && java ttsCollatz5

Ruby

tagsystem.rb

s = gets.split();
q = s[0]; r = Hash[s[2].split(//).zip(s.slice(3, s.length))]
while q.size > 1 do q = q[s[1].to_i..-1]+r[q[0]]; print q, "\n" end

ruby 2.7.4

$ ruby tagsystem.rb
aaaaa 2 abc bc a aaa（入力：初期文字列 削除数 記号群 規則1 規則2 ...）

JavaScript

2ts-Collatz5.js

q = 'a'.repeat(5); r = {'a':"bc", 'b':"a", 'c':"aaa"}
while (q.length > 1) { q = q.slice(2) + r[q[0]]; console.log(q); }

Chrome 108デベロッパーツール

R

2ts-Collatz5.r

q <- "aaaaa"
r <- c("bc","a","aaa")
names(r) <- c("a","b","c")

while (nchar(q) > 1) {
  q <- paste0(substring(q,3), r[substring(q,1,1)])
  cat(q, "\n")
}

R

R -q
> source("2ts-Collatz5.r")

Julia

2ts-Collatz5.jl

q = "aaaaa"; r = Dict('a'=>"bc", 'b'=>"a", 'c'=>"aaa")
while length(q) > 1 global q = q[3:end]*r[q[1]]; println(q) end

Julia 1.5.3

$ julia 2ts-Collatz5.jl

Perl

2ts-Collatz5.pl

my %r;
$r{"a"}="bc"; $r{"b"}="a"; $r{"c"}="aaa";
$q = "a"x5;

while (length $q > 1) {
  $q = substr($q,2) . $r{substr($q,0,1)};
  print "$q\n";
}

perl 5.32.1

$ perl 2ts-Collatz5.pl

PHP

2ts-Collatz5.php

<?php
$q = "aaaaa";
$r = array(); $r["a"] = ["bc"]; $r["b"] = ["a"]; $r["c"] = ["aaa"];
while (strlen($q) > 1) { $q = substr($q,2).$r[$q[0]][0]; echo $q, "\n"; }

PHP 7.4.33

$ php 2ts-Collatz5.php

Lua

2ts-Collatz5.lua

q = "aaaaa"; r = {a="bc", b="a", c="aaa"}
while string.len(q)>1 do q = string.sub(q,3)..r[string.sub(q,0,1)]; print(q) end

Lua 5.4.2

$ lua 2ts-Collatz5.lua

Prolog

2ts-Collatz5.swi

dic(_,[],[]).
dic(K,[[K|V]|_],V) :- !.
dic(K,[_|D],V) :- dic(K,D,V).

two_ts([_],_).
two_ts([Q1,_|Q],D) :- dic(Q1,D,A), append(Q,A,R),
                      write(R), nl, two_ts(R,D).

:- two_ts([a,a,a,a,a],[[a,b,c],[b,a],[c,a,a,a]]).
:- halt.

SWI-Prolog 8.2.4

$ swipl -q 2ts-Collatz5.swi
[a,a,a,b,c]
[a,b,c,b,c]
[c,b,c,b,c]
[c,b,c,a,a,a]
[c,a,a,a,a,a,a]
[a,a,a,a,a,a,a,a]
[a,a,a,a,a,a,b,c]
[a,a,a,a,b,c,b,c]
[a,a,b,c,b,c,b,c]
[b,c,b,c,b,c,b,c]
[b,c,b,c,b,c,a]
[b,c,b,c,a,a]
[b,c,a,a,a]
[a,a,a,a]
[a,a,b,c]
[b,c,b,c]
[b,c,a]
[a,a]
[b,c]
[a]

Haskell

2ts-Collatz5.hs

two_ts (c:[]) _ r = r
two_ts (c:s) d r =
  two_ts n d (r ++ n:[])
  where a = case lookup c d of (Just x) -> x
        n = tail s ++ a

main = do
  let d = [('a',"bc"),('b',"a"),('c',"aaa")]
  mapM putStrLn $ two_ts "aaaaa" d []

GHC 8.8.4

$ runghc 2ts-Collatz5.hs

Go言語

2ts-Collatz5.go

package main
import ("fmt")

func main() {
  r := map[rune]string{'a':"bc",'b':"a",'c':"aaa"}
  q := "aaaaa"
  for q[1:] != "" {
    q = q[2:]+r[rune(q[0])]; fmt.Println(q)
  }
}

Go 1.15.15

$ go run 2ts-Collatz5.go

Rust

2ts-Collatz5.rs

use std::collections::HashMap;

fn main() {
  let mut r = HashMap::new();
  r.insert('a', "bc"); r.insert('b', "a"); r.insert('c', "aaa");
  let mut q = String::from("aaaaa");

  while q.len() > 1 {
    q += r[&q.chars().nth(0).unwrap()]; q.remove(0); q.remove(0);
    println!("{}", q);
  }
}

rustc 1.48.0

$ rustc 2ts-Collatz5.rs && ./2ts-Collatz5

awk

2ts-Collatz5.awk

{
  q = "aaaaa"; r["a"] = "bc"; r["b"] = "a"; r["c"] = "aaa"
  while (length(q) > 1) { q = substr(q,3)r[substr(q,1,1)]; print q }
}

mawk 1.3.4

$ echo | awk -f 2ts-Collatz5.awk

sh（POSIX準拠）

2ts-Collatz5.sh

q=aaaaa; a=bc; b=a; c=aaa
while [ ${q#?} ]; do eval q=$q\$${q%${q#?}}; q=${q#??}; echo $q; done

dash 0.5.11

$ sh 2ts-Collatz5.sh

Googleスプレッドシート

=LAMBDA(u,u(u))(
 LAMBDA(u,
   LAMBDA(q,r,
     IF(LEN(q)>1,{q;u(u)(MID(q,3,LEN(q))&VLOOKUP(MID(q,1,1),r,2),r)},q))))(
 "aaaaa", {{"a","bc"};{"b","a"};{"c","aaa"}})

2023/01/15現在

Vim script

2ts-Collatz5.vimscript

:let r = {'a':'bc', 'b':'a', 'c':'aaa'}
:let q = 'aaaaa'
:while strlen(q) > 1
  :let q = q[2:].r[q[0]]
  :echo q
:endwhile

Vim 8.2（ファイルを読み込んだ後，:source %で実行）

（共通の出力結果）
Press ENTER or type command to continue

Vimマクロ（キー入力の登録・実行）

【オリジナル】https://buttondown.email/hillelwayne/archive/vim-is-turing-complete/
※下記は生成規則を先頭文字でキー参照するよう修正したもの
※最初のlh（→←）は，文字列が1文字の時に，その後の登録キー入力が実行されないようにするため

lh2xjpx*3lyv$gg$pj$xgg

生成規則および初期値の設定

aaaaa
R（『*』による生成規則検索用のダミー文字．記号群で用いるものでなければなんでも良い）

Ra bc（行の最後にスペースをひとつ入れる）
Rb a（同上）
Rc aaa（同上）

実行方法
1. 上記キー入力を，たとえば『qa（コマンドキー入力）q』として，aにマクロ登録する．
2. 上記生成規則および初期値を記述したテキストファイルをvimで読み込み，1行目の初期値先頭にカーソルを移動させる．
3. たとえば20@aと，必要十分以上の回数のマクロ実行を行うと，1行目の文字列に対して連続実行される（文字列が1文字になった時に実行停止．@aの後に@@でステップ実行を行うことも可能）．

実行例：次のデモ動画は，わかりやすくするため，下記コマンドキー入力によるマクロ登録を用いて，ステップ実行を行いながら，それまでの実行結果を残すようにしています．

ddPPjlh2xjpx*3lyv$gg/R^Mk$pj$xgg/R^Mk

Excel数式＋オートフィル機能（参考）

※A列にA1=0から始まる最大実行回数分の数列，B1に初期値，B2に下記数式，C1:D3に生成規則のルックアップテーブルが記述されていることを想定

=IF(LEN(B1)>1,MID(B1,3,LEN(B1))&VLOOKUP(MID(B1,1,1),$C$1:$D$3,2),"")

実行方法：数式セル（B2）右下の角（マウスカーソルが+となる）をダブルクリックする．

実行例：（停止条件で停止処理が行われない）

bc（UNIX）

※多倍長整数演算による桁移動処理を用いたキュー相当を実装しています．下記実行例では，1，2，3が共通の出力結果のa，b，cに相当し，キューの方向は逆となっています．

tagsystem.bc

scale = 0
q = 11111
r = 111001032
w = 3; m = 2; d = 1
while (q > 10^d) {
  h = q-q/(10^d)*(10^d)
  g = r/((10^d)^(w*(h-1)))%((10^d)^w)
  e = q+10^length(q)*g
  q = e/((10^d)^m)
  q
}

bc 1.07.1

$ bc < tagsystem.bc
32111
32321
32323
111323
1111113
11111111
32111111
32321111
32323211
32323232
1323232
113232
11132
1111
3211
3232
132
11
32
1

【解説】
scale = 0：整数部分のみ使用することを指定（割り算結果は小数部を四捨五入）
q：初期キュー（1桁目が先頭，最上位桁が最後尾），w：1記号ごとの対応規則の最大桁数
r：生成規則（1桁目から上位桁に向かってw記号ずつ記号1,2,3...に対応）
m：削除記号数，d：1記号あたりの桁数（上記の例では1～9の範囲なので1）
h = q-q/(10^d)*(10^d)：qの先頭（1記号目）を取得（削除はしない）
g = r/((10^d)^(w*(h-1)))%((10^d)^w)：生成規則rからhに対応する規則を取得
e = q+10^length(q)*g：qに対応規則gを上位に追加（lengthは桁数取得関数）
q = e/((10^d)^m)：下位m記号を削除

2-タグシステムで1記号あたり1桁に特化した場合の例

2ts-Collatz5.bc

scale = 0; w = 3; q = 11111; r = 111001032
while (q > 10) { q = (q+10^length(q)*(r/(10^(w*(q-q/10*10-1)))%(10^w)))/100; q }

備考

記事に関する補足

実のところ，型なしラムダ計算の考え方に基づく，ラムダ式のみのタグシステム実装例もあります（読みやすさのため，無名再帰ではなく，普通に関数・変数定義を用いています）．やはりラムダ式も単体でチューリング完全だったか…．

bc版の多倍長整数演算を使った実装例，何かに応用できないかな…．具体的には，関数電卓のように，数学関数やメモリ機能はたくさんあるけど，各種のデータ構造やループ構文はない仕組みで，ステップ実行を人力で行えばタグシステム相当が動くのを確認するとか．準チューリング完全？違うか．

更新履歴

2023-01-23：シェルスクリプトの実装例を大幅修正
2023-01-18：数値演算等によるbcの実装例を追加，Scheme/Pythonの数値演算等のみの実装例を削除
2023-01-18：一部の例について，共通の出力結果の記載を省略
2023-01-18：Clojure/Java/Common Lisp/Emacs Lisp/PHP/R/awkの各版を追加
2023-01-17：記事に関する補足として，ラムダ式のみのタグシステム実装例について記載
2023-01-17：Scheme/Pythonの数値演算等のみの実装例を追加
2023-01-17：Haskell/Go言語/Rust/Perlの各版を追加
2023-01-16：Pythonリスト内包表記/Excel数式（参考）/Prologの各版を追加
2023-01-16：初版公開（Python/Scheme/C/C++/Ruby/JavaScript/Julia/Lua/シェルスクリプト/Googleスプレッドシート/Vim script/Vimマクロ）

停止記号による停止や，削除数が2以外の場合については省略しています． ↩