ルモーリン
ホーム 更新 Perl Sample サービス 雑談 鉄ゲタ Linux リンク 連絡先

Perlサンプル26 シークヮーサーの表記ゆれ~その3~

投稿:2020-09-18

正規表現に沿って生成するけれどランダム生成するサブルーチンは自分で手書きしているので面白くない。 あとバリエーションの個数を自分で数えて終了条件にするくらいなら全部自分で書き出せばいいんじゃね(笑)>私
Perlサンプル25 シークヮーサーの表記ゆれ~その2~

正規表現をパースして構文木(用法合ってる?)を作り、それを見て、文字列生成のオブジェクト(階層構造)を構築して、生成します。 生成方法(生成するサブルーチン)を自動化できるのでバリエーションの個数も自動で求めます。 もう自分で数えなくてもいいんだ(わーい♪)

シークワーサーしか試していないので、他の正規表現は間違いなく失敗します。 例えば、代替「|」をカッコで囲むのは確か私の癖なのでカッコなしでも書けたはず。 そういった書き方ではオブジェクトを構築できないので。

#!/usr/bin/env perl

use v5.26;
use utf8;
use warnings;
use strict;

use Encode::Locale;
use Regexp::Parser;

use feature "say";
use open IO => ":utf8";

binmode STDOUT, ":encoding(console_out)";
binmode STDERR, ":encoding(console_out)";

$| = 1;

use constant REGEXP => '^シ((ィ|イ)ー?|ー)ク(ア|ァ|ワ|ヮ)ー?(サ|シャ)ー$';
my $parser = Regexp::Parser->new(REGEXP);
$parser->parse;
my $gen = Gen_root->new;
$gen->build_child($parser);
my $case = $gen->count_case;
say "ケース数 $case";

say "試行";
my $trial = 0;
my %result;
while (%result < $case) {
	$trial++;
	my $test = $gen->gen_string;
	if ($test !~ /@{[REGEXP]}/) {
		die "マッチしない $test";
	} elsif (!exists $result{$test}) {
		$result{$test} = 1;
		say "試行 $trial 回目, @{[scalar keys %result]} 個目, $test";
	}
}

say "昇順";
say for sort keys %result;

exit;

package Gen;
# 元のクラス
sub new {
	my $class = shift;
	my $self = {};
	bless $self, $class;
}

# 構文木のオブジェクトに合わせて生成
sub build_from_parser {
	my $self = shift;
	my ($parser) = @_;

	my $class = ref $parser;
	# Regexp::Parser::を削る
	$class =~ s/.*://;
	my $object;
	if ("bol" eq $class) {
		$object = Gen_bol->new;
	} elsif ("exact" eq $class) {
		$object = Gen_exact->new;
	} elsif ("open" eq $class) {
		$object = Gen_open->new;
	} elsif ("branch" eq $class) {
		$object = Gen_branch->new;
	} elsif ("quant" eq $class) {
		$object = Gen_quant->new;
	} elsif ("eol" eq $class) {
		$object = Gen_eol->new;
	} elsif ("ARRAY" eq $class) {
		# 子が複数の場合に自家製派生クラスを使う(構文木にない)
		$object = Gen_folder->new;
	} else {
		# 構文木がないのでオブジェクトを作らない(値がある)
	}

	# クラス毎に子の扱いが変わるので別メソッドにして呼び出す
	$object->build_child($parser) if defined $object;
	return $object;
}

sub build_child {
	my $self = shift;
	my ($parser) = @_;

	my $child = $self->build_from_parser($parser->{data});
	$self->{child} = [$child] if defined $child;
}

sub gen_string {
	my $self = shift;

	my $string = "";
	$string = ${$self->{child}}[0]->gen_string if exists $self->{child};

	return $string;
}

sub count_case {
	my $self = shift;
	return ${$self->{child}}[0]->count_case if exists $self->{child};
	return 1;
}

package Gen_root;
# ルート
use parent -norequire, qw/ Gen /;

sub build_child {
	my $self = shift;
	# この$parserはRegexp::Parser
	my ($parser) = @_;

	# ダミーのrootを作って渡す
	$self->SUPER::build_child({
		data => $parser->root,
	});
}

package Gen_bol;
# 行頭
use parent -norequire, qw/ Gen /;

