File Coverage

blib/lib/Quantum/Superpositions/Lazy/Statistics.pm

Criterion	Covered	Total	%
statement	35	37	94.5
branch			n/a
condition			n/a
subroutine	13	14	92.8
pod	4	4	100.0
total	52	55	94.5

package Quantum::Superpositions::Lazy::Statistics;
$Quantum::Superpositions::Lazy::Statistics::VERSION = '1.12';
use v5.24;
use warnings;
use Moo;
use Quantum::Superpositions::Lazy::Role::Collapsible;
use Quantum::Superpositions::Lazy::State;
use Types::Standard qw(ArrayRef ConsumerOf InstanceOf);
use Sort::Key qw(keysort nkeysort);
use List::Util qw(sum0);

# This approximation should be well within the range of 32 bit
# floating point values - 6 digits (IEEE 754)
use constant HALF_APPROX => "0.500000";

sub transform_states
{
	my ($items, $transformer) = @_;
	my @transformed = map {
		$_->clone_with(value => $transformer)
	} @$items;

	return \@transformed;
}

sub weight_to_probability
{
	my ($item, $weight_sum) = @_;
	return $item->clone_with(
		weight => sub { shift() / $weight_sum }
	) if defined $item;

	return $item;
}

sub weighted_mean
{
	my ($list_ref, $weight_sum) = @_;
	$weight_sum = sum0 map { $_->weight }
	$list_ref->@*
		unless defined $weight_sum;

	if ($weight_sum > 0) {
		my @values = map { $_->value * $_->weight / $weight_sum } $list_ref->@*;
		return sum0 @values;
	}
	return undef;
}

# The sorting order is irrelevant here
sub weighted_median
{
	my ($sorted_list_ref, $average) = @_;
	$average //= 0;

	my $approx_half = sub {
		my ($value) = @_;

		return HALF_APPROX eq substr(($value . (0 x length HALF_APPROX)), 0, length HALF_APPROX);
	};

	my $running_sum = 0;
	my $last_el;
	my @found;

	for my $el (@{$sorted_list_ref}) {
		$running_sum += $el->weight;

		if ($running_sum > 0.5) {
			push @found, $last_el if $approx_half->($running_sum - $el->weight);
			push @found, $el;
			last;
		}

		$last_el = $el;
	}

	# if we're allowed to average the result, do that
	return weighted_mean(\@found)
		if $average;

	# get the lowest weight value if we can't average the two
	# be biased towards the first value
	return $found[1]->weight < $found[0]->weight ? $found[1]->value : $found[0]->value
		if @found == 2;

	return @found > 0 ? $found[0]->value : undef;
}

# CAUTION: float == comparison inside. Will only work for elements
# that were obtained in a similar fasion
sub find_border_elements
{
	my ($sorted) = @_;
	my @found;
	for my $state (@$sorted) {
		push @found, $state
			if @found == 0 || $found[-1]->weight == $state->weight;
	}

	return \@found;
}

my %options = (
	is => "ro",
	lazy => 1,
	init_arg => undef,
);

use namespace::clean;

our $implementation = __PACKAGE__;

has "parent" => (
	is => "ro",
	isa => ConsumerOf ["Quantum::Superpositions::Lazy::Role::Collapsible"],
	weak_ref => 1,
);

# Sorted in ascending order
has "sorted_by_probability" => (
	%options,
	isa => ArrayRef [InstanceOf ["Quantum::Superpositions::Lazy::State"]],
	default => sub {
		my ($self) = @_;

		[
			map {
				weight_to_probability($_, $self->parent->weight_sum)
			}
				nkeysort {
				$_->weight
			}
			$self->parent->states->@*
		];
	},
);

# Sorted in ascending order
# (we use sorted_by_probability to avoid copying states twice in weight_to_probability)
has "sorted_by_value_str" => (
	%options,
	isa => ArrayRef [InstanceOf ["Quantum::Superpositions::Lazy::State"]],
	default => sub {
		my ($self) = @_;

		[
			keysort { $_->value }
			$self->sorted_by_probability->@*
		];
	},
);

has "sorted_by_value_num" => (
	%options,
	isa => ArrayRef [InstanceOf ["Quantum::Superpositions::Lazy::State"]],
	default => sub {
		my ($self) = @_;

		[
			nkeysort { $_->value }
			$self->sorted_by_probability->@*
		];
	},
);

# Other consumer indicator
has "most_probable" => (
	%options,
	isa => InstanceOf ["Quantum::Superpositions::Lazy::Superposition"],
	default => sub {
		my ($self) = @_;

		my @sorted = reverse $self->sorted_by_probability->@*;
		return Quantum::Superpositions::Lazy::Superposition->new(
			states => find_border_elements(\@sorted)
		);
	},
);

has "least_probable" => (
	%options,
	isa => InstanceOf ["Quantum::Superpositions::Lazy::Superposition"],
	default => sub {
		my ($self) = @_;

		my $sorted = $self->sorted_by_probability;
		return Quantum::Superpositions::Lazy::Superposition->new(
			states => find_border_elements($sorted)
		);
	},
);

has "median_str" => (
	%options,
	default => sub {
		my ($self) = @_;

		weighted_median($self->sorted_by_value_str);
	},
);

has "median_num" => (
	%options,
	default => sub {
		my ($self) = @_;

		weighted_median($self->sorted_by_value_num, 1);
	},
);

has "mean" => (
	%options,
	default => sub {
		my ($self) = @_;

		# since the mean won't return a state, we're free not
		# to make copies of the states.
		weighted_mean($self->parent->states, $self->parent->weight_sum);
	},
);

has "variance" => (
	%options,
	default => sub {
		my ($self) = @_;

		# transform_states is required here so that we don't modify existing states
		weighted_mean(
			transform_states($self->parent->states, sub { $_[0]**2 }),
			$self->parent->weight_sum
			)
			-
			$self->mean**2;
	},
);

sub sorted_by_value
{
	my ($self) = @_;
	return $self->sorted_by_value_str;
}

sub median
{
	my ($self) = @_;
	return $self->median_str;
}

sub expected_value
{
	my ($self) = @_;
	return $self->mean;
}

sub standard_deviation
{
	my ($self) = @_;
	return sqrt $self->variance;
}

1;

__END__