Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

list of four digit lock combinations without repeated digits

by Lotus1 (Vicar)
on Jun 20, 2018 at 18:58 UTC ( #1217042=perlquestion: print w/replies, xml ) Need Help??

Lotus1 has asked for the wisdom of the Perl Monks concerning the following question:

I have a spare key lock for my front door that takes four digits without repeated digits and the order doesn't matter. I've forgotten the combination so I wrote a script to give me a list of the possible combinations. I'm planning to replace this since I don't like that it only has 210 possible combinations but I have to open it before I can remove it. Here is my solution. I found the text at the top in one of the answers at https://math.stackexchange.com/questions/156928/number-of-4-digit-numbers-with-no-repeated-digit.

I'm wondering if there is a way to do this with some modules or if anyone else has interesting solutions.

use strict; use warnings; # Four digit mechanical lock: no repeated digits, order doesn't matter +. # #https://math.stackexchange.com/questions/156928/number-of-4-digit-num +bers-with-no-repeated-digit # Start by finding the permutations: For the first choice, you have 10 + possible digits to choose from. #For the second choice, you have 9 digits because you used one for the + first choice. #The third choice comes from 8 possibilities and the fourth from 7 pos +sibilities. #Now we multiply these together: 10 x 9 x 8 x 7 = 90 x 56 = 5040. That +'s the number of permutations. #No digits repeat, but 0123 is different from 0321. # Now to find the number of combinations, I have to know how many diff +erent ways there are of arranging four digits. #That's the same kind of problem: the first position could be from 4 p +ossibilities, the second from 3 possiblities, #the third from 2 choices and the last has to be the 1 left. So there +are 4 x 3 x 2 x 1 = 24 possible ways of #arranging 4 items. # Therefore I divide 5040 / 24 = 210. So there are 210 different combi +nations of four digits chosen #from 0-9 where the digits don't repeat. my %output; foreach(123..9876){ my $num = sprintf "%04d", $_; next if $num =~ /(\d).*\1/; my @digits = sort split //, $num; my $num_sorted = join '', @digits; #print "$num: @digits - $num_sorted\n"; if (not exists $output{$num_sorted} ) { #print "adding $num_sorted\n"; $output{$num_sorted}=1; } } print "found ", scalar keys %output, " combinations.\n"; print "$_\n" foreach sort keys %output;

Here are the results:

found 210 combinations. 0123 0124 0125 0126 0127 0128 0129 0134 0135 0136 0137 0138 0139 0145 0146 0147 0148 0149 0156 0157 0158 0159 0167 0168 0169 0178 0179 0189 0234 0235 0236 0237 0238 0239 0245 0246 0247 0248 0249 0256 0257 0258 0259 0267 0268 0269 0278 0279 0289 0345 0346 0347 0348 0349 0356 0357 0358 0359 0367 0368 0369 0378 0379 0389 0456 0457 0458 0459 0467 0468 0469 0478 0479 0489 0567 0568 0569 0578 0579 0589 0678 0679 0689 0789 1234 1235 1236 1237 1238 1239 1245 1246 1247 1248 1249 1256 1257 1258 1259 1267 1268 1269 1278 1279 1289 1345 1346 1347 1348 1349 1356 1357 1358 1359 1367 1368 1369 1378 1379 1389 1456 1457 1458 1459 1467 1468 1469 1478 1479 1489 1567 1568 1569 1578 1579 1589 1678 1679 1689 1789 2345 2346 2347 2348 2349 2356 2357 2358 2359 2367 2368 2369 2378 2379 2389 2456 2457 2458 2459 2467 2468 2469 2478 2479 2489 2567 2568 2569 2578 2579 2589 2678 2679 2689 2789 3456 3457 3458 3459 3467 3468 3469 3478 3479 3489 3567 3568 3569 3578 3579 3589 3678 3679 3689 3789 4567 4568 4569 4578 4579 4589 4678 4679 4689 4789 5678 5679 5689 5789 6789

Edit:After posting I realized I remembered one of the digits which narrowed the list down by a lot. My $spouse remembered the code before I started trying but the lock would have been opened within my first few attempts from the list.

Replies are listed 'Best First'.
Re: list of four digit lock combinations without repeated digits
by BrowserUk (Pope) 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.
    "Science is about questioning the status quo. Questioning authority". The enemy of (IT) success is complexity.
    In the absence of evidence, opinion is indistinguishable from prejudice. Suck that fhit
      > 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.
        Am I doing something stupid with the module, or perl?
        1. This: for(@$c){ $x .= $_ } is a really slow way to build a string from an array.
        2. Package variables are slower than lexicals.
        3. Postfix loops generally run more quickly than those with scoped bodies.

        Try this and see how it compares on your system:

        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.
        "Science is about questioning the status quo. Questioning authority". The enemy of (IT) success is complexity.
        In the absence of evidence, opinion is indistinguishable from prejudice. Suck that fhit

      Wow! That is great. Thanks

Re: list of four digit lock combinations without repeated digits -- tartaglia
by Discipulus (Abbot) 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.

      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.

Re: list of four digit lock combinations without repeated digits
by tybalt89 (Parson) 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)/;

      I did ask for interesting solutions. It's going to take me a while to understand how this works. I found in perlvar a description of @- as being an array of the indexes of the matches. Thanks for posting.

      @- $-[0] is the offset of the start of the last successful match. $-[n] i +s the offset of the start of the substring matched by n-th subpattern +, or undef if the subpattern did not match. Thus, after a match against $_ , $& coincides with substr $_, $-[0], $ ++[0] - $-[0] . Similarly, $n coincides with substr $_, $-[n], $+[n] - + $-[n] if $-[n] is defined, and $+ coincides with substr $_, $-[$#-], + $+[$#-] - $-[$#-] . One can use $#- to find the last matched subgrou +p in the last successful match. Contrast with $#+ , the number of sub +groups in the regular expression. Compare with @+ . This array holds the offsets of the beginnings of the last successful +submatches in the currently active dynamic scope. $-[0] is the offset + into the string of the beginning of the entire match. The nth elemen +t of this array holds the offset of the nth submatch, so $-[1] is the + offset where $1 begins, $-[2] the offset where $2 begins, and so on.

        Here's another version without the @-

        Just match any four of the digits (from an ordered string).

        #!/usr/bin/perl # https://perlmonks.org/?node_id=1217042 use strict; use warnings; '0123456789' =~ /(.).*?(.).*?(.).*?(.)(?{print "$1$2$3$4\n"})(*FAIL)/;
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

    Cheers,

    JohnGG

      I tried out your glob approach at number generation to understand it. Thanks for posting. I'm always trying to learn more about the usage of glob(). I found I could simplify your $globStr declaration like this:

      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).

Re: list of four digit lock combinations without repeated digits
by choroba (Bishop) on Jun 20, 2018 at 21:58 UTC
    Another possibility is to use Math::Combinatorics:
    #! /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,
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

    Cheers,

    JohnGG

    A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1217042]
Approved by BrowserUk
Front-paged by haukex
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (12)
As of 2019-10-21 10:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?