view release on metacpan or  search on metacpan

WalshTransform.pm  view on Meta::CPAN

	if ($alternate) {
		for ($k=$[; $k<$n-$[; $k+=2) {
			$kp1 = $k+1;
			$mr[$k]   =  $mr[$k] + $mr[$kp1];
			$mr[$kp1] =  $mr[$k] - $mr[$kp1] - $mr[$kp1];
		}
	} else { 
		for ($k=$[; $k<$n-$[; $k+=2) { 
			$kp1 = $k+1;
			$nr[$k]   =  $mr[$k] + $mr[$kp1];
			$nr[$kp1] =  $mr[$k] - $mr[$kp1];
		}
	}

	$k = 1; my $nh = $n/2;
	while () {
		my $kh = $k; $k = $k+$k; $kp1 = $k+1; last if $kp1>$n;
		$nh = $nh/2; $l = $[; $i = $[; $alternate = !$alternate;
		for ($nl=1; $nl<=$nh; $nl++) {
			for ($nk=1; $nk<=$kh; $nk++) {
				if ($alternate) {
					$mr[$l]   =  $nr[$i]   + $nr[$i+$k];
					$mr[$l+1] =  $nr[$i]   - $nr[$i+$k];
					$mr[$l+2] =  $nr[$i+1] - $nr[$i+$kp1];
					$mr[$l+3] =  $nr[$i+1] + $nr[$i+$kp1];
				} else {
					$nr[$l]   =  $mr[$i]   + $mr[$i+$k];
					$nr[$l+1] =  $mr[$i]   - $mr[$i+$k];
					$nr[$l+2] =  $mr[$i+1] - $mr[$i+$kp1];
					$nr[$l+3] =  $mr[$i+1] + $mr[$i+$kp1];
				}
				$l = $l+4; $i = $i+2;
			}
			$i = $i+$k;
		}
	}
	return @mr;
}

sub logical_convolution { my ($xref, $yref) = @_;
	if (ref $xref ne 'ARRAY') { warn
	"Math::WalshTransform::logical_convolution 1st arg must be array ref\n";
		return undef;
	} elsif (ref $yref ne 'ARRAY') { warn
	"Math::WalshTransform::logical_convolution 2nd arg must be array ref\n";
		return undef;
	}
	my @Fx = &fwt(@$xref);  my @Fy = &fwt(@$yref);
	# my @Fz; foreach ($[ .. $#Fx) { $Fz[$_] = $Fx[$_] * $Fy[$_]; } return @Fz;
	return &fwtinv(&product(\@Fx, \@Fy));
}

sub old_logical_convolution { my ($xref, $yref) = @_;
	if (ref $xref ne 'ARRAY') { warn
	"Math::WalshTransform::logical_convolution 1st arg must be array ref\n";
		return undef;
	} elsif (ref $yref ne 'ARRAY') { warn
	"Math::WalshTransform::logical_convolution 2nd arg must be array ref\n";
		return undef;
	}
	local $[ = 0;
	my @x = @$xref; my @y = @$yref;
	my $n = scalar @x;
	my @z; $#z=$#x;
	my $j; my $k; my $sum;
	for ($k=$[; $k<=$#x; $k++) {
		$sum = 0.0;
		for ($j=$[; $j<=$#x; $j++) { $sum += $x[$j^$k] * $y[$j]; }
		$z[$k] = $sum/$n;
	}
	return @z;
}
sub logical_autocorrelation {
	&logical_convolution(\@_,\@_);
}
sub power_spectrum {
	&fwt( &logical_convolution(\@_,\@_) );
}
sub walsh2hadamard {
	my @h; $#h = $#_;
	my @jw2jh = &jw2jh(scalar @_);
	my $i; for ($i=$[; $i<=$#_; $i++) { $h[$jw2jh[$i]] = $_[$i]; }
	return @h;
}
sub hadamard2walsh {
	my @w; $#w = $#_;
	my @jw2jh = &jw2jh(scalar @_);
	my $i; for ($i=$[; $i<=$#_; $i++) { $w[$i] = $_[$jw2jh[$i]]; }
	return @w;
}

# ---------------------- EXPORT_OK stuff ---------------------------

sub biggest { my $k = shift @_; my @weeded = @_;
	my $smallest;
	if ($k <= 0) {
		my $tot = 0.0; foreach (@weeded) { $tot += abs $_; }
		$smallest = $tot / scalar @weeded;
	} else {
		my @sorted = sort { abs $b <=> abs $a } @weeded;
		$smallest = abs $sorted[$[-1+$k];
	}
	foreach (@weeded) { if (abs $_ < $smallest) { $_=0.0; } }
	return @weeded;
}
sub sublist { my ($aref, $offset, $length) = @_;
	if (ref $aref ne 'ARRAY') {
	warn "Math::WalshTransform::sublist 1st arg must be array ref\n"; return ();
	}
	my $first;
	if ($offset<0) { $first = $#{$aref}+$offset+1; } else { $first=$offset; }
	my $last;
	if (! defined $length) { $last = $#{$aref};
	} elsif ($length < 0) { $last = $#{$aref} + $length;
	} else { $last = $first + $length - 1;
	}
	# warn "offset=$offset length=$length first=$first last=$last\n";
	my @sublist = (); my $i;
	for ($i=$first; $i<=$last; $i++) { push @sublist, ${$aref}[$i]; }
	return @sublist;
}