Re: list of four digit lock combinations without repeated digits
by BrowserUk (Patriarch) on Jun 20, 2018 at 19:24 UTC
|
Algorithm::Combinatorics is good for this (though it sometimes takes trial and error to work out which of it algorithms you need), and it generates these kinds of patterns very efficiently:
#! perl -slw
use strict;
use Algorithm::Combinatorics qw[:all];
my $iter = combinations( [0..9], 4 );
print "@$_" while $_ = $iter->next;
__END__
C:\test>4of10Combinations.pl | wc -l
210
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
In the absence of evidence, opinion is indistinguishable from prejudice.
Suck that fhit
| [reply] [d/l] |
|
> it generates these kinds of patterns very efficiently
I tried Algorithm::Combinatorics for a similar task. Both of these examples generate an array of strings n characters in length of all combinations of letters (e.g. 4 = 'aaaa'..'zzzz').
Am I doing something stupid with the module, or perl?
Perl string iteration:
real 0m0.129s
time perl -wle '
$n = shift; die "need a number" unless $n and $n =~ /^\d+$/;
$a = "a" x $n; $c = 0; $e = 26**$n;
while () { push @x, $a; $a++ and $c++; last if $c == $e }
print scalar @x' 4
Using Algorithm::Combinatorics:
real 0m0.858s
time perl -MAlgorithm::Combinatorics=:all -wle '
$n = shift; die "need a number" unless $n and $n =~ /^\d+$/;
@_ = ("a".."z"); $i = variations_with_repetition(\@_,$n);
while ($c = $i->next){
for (@$c) { $x .= $_ }
push @x, $x; undef $x }
print scalar @x' 4
Be careful with the parameter because this can make a very big array.
4 is only ~2MB but 5 is 70MB and the 6 character array is around 2000MB.
| [reply] [d/l] [select] |
|
perl -MAlgorithm::Combinatorics=:all -wle'my $i=variations_with_repeti
+tion(["a".."z"],$ARGV[0]); my @x; push @x, qq[@$_] while $_=$i->next;
+ print scalar @x' 4
In general, those algorithms that require more selection than variations_with_repetition() -- almost any of the other algorithms -- is where A;:C shines over a pure perl implementation.
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
In the absence of evidence, opinion is indistinguishable from prejudice.
Suck that fhit
| [reply] [d/l] [select] |
|
|
|
|
| [reply] |
Re: list of four digit lock combinations without repeated digits -- tartaglia
by Discipulus (Canon) on Jun 20, 2018 at 21:04 UTC
|
Hello Lotus1
> anyone else has interesting solutions
Yes! go to mine tartaglia triangle repository, download the program, run it, choose the combinations experiment and feed 10 4 and you'll see coulored solutions in the triangle and the following output:
*** Combinations of 4 items in a group of 10
There are 210 (red tile position 10 - 4) different combinations (whe
+n the order does not matter) of 4 items in a group of 10.
There are 715 (green tile) different combinations with repetitions o
+f 4 items in group of 10.
More informations are provided upon request:
This is called combination (or k-combination) in mathematic, id est no
+ matter of the order of the elements and no repetition of elements.
The formula is the binomial coefiicent one.
n!
C(n,k) = ----------
k!(n-k)!
PS The following ugly oneliner to print all 5040 permutations
perl -E "say @$_ for grep{$$_[0]!=$$_[1] and $$_[0]!=$$_[2] and $$_[0]
+!=$$_[3] and $$_[1]!=$$_[2]
and $$_[1]!=$$_[3] and $$_[2]!=$$_[3]} map { [split '',sprintf '%04s'
+,$_]} 0..9999;"
PPS cannabalizing the below elegant solution by johngg I got a better solution:
perl -e "print qq($_ ) for grep { ! m{(.).*\1} }map{sprintf '%04s',$_}0..9999"
L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
| [reply] [d/l] [select] |
|
I ran your Tartaglia project and tried some of the experiments. It is a very nice application with nice graphics. I know the triangle as Pascal's triangle and have used it for binomial expansion but I didn't know about (or I've forgotten some of) the other uses. Thanks for sharing this.
Your Perl code seems to be the same regex approach I used to eliminate duplicate digits. This by itself produces permutations. To get the 210 combinations add the split, sort and store in a hash.
| [reply] |
Re: list of four digit lock combinations without repeated digits
by johngg (Canon) on Jun 20, 2018 at 22:06 UTC
|
A solution using glob to generate the 4-digit numbers, split, sort and join to get only ascending values then grep and a regex to sift out repeating digits. A hash is populated so that any duplicate values go into the same key/value pair and are therefore masked. Finally print the sorted values.
johngg@abouriou ~/perl/Monks $ perl -Mstrict -Mwarnings -E '
my $digs = q{0,1,2,3,4,5,6,7,8,9};
my $globStr = qq|{$digs}| x 4;
my %combs =
map { $_ => 1 }
grep { ! m{(.).*\1} }
map { join q{}, sort split m{} }
glob $globStr;
say for sort keys %combs;' | wc -l
210
I hope this is of interest.
Update: Can be shortened by acting directly on an anonymous hash but there's a warning unless you silence it (which, sadly, makes it not so short again).
johngg@abouriou ~/perl/Monks $ perl -Mstrict -Mwarnings -E '
my $digs = q{0,1,2,3,4,5,6,7,8,9};
my $globStr = qq|{$digs}| x 4;
say for do {
no warnings qw{ experimental::autoderef };
sort keys {
map { $_ => 1 }
grep { ! m{(.).*\1} }
map { join q{}, sort split m{} }
glob $globStr };
};' | wc -l
210
| [reply] [d/l] [select] |
|
use warnings;
use strict;
my $digit_pattern = '{0,1,2,3,4,5,6,7,8,9}' x 4;
print "$_\n" foreach glob $digit_pattern;
When I saw your solution I realized I didn't need to test for the key existence in the hash. I could simply assign to the key. Thanks again.
Edit:
sort keys {
map { $_ => 1 }
grep { ! m{(.).*\1} }
map { join q{}, sort split m{} }
glob $globStr };
I forgot to mention before an optimization I noticed: if there is a repeated digit in the number then there's no need to split and sort it. If you put the grep line after the map, join, sort, split line then it will filter out the repeats before the split(). The split, sort and assign to a hash approach is the exact same one that I took but mine were inside a foreach loop instead of in a map (loop). | [reply] [d/l] [select] |
Re: list of four digit lock combinations without repeated digits
by tybalt89 (Monsignor) on Jun 20, 2018 at 20:18 UTC
|
#!/usr/bin/perl
# https://perlmonks.org/?node_id=1217042
use strict;
use warnings;
(1 x 10) =~ /.+?(.).*?(.).*?(.)(?{print @-, "\n"})(*FAIL)/;
| [reply] [d/l] |
|
| [reply] [d/l] [select] |
|
#!/usr/bin/perl
# https://perlmonks.org/?node_id=1217042
use strict;
use warnings;
'0123456789' =~ /(.).*?(.).*?(.).*?(.)(?{print "$1$2$3$4\n"})(*FAIL)/;
| [reply] [d/l] |
Re: list of four digit lock combinations without repeated digits
by choroba (Cardinal) on Jun 20, 2018 at 21:58 UTC
|
#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
use Math::Combinatorics;
my $count = 0;
my $comb = 'Math::Combinatorics'->new(count => 4, data => [ 0 .. 9 ]);
++$count, say @$_ while @$_ = $comb->next_combination;
say $count;
($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
| [reply] [d/l] [select] |
Re: list of four digit lock combinations without repeated digits
by johngg (Canon) on Jun 22, 2018 at 16:22 UTC
|
Here are a couple of nested loop solutions that are probably what the *::Combinatorics modules do under the hood.
johngg@abouriou ~/perl/Monks $ perl -Mstrict -Mwarnings -E '
for my $w ( 0 .. 6 )
{
for my $x ( $w + 1 .. 7 )
{
for my $y ( $x + 1 .. 8 )
{
for my $z ( $y + 1 .. 9 )
{
say join q{}, $w, $x, $y, $z;
}
}
}
}' | wc -l
210
johngg@abouriou ~/perl/Monks $ perl -Mstrict -Mwarnings -E '
say for
map {
my $w = $_;
my $x = $w + 1;
map {
my $y = $_ + 1;
map {
my $z = $_ + 1;
map {
join q{}, $w, $x, $y, $z
} $z .. 9
} $y .. 8
} $x .. 7
} 0 .. 6;' | wc -l
210
Done just for fun, the modules are probably the best way to go.
Update: Ignore the map version as it is giving incorrect results, right number but wrong digits.
Update 2: Spotted my error in the map version, I was initialising the three inner variables too early. This works:-
johngg@abouriou ~/perl/Monks $ perl -Mstrict -Mwarnings -E '
say for
map {
my $w = $_;
map {
my $x = $_;
map {
my $y = $_;
map {
my $z = $_;
join q{}, $w, $x, $y, $z;
} ( $y + 1 ) .. 9
} ( $x + 1 ) .. 8
} ( $w + 1 ) .. 7
} 0 .. 6;' | wc -l
210
| [reply] [d/l] [select] |
A reply falls below the community's threshold of quality. You may see it by logging in. |