view release on metacpan or  search on metacpan

lib/Algorithm/Bitonic/Sort.pm  view on Meta::CPAN

sub _bitonic_merge {
	my $up = shift;
	say '#### Merge: '.Dumper(@_) if DEBUG;
	
	my $single_bit = shift;
	say Dumper $single_bit if DEBUG;
	
	# assume input @num is bitonic, and sorted list is returned 
	return @_ if int @_ == 1;
	
	my $single_bit_2 = shift @_ if @_ % 2;
	$single_bit_2 //= 'NA';
	
	my @num = @_;
	@num = _bitonic_compare( $up, @num );
	
	my @first = _bitonic_merge( $up, 'NA', @num[0..(@num /2 -1)] );
	my @second = _bitonic_merge( $up, 'NA', @num[(@num /2)..(@num -1)] );
	
	@num = (@first, @second);
	@num = _some_sorting_algorithm( $up, $single_bit, @first, @second ) if $single_bit ne 'NA';
	@num = _some_sorting_algorithm( $up, $single_bit_2, @first, @second ) if $single_bit_2 ne 'NA';
	
	say "#####\n# Merge Result\n#####\n".Dumper(@num)  if DEBUG;
	
	return (@num);
}

sub _bitonic_compare {
	my $up = shift;
	say '#### Compare: '.Dumper(@_) if DEBUG;
	my @num = @_;
	
	my $dist = int @num /2;
	#~ 
	for my $i (0..$dist-1) {
		say "i=$i, dist=$dist, $num[$i] > $num[$i+$dist]) == $up" if DEBUG;
		if ( ($num[$i] > $num[$i+$dist]) == $up ) {
			say "Swapping....." if DEBUG;
			($num[$i], $num[$i+$dist]) = ($num[$i+$dist], $num[$i]);	#swap
		}
	}
	#~ for my $i (0..(int @$first)) {
		#~ if ( ($first->[$i] > $second->[$i]) == $up ) {
			#~ ($first->[$i], $second->[$i]) = ($second->[$i], $first->[$i]);	#swap
		#~ }
	#~ }
	
	say 'Compared result:'.Dumper(@num) if DEBUG;
	return @num;
	#~ return ($first, $second);
}


sub _some_sorting_algorithm {
	my $up = shift;
	my $single_bit = shift;
	my @num = @_;
	my @num_new;
	
	say "_SOME_SORTING_ALGORITHM: INPUT: ".Dumper(@num) if DEBUG;
	
	while (my $curr = shift @num) {
		say "_SOME_SORTING_ALGORITHM: for: ".Dumper($curr, $single_bit, @num) if DEBUG;
		if ($up and $single_bit < $curr) {
			push @num_new, $single_bit;
			push @num_new, $curr;
			say "Return earlier, up is ".($up or '0').':'.Dumper(@num_new, @num) if DEBUG;
			return (@num_new, @num);
		} elsif ($single_bit > $curr and not $up) {
			push @num_new, $single_bit;
			push @num_new, $curr;
			say "Return earlier, up is ".($up or '0').':'.Dumper(@num_new, @num) if DEBUG;
			return (@num_new, @num)
		} else {
			push @num_new, $curr;
		}
	}
	
	push @num_new, $single_bit;
	say "Return normal, ".Dumper(@num_new, @num) if DEBUG;
	return @num_new;
}

=head1 AUTHOR

BlueT - Matthew Lien - 練喆明, C<< <BlueT at BlueT.org> >>


=head1 INSTALLATION

To install this module, run the following commands:

	perl Makefile.PL
	make
	make test
	make install

Or install with cpanm

	cpanm Algorithm::Bitonic::Sort


=head1 BUGS

Please report any bugs or feature requests to CPAN ( C<bug-algorithm-bitonic-sort at rt.cpan.org>, L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Algorithm-Bitonic-Sort> ) or GitHub (L<https://github.com/BlueT/Algorithm-Bitonic-Sort/issues>).
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Algorithm::Bitonic::Sort


You can also look for information at:

=over 4