Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

table of values

by dnamonk (Acolyte)
on Nov 29, 2021 at 03:47 UTC ( [id://11139200]=perlquestion: print w/replies, xml ) Need Help??

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

Dear Monks, I was thinking to create a random string generator and then count the occurrence of characters and checking the differences in each word.

Here is my code so far:

#!/bin/bash/perl @tests; for($i=0; $i-4; $i++){ my @char = ('M','A','N','O'); my $len = 6; my $string1; my $string2; while($len--){ $string1 .= $char[rand @char]; $string2 .= $char[rand @ +char];}; print "$string1\t$string2\n"; $string = $string1.' '.$string2; push(@tests, $string); }

Replies are listed 'Best First'.
Re: 10 x 10 table of values
by talexb (Chancellor) on Nov 29, 2021 at 04:50 UTC

    There seems to be a problem with the output -- since a comparison of two words should produce a single result, regardless of the word order, the results should be identical along the diagonal axis -- yet DOG/COT has values of 1 and 2; the correct value is 2. All that to say that you could get away with a triangular presentation of the results.

    Alex / talexb / Toronto

    Thanks PJ. We owe you so much. Groklaw -- RIP -- 2003 to 2013.

Re: 10 x 10 table of values
by AnomalousMonk (Archbishop) on Nov 29, 2021 at 05:32 UTC

    Maybe something along the lines of:

    c:\@Work\Perl>perl -wMstrict -e "my @strings = qw(DOG COT BAL MAN); ;; use constant FMT => '%6s'; ;; printf FMT, $_ for '', @strings; print qq{\n}; ;; for my $row (@strings) { printf FMT, $row; for my $col (@strings) { my $d = diff($row, $col); printf FMT, $d; } print qq{\n}; } ;; sub diff { return scalar ($_[0] ^ $_[1]) =~ tr/\0//c; } " DOG COT BAL MAN DOG 0 2 3 3 COT 2 0 3 3 BAL 3 3 0 2 MAN 3 3 2 0

    Update: In the
        sub diff { return scalar ($_[0] ^ $_[1]) =~ tr/\0//c; }
    function definition, the scalar call is not needed, but does no harm. (Assignment to a scalar imposes scalar context.)


    Give a man a fish:  <%-{-{-{-<

      Thanks. that looks great. However, how do I control if I want to allow 0 and only >=3 mismatches for randomly generated strings in the 10 x 10 table? That's actually where I am struggling.

        I assume davido's solution++ has satisfied your needs.


        Give a man a fish:  <%-{-{-{-<

Re: 10 x 10 table of values
by talexb (Chancellor) on Nov 29, 2021 at 17:44 UTC

    You've updated your node and replaced the original three letter words with five letter words. Don't do that -- partly because it means replies made before the change no longer make sense.

    If you're going to make changes, make it in a reply to one of the replies -- or at the very least, add it to the end of your post, and mark it clearly as an update.

    Alex / talexb / Toronto

    Thanks PJ. We owe you so much. Groklaw -- RIP -- 2003 to 2013.

      Okay noted. Thanks
Re: 10 x 10 table of values
by tybalt89 (Monsignor) on Nov 29, 2021 at 18:19 UTC
    #!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11139200 use warnings; use List::Util qw( none ); $| = 1; my @strings; while( @strings < 10 ) { my $try = join '', map +('A' .. 'Z')[rand 26], 1 .. 5; if( none { ($try ^ $_) =~ tr/\0//c < 3 } @strings ) { push @strings, $try; print "$try "; } } print "\n";

    Sample Output

    OJLGF RESJW YKHXZ CGINN RMVRS NBVJA PKZFG DHBNR JMXML QFAUY
      Great solution. Thanks a lot :) One question. Why is the program freezing? The program gets stuck at 30 output if I want to let's say 70-99 instead of just 10.

        What letters are you using? I changed the program to just use five letters only from ACGT (you mentioned biology) and it can't find 100 (it times out). There may not be that many strings that are that mutually different.

        Please show the code you are running that hangs.

Re: 10 x 10 table of values
by davido (Cardinal) on Nov 29, 2021 at 17:22 UTC

    I'm just curious, do you need the table, or do you need the list of those string pairs that have three or more differences? Of what significance is the 10x10 table? Really just satisfying my curiosity.


    Dave

      Just a list should be enough. No need to plot the table. It is related to some biological experiment.

        #!/usr/bin/env perl use strict; use warnings; use Algorithm::Loops qw(NestedLoops); use Text::Levenshtein::XS qw(distance); my @chars = qw(A M N U); my $depth = 5; # We're taking "five at a time" from A, M, N, U. my $min_dist = 3; # We need a minimum difference of 3 characters. my @strings; NestedLoops( [ ([@chars]) x $depth ], sub { push @strings, join('', @_) }, ); my $count = 0; foreach my $left (@strings) { foreach my $right (@strings) { if (distance($left, $right) >= $min_dist) { print ++$count, ": $left <=> $right\n"; } } } print "\n$count pairs with minimum difference of $min_dist from a set +of ", scalar(@chars), " characters taken $depth at a time.\n";

        Algorithm::Loops and Text::Levenshtein make it easy to generate the list of hits.

        Output:

        1: AAAAA <=> AAMMM 2: AAAAA <=> AAMMN 3: AAAAA <=> AAMMU 4: AAAAA <=> AAMNM 5: AAAAA <=> AAMNN .... # many lines deleted 917168: UUUUU <=> UUNMM 917169: UUUUU <=> UUNMN 917170: UUUUU <=> UUNNA 917171: UUUUU <=> UUNNM 917172: UUUUU <=> UUNNN 917172 pairs with minimum difference of 3 from a set of 4 characters t +aken 5 at a time.

        Dave

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11139200]
Approved by talexb
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others musing on the Monastery: (8)
As of 2024-03-28 10:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found