123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448 |
- #!/usr/bin/perl
- # Daniel "Trizen" Șuteu
- # Date: 15 April 2016
- # Edit: 15 May 2021
- # https://github.com/trizen
- # Analyze a sequence of numbers and find a closed-form expression.
- # Unfinished work...
- # Use the script "sequence_analyzer.pl" instead.
- use 5.010;
- use strict;
- use warnings;
- package Sequence::ClosedForm {
- use Math::AnyNum qw(Inf);
- sub new {
- my ($class, %opt) = @_;
- bless \%opt, $class;
- }
- sub sub_n {
- my $n = 0;
- sub {
- $_[0] - ++$n;
- };
- }
- sub add_n {
- my $n = 0;
- sub {
- $_[0] + ++$n;
- };
- }
- sub mul_n {
- my $n = 1;
- sub {
- $_[0] * ++$n;
- };
- }
- sub div_n {
- my $n = 1;
- sub {
- $_[0] / ++$n;
- };
- }
- sub sub_constant {
- my (undef, $c) = @_;
- sub {
- $_[0] - $c;
- };
- }
- sub div_constant {
- my (undef, $c) = @_;
- sub {
- $_[0] / $c;
- };
- }
- sub add_constant {
- my (undef, $c) = @_;
- sub {
- $_[0] + $c;
- };
- }
- sub add_all {
- my $sum = 0;
- sub {
- $sum += $_[0];
- $sum;
- };
- }
- sub mul_all {
- my $prod = 1;
- sub {
- $prod *= $_[0];
- $prod;
- };
- }
- sub sub_consecutive {
- my $prev;
- sub {
- my ($term) = @_;
- if (defined($prev)) {
- $term = $term - $prev;
- }
- $prev = $_[0];
- $term;
- };
- }
- sub add_consecutive {
- my $prev;
- sub {
- my ($term) = @_;
- if (defined($prev)) {
- $term = $term + $prev;
- }
- $prev = $_[0];
- $term;
- };
- }
- sub div_consecutive {
- my $prev;
- sub {
- my ($term) = @_;
- if (defined($prev)) {
- $term = $term / $prev;
- }
- $prev = $_[0];
- $term;
- };
- }
- sub find_closed_form {
- my ($self, $seq) = @_;
- my %data = (
- diff_min => Inf,
- diff_max => -Inf,
- diff_avg => 0,
- ratio_min => Inf,
- ratio_max => -Inf,
- ratio_avg => 0,
- min => Inf,
- max => -Inf,
- );
- my $count = @$seq - 1;
- return if $count <= 0;
- my $prev;
- foreach my $term (@{$seq}) {
- if ($term < $data{min}) {
- $data{min} = $term;
- }
- if ($term > $data{max}) {
- $data{max} = $term;
- }
- if (defined $prev) {
- my $diff = $term - $prev;
- if ($diff < $data{diff_min}) {
- $data{diff_min} = $diff;
- }
- if ($diff > $data{diff_max}) {
- $data{diff_max} = $diff;
- }
- $data{diff_avg} += $diff / $count;
- my $ratio = $term / $prev;
- if ($ratio < $data{ratio_min}) {
- $data{ratio_min} = $ratio;
- }
- if ($ratio > $data{ratio_max}) {
- $data{ratio_max} = $ratio;
- }
- $data{ratio_avg} += $ratio;
- }
- $prev = $term;
- }
- $data{ratio_avg} /= $count;
- my @closed_forms;
- if ($data{diff_avg} == $data{diff_max} and $data{diff_max} == $data{diff_min}) {
- my $min = ($data{min} - $data{diff_min})->round(-20);
- push @closed_forms,
- scalar {
- factor => $data{diff_min},
- offset => $min,
- type => 'arithmetic',
- };
- }
- if ($data{ratio_avg} == $data{ratio_max} and $data{ratio_max} == $data{ratio_min}) {
- my $factor = $data{min} / $data{ratio_min};
- push @closed_forms,
- scalar {
- factor => $factor,
- base => $data{ratio_min},
- type => 'geometric',
- };
- }
- #foreach my $key (sort keys %data) {
- # printf("%9s => %s\n", $key, $data{$key});
- #}
- #print "\n";
- return @closed_forms;
- }
- }
- use Math::AnyNum;
- use List::Util qw(first);
- my $seq = Sequence::ClosedForm->new();
- my @constants = (1 .. 5); #, #exp(1), atan2(0, -'inf'));
- my @rules = (
- #['sub_consecutive', 'add_n'], # 'add_n'],
- #['add_constant', 'sub_consecutive'],
- ['sub_constant', 'sub_consecutive'],
- ['sub_constant', 'div_constant'],
- ['sub_constant'],
- #['add_constant', 'div_consecutive'],
- ['sub_constant', 'add_n',],
- ['sub_constant', 'div_consecutive', 'sub_constant'],
- #['sub_constant'],
- #['sub_constant', 'div_consecutive',],
- ['sub_constant', 'div_consecutive'],
- #['div_consecutive', 'sub_constant'],
- # ['sub_constant', 'sub_consecutive'],
- #['sub_constant'],
- #['add_n', 'div_consecutive',],
- #['div_consecutive',],
- );
- sub make_constant_obj {
- my ($method) = @_;
- my %cache;
- my %state = (
- i => 0,
- done => 0,
- code => sub {
- my ($self, $n) = @_;
- my $i = $self->{i} - 1;
- my $sub = ($cache{$i} //= $seq->$method($constants[$i]));
- $sub->($n);
- }
- );
- bless \%state, 'Sequence::Constant';
- }
- sub generate_actions {
- map { /_constant\z/ ? [$_, make_constant_obj($_)] : [$_, $seq->$_] } @_;
- }
- my @numbers = (map { Math::AnyNum->new($_) } 1 .. 9);
- #my @seq = map { 3**$_ + 2} @numbers;
- #my @seq = map { 3 * $_ } @numbers;
- #my @seq = map { $_ * ($_ + 1) / 2 + 1 } @numbers;
- my @seq = map { $_->factorial + 2 } @numbers;
- say "\nseq: @seq\n";
- my %closed_forms = (
- sub_consecutive => sub {
- my ($n, $data) = @_;
- #"($data->{factor}*$n + $data->{offset})*($data->{factor}*$n + $data->{offset} + 1)/2";
- #"($n * ($n+1) / 2)";
- $data->{type} eq 'arithmetic'
- ? "($n * ($n+1) / 2)"
- : "($data->{base}**$n)";
- },
- add_n => sub {
- my ($n, $data) = @_;
- #"(2 * ($n) / $data->{factor})";
- #"($n / (2 * $data->{factor}))";
- #"($n - 1)";
- "($n * " . ($data->{factor} - 1) . " / $data->{factor})";
- },
- div_consecutive => sub {
- my ($n) = @_;
- "($n!)";
- },
- add_constant => sub {
- my ($n, $data, $const) = @_;
- $data->{type} eq 'arithmetic'
- ? "($data->{factor}*($n-$constants[$const->{i}-1+$data->{offset}]))"
- : die "geometric sequences are not supported, yet!"; # TODO: implement it
- },
- sub_constant => sub {
- my ($n, $data, $const) = @_;
- $data->{type} eq 'arithmetic'
- ? "($data->{factor}*($n+$constants[$const->{i}-1]+$data->{offset}))"
- : "($constants[$const->{i}-1] + $n)"; # wrong
- },
- div_constant => sub {
- my ($n, $data, $const) = @_;
- $data->{type} eq 'geometric'
- ? "($constants[$const->{i}-1] * $data->{factor} * $data->{base}**$n)"
- : "($data->{factor} * $n)"; # wrong
- },
- );
- sub fill_closed_form {
- my ($cf, $actions) = @_;
- my $result = 'n';
- foreach my $action (reverse @$actions) {
- my ($name, $obj) = @$action;
- #$report .= "name: $name" . (ref($obj) eq 'Sequence::Constant' ? (' (' . $constants[$obj->{i}-1] . ')') : '') . "\n";
- if (not exists($closed_forms{$name})) {
- warn "No closed-form for rule: $name\n";
- next;
- }
- $result = $closed_forms{$name}($result, $cf, $obj);
- }
- $result;
- #"$result / $cf->{factor} + $cf->{offset}";
- }
- say '-' x 80;
- my %seen;
- RULE: foreach my $rule (@rules) {
- my @actions = generate_actions(@$rule);
- my @const_pos = grep { $rule->[$_] =~ /_constant\z/ } 0 .. $#{$rule};
- my $has_const = !!@const_pos;
- WHILE: while (1) {
- foreach my $group (grep { $_->[0] !~ /_constant\z/ } @actions) {
- my $method = $group->[0];
- $group->[1] = $seq->$method;
- }
- my @sequence;
- my $stop = $has_const;
- foreach my $pos (@const_pos) {
- my $constant = $actions[$pos][1];
- if ($constant->{done}) {
- if ($constant->{i} >= $#constants) {
- $constant->{i} = 0;
- }
- else {
- $constant->{i}++;
- }
- }
- else {
- if ($constant->{i} >= $#constants) {
- $constant->{i} = 0;
- $constant->{done} = 1;
- }
- else {
- $constant->{i}++;
- }
- $stop = 0;
- last;
- }
- }
- last if $stop;
- foreach my $term (@seq) {
- my $result = $term;
- foreach my $group (@actions) {
- my $action = $group->[1];
- if (ref($action) eq 'Sequence::Constant') {
- $result = $action->{code}($action, $result);
- }
- else {
- $result = $action->($result);
- }
- }
- next WHILE if ($result <= 0 or not $result->is_real);
- push @sequence, $result;
- }
- if ($sequence[0] >= $sequence[1]) {
- $has_const || last;
- next;
- }
- next if $seen{join(';', map { $_->as_rat } @sequence)}++;
- say "try: @sequence";
- my @closed_forms = $seq->find_closed_form(\@sequence);
- if (@closed_forms) {
- say "new: @sequence\n";
- foreach my $cf (@closed_forms) {
- if ($cf->{type} eq 'geometric') {
- say "type: $cf->{type}";
- say "base: $cf->{base}";
- say "fact: $cf->{factor}";
- }
- elsif ($cf->{type} eq 'arithmetic') {
- say "type: $cf->{type}";
- say "fact: $cf->{factor}";
- say "offs: $cf->{offset}";
- }
- foreach my $action (@actions) {
- my ($name, $obj) = @$action;
- say "name: $name" . (ref($obj) eq 'Sequence::Constant' ? " (constant: $constants[$obj->{i}-1])" : '');
- }
- my $filled = fill_closed_form($cf, \@actions);
- say "\n=> Possible closed-form: $filled";
- }
- say '-' x 80;
- }
- $has_const || last;
- }
- }
|