package Gen_exact;
# 固定文字列
use parent -norequire, qw/ Gen /;

sub build_child {
	my $self = shift;
	my ($parser) = @_;
	$self->SUPER::build_child($parser);

	# 子の文字を連結して保存
	my $string;
	$string .= $_ for @{$parser->{data}};
	$self->{string} = $string;
}

sub gen_string {
	my $self = shift;
	return $self->{string};
}

package Gen_open;
# 開きカッコ
use parent -norequire, qw/ Gen /;

package Gen_branch;
# 代替「|」は、複数から均等の確率で出す
use parent -norequire, qw/ Gen /;

sub gen_string {
	my $self = shift;

	# Gen_folderが間に入っているので1階層降りて参照する
	my @child = @{${$self->{child}}[0]->{child}};
	return $child[int rand @child]->gen_string;
}

sub count_case {
	my $self = shift;
	# 子のケースを選択するので合計する
	# 例:2通りと3通りの子があれば全5通り
	my $count = 0;
	$count += $_->count_case for @{${$self->{child}}[0]->{child}};
	return $count;
}

package Gen_quant;
# 量指定子「?」(0回又は1回)は、50%の確率で文字を出す
use parent -norequire, qw/ Gen /;

sub gen_string {
	my $self = shift;
	my $string = "";
	$string = $self->SUPER::gen_string if int rand 2;
	return $string;
}

sub count_case {
	my $self = shift;
	return 2;
}

package Gen_eol;
# 行末
use parent -norequire, qw/ Gen /;

package Gen_folder;
# 階層
use parent -norequire, qw/ Gen /;

sub build_child {
	my $self = shift;
	my ($data) = @_;

	my @child;
	for (@{$data}) {
		my $child = $self->build_from_parser($_);
		push @child, $child if defined $child;
	}
	$self->{child} = \@child;
}

# 子が出してきた文字列を連結
sub gen_string {
	my $self = shift;

	my $string = "";
	$string .= $_->gen_string for @{$self->{child}};

	return $string;
}

sub count_case {
	my $self = shift;
	# 各々の子のケース数が組み合わされるので掛けていく
	# 例:2通りと3通りの子があれば全6通り
	my $count = 1;
	$count *= $_->count_case for @{$self->{child}};
	return $count;
}

相変わらずランダム生成ということ、そして乱数の種を指定していないので、実行の度に80個目の試行回数が変わります。

