diff options
| author | Adam Russell <ac.russell@live.com> | 2024-03-16 20:43:18 -0400 |
|---|---|---|
| committer | Adam Russell <ac.russell@live.com> | 2024-03-16 20:43:18 -0400 |
| commit | 7be4d35fb8b6c00d67e99390206ec30aaa1fe1f3 (patch) | |
| tree | f6e2ce7761c0be8f90a4351f06467de8cdfa8889 | |
| parent | 8d8f9f052114a2b03b2b652a70ef4e75428f8239 (diff) | |
| download | perlweeklychallenge-club-7be4d35fb8b6c00d67e99390206ec30aaa1fe1f3.tar.gz perlweeklychallenge-club-7be4d35fb8b6c00d67e99390206ec30aaa1fe1f3.tar.bz2 perlweeklychallenge-club-7be4d35fb8b6c00d67e99390206ec30aaa1fe1f3.zip | |
initial commit
| -rw-r--r-- | challenge-260/adam-russell/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-260/adam-russell/perl/ch-1.pl | 23 | ||||
| -rw-r--r-- | challenge-260/adam-russell/perl/ch-2.pl | 46 |
3 files changed, 70 insertions, 0 deletions
diff --git a/challenge-260/adam-russell/blog.txt b/challenge-260/adam-russell/blog.txt new file mode 100644 index 0000000000..e8920bea37 --- /dev/null +++ b/challenge-260/adam-russell/blog.txt @@ -0,0 +1 @@ +http://www.rabbitfarm.com/cgi-bin/blosxom/perl/2024/03/16
\ No newline at end of file diff --git a/challenge-260/adam-russell/perl/ch-1.pl b/challenge-260/adam-russell/perl/ch-1.pl new file mode 100644 index 0000000000..a09cbd1695 --- /dev/null +++ b/challenge-260/adam-russell/perl/ch-1.pl @@ -0,0 +1,23 @@ + + +use v5.38; +use boolean; + + +sub unique_occurrences{ + my %occurrences; + do{ + $occurrences{$_}++; + } for @_; + my %h; + do{$h{$_} = undef} for values %occurrences; + return boolean(values %occurrences == keys %h); +} + + +MAIN:{ + say unique_occurrences 1, 2, 2, 1, 1, 3; + say unique_occurrences 1, 2, 3; + say unique_occurrences -2, 0, 1, -2, 1, 1, 0, 1, -2, 9; +} + diff --git a/challenge-260/adam-russell/perl/ch-2.pl b/challenge-260/adam-russell/perl/ch-2.pl new file mode 100644 index 0000000000..00a597feda --- /dev/null +++ b/challenge-260/adam-russell/perl/ch-2.pl @@ -0,0 +1,46 @@ + + +use v5.38; +use boolean; + + +sub permutations{ + my($a, $k, $permutations) = @_; + if($k == 1){ + push @{$permutations}, [@{$a}]; + return true; + } + else{ + permutations($a, $k - 1, $permutations); + for my $i (0 .. $k - 2){ + if($k & 1){ + ($a->[0], $a->[$k - 1]) = ($a->[$k - 1], $a->[0]); + } + else{ + ($a->[$i], $a->[$k - 1]) = ($a->[$k - 1], $a->[$i]); + } + permutations($a, $k - 1, $permutations); + } + } +} + + +sub dictionary_rank{ + my($word) = @_; + my $permutations = []; + permutations [split //, $word], length($word), $permutations; + my %h; + do {$h{join q//, @{$_}} = undef} for @{$permutations}; + my @permutations = sort {$a cmp $b} keys %h; + return ( + grep {$permutations[$_] eq $word} 0 .. @permutations - 1 + )[0] + 1; +} + + +MAIN:{ + say dictionary_rank q/CAT/; + say dictionary_rank q/GOOGLE/; + say dictionary_rank q/SECRET/; +} + |
