#!/usr/bin/env perl use strict; use warnings; use Getopt::Long; use List::Util qw(sum); my $fields = ""; GetOptions( "fields=s" => \$fields, # select only these fields (origin 1) ); my @flds = map {$_ - 1} split(/,/, $fields); my @cols; while (<>) { chomp; next if not /^[\d-]/; my @c = $fields ? (split/\t/)[@flds] : split/\t/; push @{$cols[$_]}, $c[$_] for (0..$#c); } for (my $i = 0; $i < @cols; $i++) { for (my $j = 0; $j < $i; $j++) { printf "%.4f", skks($cols[$i], $cols[$j]); print (($j < $i-1) ? "\t" : "\n"); } } sub skks { my (@cs) = @_; my (@av, @vr); foreach my $i (0, 1) { $av[$i] = (sum @{$cs[$i]}) / @{$cs[$i]}; $vr[$i] += ($_ - $av[$i])**2 for @{$cs[$i]}; } my $cv = sum map {($cs[0][$_] - $av[0]) * ($cs[1][$_] - $av[1])} (0..$#{$cs[0]}); return $cv / (sqrt($vr[0]) * sqrt($vr[1])); }
身長 性別 自宅 176 1 0 173 1 1 175 1 0 170 1 0 173 1 1 170 0 0 165 0 1 164 0 1 165 0 0 160 0 1
% ./skks.pl -f 1,2 skks-test.txt 0.8484 % ./skks.pl -f 2,3 skks-test.txt -0.2000 % ./skks.pl -f 1,3 skks-test.txt -0.4143 % ./skks.pl -f 1,2,3 skks-test.txt 0.8484 -0.4143 -0.2000