グループ化アルゴリズム

提供: dococo wiki
2017年9月10日 (日) 15:54時点におけるimported>Webmasterによる版 (ページの作成:「<syntaxhighlight lang="perl"> use strict; use warnings; use utf8; use Encode; open (FILE, "<test.csv") or die "$!"; my @union_a;# my @union_b;# my %count; wh...」)
(差分) ← 古い版 | 最新版 (差分) | 新しい版 → (差分)
ナビゲーションに移動 検索に移動
	use strict;
	use warnings;
	use utf8;
	use Encode;

	open (FILE, "<test.csv") or die "$!";
	
	my @union_a;#
	my @union_b;#
	my %count;

	while (my  $line = <FILE>) {
	$line = decode('cp932', $line);
	my @data =&ReturnCSV($line);
		push(@union_b, $data[1]);
	}
	@union_b = grep( !$count{$_}++, @union_b ) ;
	@union_b = sort {$a cmp $b} @union_b;
	for (0..@union_b-1){push(@union_a, $_);}
	
	my $Progress_End = @union_b-1;
	for (0..@union_b-1){
		my $Progress = $_;
		my $Parent_Node_Name = $union_b[$Progress];#

		seek(FILE, 0, 0);
		<FILE>;
		while (my  $line = <FILE>) {
		$line = decode('cp932', $line);
		my @data =&ReturnCSV($line);
		
			if ($Parent_Node_Name eq $data[1]){
				my $Search_Link_Info = $data[0];
				my $File_point = tell(FILE);
				seek(FILE, 0, 0);
				<FILE>;
				while (my  $line = <FILE>) {
				$line = decode('cp932', $line);
				my @data =&ReturnCSV($line);
					if ($Parent_Node_Name eq $data[1]){next;}
					if($Search_Link_Info eq $data[0]){
						my $Child_Node;
						for (0..@union_b-1){
							if($data[1] eq $union_b[$_]){$Child_Node = $_;}
						}
						if ($union_a[$Progress] <= $union_a[$Child_Node]){
							for (0..@union_a-1){
								if ($union_a[$_] eq $union_a[$Child_Node]){
									$union_a[$_] = $union_a[$Progress];
								}
							}
							$union_a[$Child_Node] = $union_a[$Progress];
						}
						else{
							
							for (0..@union_a-1){
								if ($union_a[$_] eq $union_a[$Progress]){
									$union_a[$_] = $union_a[$Child_Node];
								}
							}
							$union_a[$Progress] = $union_a[$Child_Node];
						}
					}
				}
				
				seek(FILE, $File_point, 0);
			}
		}

	print "$Progress/$Progress_End\n";
	}

	
	for (0..@union_b-1){print OUT "$union_b[$_], $union_a[$_]\n";}
	close (FILE);



sub ReturnCSV
{
	my (@RETURN)=();
	my ($CSV_DATA) = @_;
	$CSV_DATA =~ tr/"//d;
	chomp($CSV_DATA);
	@RETURN = split (/,/ , $CSV_DATA);
	return(@RETURN);
}