ケース数 80
試行
試行 1 回目, 1 個目, シイークワシャー    
試行 2 回目, 2 個目, シィークアーサー    
試行 3 回目, 3 個目, シィクワーサー      
試行 4 回目, 4 個目, シークアーシャー    
試行 5 回目, 5 個目, シークアサー        
試行 6 回目, 6 個目, シィクァシャー      
試行 7 回目, 7 個目, シイークァシャー    
試行 8 回目, 8 個目, シークアシャー      
試行 9 回目, 9 個目, シークァサー        
試行 10 回目, 10 個目, シイクァーサー    
試行 11 回目, 11 個目, シイークワーサー  
試行 12 回目, 12 個目, シークワーサー    
試行 13 回目, 13 個目, シイクアーサー    
試行 14 回目, 14 個目, シイークアサー    
試行 16 回目, 15 個目, シィークワーシャー
試行 17 回目, 16 個目, シィークァーサー
試行 18 回目, 17 個目, シィクアーシャー
試行 19 回目, 18 個目, シイクアサー    
試行 20 回目, 19 個目, シークァシャー  
試行 21 回目, 20 個目, シークヮーシャー
試行 22 回目, 21 個目, シイークァーサー
試行 23 回目, 22 個目, シークヮシャー  
試行 24 回目, 23 個目, シイクワーサー  
試行 26 回目, 24 個目, シィークヮシャー
試行 27 回目, 25 個目, シイクヮサー    
試行 29 回目, 26 個目, シィクヮサー    
試行 30 回目, 27 個目, シィクアシャー  
試行 33 回目, 28 個目, シイークヮーサー
試行 34 回目, 29 個目, シークァーサー  
試行 36 回目, 30 個目, シィークワーサー
試行 37 回目, 31 個目, シィクヮシャー  
試行 38 回目, 32 個目, シイークワサー    
試行 39 回目, 33 個目, シイークワーシャー
試行 40 回目, 34 個目, シークアーサー    
試行 43 回目, 35 個目, シィークワサー    
試行 44 回目, 36 個目, シイクァーシャー  
試行 45 回目, 37 個目, シイクヮシャー    
試行 48 回目, 38 個目, シークァーシャー  
試行 50 回目, 39 個目, シークワサー      
試行 53 回目, 40 個目, シィクヮーシャー  
試行 54 回目, 41 個目, シィークアシャー  
試行 55 回目, 42 個目, シイークアシャー  
試行 57 回目, 43 個目, シィクワサー      
試行 68 回目, 44 個目, シイクアーシャー
試行 69 回目, 45 個目, シイクワシャー  
試行 71 回目, 46 個目, シークヮサー    
試行 73 回目, 47 個目, シイークヮサー  
試行 76 回目, 48 個目, シィークアサー  
試行 77 回目, 49 個目, シイークアーサー
試行 78 回目, 50 個目, シークヮーサー  
試行 83 回目, 51 個目, シィクァサー     
試行 88 回目, 52 個目, シィクアーサー   
試行 91 回目, 53 個目, シイクァシャー   
試行 92 回目, 54 個目, シィクヮーサー   
試行 96 回目, 55 個目, シイクワサー     
試行 102 回目, 56 個目, シイクワーシャー
試行 103 回目, 57 個目, シークワーシャー
試行 106 回目, 58 個目, シイークアーシャー
試行 125 回目, 59 個目, シイークヮシャー  
試行 133 回目, 60 個目, シイークァサー
試行 161 回目, 61 個目, シィクァーサー
試行 191 回目, 62 個目, シイクアシャー
試行 198 回目, 63 個目, シィクワシャー
試行 218 回目, 64 個目, シィークァシャー
試行 224 回目, 65 個目, シィークヮーサー
試行 227 回目, 66 個目, シィクァーシャー
試行 232 回目, 67 個目, シークワシャー  
試行 240 回目, 68 個目, シィークヮサー
試行 278 回目, 69 個目, シイークヮーシャー
試行 285 回目, 70 個目, シイクァサー      
試行 292 回目, 71 個目, シイクヮーシャー  
試行 303 回目, 72 個目, シィークヮーシャー
試行 358 回目, 73 個目, シィークアーシャー
試行 369 回目, 74 個目, シイークァーシャー
試行 374 回目, 75 個目, シィークワシャー  
試行 464 回目, 76 個目, シィークァサー
試行 499 回目, 77 個目, シィクアサー
試行 561 回目, 78 個目, シイクヮーサー
試行 740 回目, 79 個目, シィクワーシャー
試行 774 回目, 80 個目, シィークァーシャー
昇順
シィクァサー
シィクァシャー
シィクァーサー
シィクァーシャー
シィクアサー
シィクアシャー
シィクアーサー
シィクアーシャー
シィクヮサー
シィクヮシャー
シィクヮーサー
シィクヮーシャー
シィクワサー
シィクワシャー
シィクワーサー
シィクワーシャー
シィークァサー
シィークァシャー
シィークァーサー
シィークァーシャー
シィークアサー
シィークアシャー
シィークアーサー
シィークアーシャー
シィークヮサー
シィークヮシャー
シィークヮーサー
シィークヮーシャー
シィークワサー
シィークワシャー
シィークワーサー
シィークワーシャー
シイクァサー
シイクァシャー
シイクァーサー
シイクァーシャー
シイクアサー
シイクアシャー
シイクアーサー
シイクアーシャー
シイクヮサー
シイクヮシャー
シイクヮーサー
シイクヮーシャー
シイクワサー
シイクワシャー
シイクワーサー
シイクワーシャー
シイークァサー
シイークァシャー
シイークァーサー
シイークァーシャー
シイークアサー
シイークアシャー
シイークアーサー
シイークアーシャー
シイークヮサー
シイークヮシャー
シイークヮーサー
シイークヮーシャー
シイークワサー
シイークワシャー
シイークワーサー
シイークワーシャー
シークァサー
シークァシャー
シークァーサー
シークァーシャー
シークアサー
シークアシャー
シークアーサー
シークアーシャー
シークヮサー
シークヮシャー
シークヮーサー
シークヮーシャー
シークワサー
シークワシャー
シークワーサー
シークワーシャー