may i know how to ( in Perl ) ,
generate below All Possible Patterns in a file and on screen output , and each slot in the pattern can be accessed , ?!
many thanks for all ,
input value ,
1 , no. of slots ,
2 , no. of objects ,
for example ,
no. of object = 2 , { a , b } ,
no. of slots = 4 ,
then , output ,
no. of all possible patterns = 2^4 = 16 ,
then ,
row is 16 ,
column is 8 ,
eachSlot[i][j] = allow assign or change its value ,
then , output format look like ,
a a a a
a a a b
a a b a
a a b b
a b a a
a b a b
a b b a
a b b b
b a a a
b a a b
b a b a
b a b b
b b a a
b b a b
b b b a
b b b b
and ,
if see 'a' , then do sth actionX ,
if see 'b' , then do sth actionY ,
many thanks for all the advices and helps ,
use Algorithm::Loops qw( NestedLoops );
my #syms = qw( a b );
my $num_slots = 4;
my $iter = NestedLoops([ ( \#syms ) x $num_slots ]);
while ( my #items = $iter->() ) {
say "#items";
}
I made Set::CrossProduct:
use v5.10;
use Set::CrossProduct;
my $set = Set::CrossProduct->new( [ [ qw(a b) ] x 4 ] );
while( my $next = $set->get ) {
say "#$next";
}
ikegami showed the Algorithm::Loops module, which is also fine to get all the combinations.
Related
What is the best way to write a condition in drools CEP to infer ( A after max time B )
Example :
a : new A();
b : new B( this after [1m] )
The above example is not my need.
I need this :
a : new A();
b : new B( this after a , b.timestamp - a.timestamp <= 60000)
So i reformulate the question. Is another way to obtain the same result with less instructions ?
Thanks
Edit after clarification of Q
$a: A()
$b: B( this after[ 0s, 60s ] $a )
This fires if B comes after A but not later than 60 seconds.
I am trying to write a macro which enables me to transform
(a, b, c, d) to (a, a + b, a + b + c, a + b + c + d), etc. Here is what I have got so far:
macro_rules! pascal_next {
($x: expr) => ($x);
($x: expr, $y: expr) => (
($x, $x + $y)
);
($x: expr, $y: expr, $($rest: expr),+) => (
($x, pascal_next!(
$x + $y, $($rest),+
)
)
);
}
However, there is a problem that it would actually output (a, (a + b, (a + b + c, a + b + c +d))). The origin is that the second matching rule ($x: expr, $y: expr) => (($x, $x + $y));, produces an extra bracket, so that there would be nested brackets. If I don't put a bracket outside, I would get the error error:
unexpected token: ,
So is it possible to output a comma , in Rust macros?
No; the result of a macro must be a complete grammar construct like an expression or an item. You absolutely cannot have random bits of syntax like a comma or a closing brace.
You can get around this by simply not outputting anything until you have a complete, final expression. Behold!
#![feature(trace_macros)]
macro_rules! pascal_impl {
/*
The input to this macro takes the following form:
```ignore
(
// The current output accumulator.
($($out:tt)*);
// The current additive prefix.
$prefix:expr;
// The remaining, comma-terminated elements.
...
)
```
*/
/*
Termination condition: there is no input left. As
such, dump the output.
*/
(
$out:expr;
$_prefix:expr;
) => {
$out
};
/*
Otherwise, we have more to scrape!
*/
(
($($out:tt)*);
$prefix:expr;
$e:expr, $($rest:tt)*
) => {
pascal_impl!(
($($out)* $prefix+$e,);
$prefix+$e;
$($rest)*
)
};
}
macro_rules! pascal {
($($es:expr),+) => { pascal_impl!((); 0; $($es),+,) };
}
trace_macros!(true);
fn main() {
println!("{:?}", pascal!(1, 2, 3, 4));
}
Note: To use this on a stable compiler, you will need to delete the #![feature(trace_macros)] and trace_macros!(true); lines. Everything else should be fine.
What this does is it recursively munches away at the input, passing the partial (and potentially semantically invalid) output as input to the next level of recursion. This lets us build up an "open list", which we couldn't otherwise do.
Then, once we're out of input, we just re-interpret our partial output as a complete expression and... done.
The reason I including the tracing stuff is so I could show you what it looks like as it runs:
pascal! { 1 , 2 , 3 , 4 }
pascal_impl! { ( ) ; 0 ; 1 , 2 , 3 , 4 , }
pascal_impl! { ( 0 + 1 , ) ; 0 + 1 ; 2 , 3 , 4 , }
pascal_impl! { ( 0 + 1 , 0 + 1 + 2 , ) ; 0 + 1 + 2 ; 3 , 4 , }
pascal_impl! { ( 0 + 1 , 0 + 1 + 2 , 0 + 1 + 2 + 3 , ) ; 0 + 1 + 2 + 3 ; 4 , }
pascal_impl! { ( 0 + 1 , 0 + 1 + 2 , 0 + 1 + 2 + 3 , 0 + 1 + 2 + 3 + 4 , ) ; 0 + 1 + 2 + 3 + 4 ; }
And the output is:
(1, 3, 6, 10)
One thing to be aware of: large numbers of un-annotated integer literals can cause a dramatic increase in compile times. If this happens, you can solve it by simply annotating all of your integer literals (like 1i32).
Lets say i have generated some random alphabets and random numbers
A 1
Z 2
C 3
L 2
E 4
and similarly another set
1 K
4 I
2 P
5 R
6 S
7 U
Now we can find 2 is linked to Z and L in the first case and similarly 2 is linked to P in the second set
from this we can say Z and L are connected to P
so intially i have generated the first two steps. I am a little confused how to proceed with rest?
Just to recommend a wildly different approach that may be easier to think about if you are more familiar with SQL than perl, you can look into DBD::CSV. You can then accomplish what you want with a simple join statement. Just follow the example on the linked page. If you don't know SQL than you are probably better off with a hash of arrays as already posted. I'll post actual code when I get to a machine that has DBD::CSV installed...
Perhaps what you need is all the relationships like the one you have shown us?
Here is an example program which does that. Please explain if you need something different.
use strict;
use warnings;
my %data1 = qw(
A 1
Z 2
C 3
L 2
E 4
);
my %data2 = qw(
1 K
4 I
2 P
5 R
6 S
7 U
);
# Convert to arrays indexed by the numbers
#
my #data1;
push #{ $data1[$data1{$_}] }, $_ for keys %data1;
my #data2;
push #{ $data2[$_] }, $data2{$_} for keys %data2;
# Find all the mappings between the datasets
#
for my $i (0 .. $#data1) {
my $data1 = $data1[$i] or next;
my $data2 = $data2[$i] or next;
print "#$data1 => #$data2\n";
}
output
A => K
Z L => P
E => I
The Graph module can help. In fact, concepts from Graph Theory are the right way to think about these sorts of problems instead of thrashing around with hashes and arrays trying to re-solve already solved problems.
#!/usr/bin/env perl
use strict; use warnings;
use Graph::Directed;
use Set::CrossProduct;
my $g = Graph::Directed->new;
my %first = qw(A 1 Z 2 C 3 L 2 E 4);
my %second = qw(1 K 4 I 2 P 5 R 6 S 7 U);
for my $h (\ (%first, %second) ) {
$g->add_edge($_, $h->{$_}) for keys %$h;
}
print "All weakly connected components\n";
for my $wcc ( $g->weakly_connected_components ) {
print "[#$wcc]\n";
}
my $it = Set::CrossProduct->new([ [keys %first], [values %second]]);
print "Connectedness tests\n";
while (my $case = $it->get) {
my $is_connected = $g->same_weakly_connected_components(#$case);
printf(
"%s are %s in the same weakly connected component\n",
"[#$case]", $is_connected ? '' : 'not'
);
}
Output
All weakly connected components
[R 5]
[E 4 I]
[K 1 A]
[2 Z L P]
[S 6]
[7 U]
[C 3]
Connectedness tests
[Z S] are not in the same weakly connected component
[Z I] are not in the same weakly connected component
[Z K] are not in the same weakly connected component
[Z U] are not in the same weakly connected component
[Z P] are in the same weakly connected component
[Z R] are not in the same weakly connected component
[A S] are not in the same weakly connected component
[A I] are not in the same weakly connected component
[A K] are in the same weakly connected component
[A U] are not in the same weakly connected component
[A P] are not in the same weakly connected component
[A R] are not in the same weakly connected component
[C S] are not in the same weakly connected component
[C I] are not in the same weakly connected component
[C K] are not in the same weakly connected component
[C U] are not in the same weakly connected component
[C P] are not in the same weakly connected component
[C R] are not in the same weakly connected component
[E S] are not in the same weakly connected component
[E I] are in the same weakly connected component
[E K] are not in the same weakly connected component
[E U] are not in the same weakly connected component
[E P] are not in the same weakly connected component
[E R] are not in the same weakly connected component
[L S] are not in the same weakly connected component
[L I] are not in the same weakly connected component
[L K] are not in the same weakly connected component
[L U] are not in the same weakly connected component
[L P] are in the same weakly connected component
[L R] are not in the same weakly connected component
#!/usr/bin/perl -w
use strict;
use Data::Dumper;
my (#n,#s);
sub generate_random_string
{
my #chars=('a'..'z');
my $random_string;
$random_string.=$chars[rand #chars];
return $random_string;
}
print "one\n";
foreach(1..5)
{
my $range = 10;
my $random_number = int(rand($range));
push (#n,$random_number);
my $random_string=&generate_random_string;
push(#s,$random_string);
print $random_number." ".$random_string."\n";
}
my (#nn,#ss);
print "two\n";
foreach(1..6)
{
my $range = 10;
my $random_number = int(rand($range));
push (#nn,$random_number);
my $random_string=&generate_random_string;
push(#ss,$random_string);
print $random_number." ".$random_string."\n";
}
my %h1;
# prepare data
for (my $i=0;$i<=$#n;$i++)
{
$h1{$i}{'a'}=$s[$i];
$h1{$i}{'i'}=$n[$i];
}
my %h2;
for (my $i=0;$i<=$#nn;$i++)
{
$h2{$i}{'a'}=$ss[$i];
$h2{$i}{'i'}=$nn[$i];
}
# end prepare data
my %result;
foreach (keys %h2)
{
my $letter=$h2{$_}{'a'};
my $number=$h2{$_}{'i'};
my #rarr;
foreach (keys %h1)
{
if ($h1{$_}{'i'}==$number)
{
push(#rarr,$h1{$_}{'a'});
}
}
if ($#rarr>=0)
{
#{$result{$letter}}=#rarr;
}
#rarr=undef;
}
foreach (keys %result)
{
print join(',',#{$result{$_}})." connected to ".$_."\n";
}
result:
one
8 s
2 g
6 z
7 g
7 a
two
7 e
8 w
3 r
1 c
0 t
7 h
a,g connected to e
s connected to w
a,g connected to h
You may want to solve your issue using hashes of arrays. For example if you know already that Z, L and P are conncted via 2 and you have a data structure like this
my %hash_of_arrays = ( '2' => ['Z', 'L', 'P' ]);
already. and now you find out that 'Q' is also connected to '2' you would
push(#{hash_of_arrays{'2'}}, 'Q');
Other situation is when you encounter a new $key you may want to insert a new array into the hash:
my $array = []
$hash_of_arrays{$key} = $array
hope i understood you right...
You would want a hash of arrays, which will require the use of array references.
#! /usr/bin/perl -w
my #a1 = qw( 1 K 4 I 2 P 5 R K 6 S 7 U );
my %HoA1;
for ( my $i = 0; $i < scalar #a1 - 1; $i++ ) {
unless( defined $HoA1{ $a1[$i] } ) {
$HoA1{ $a1[$i] } = [];
push #{$HoA1{ $a1[$i] }}, $a1[$i+1];
} else {
push #{$HoA1{ $a1[$i] }}, $a1[$i+1];
}
}
for my $key ( sort keys %HoA1 ) {
print "$key: #{$HoA1{ $key }} \n";
}
I am considering this random string generator in perl:
sub generate_random_string {
my $length = 12;
my #chars = qw/2 3 4 5 6 7 8 9 A B C D E F G H J K M N P Q R S T U V W X Y Z/;
my $str = '';
$str .= $chars[int rand #chars] for 1..$length;
return $str;
}
How many unique strings will this generate? If I extend the length of the string, how many more unique strings are available?
Also, how do I calculate the probability of generating the same string twice (assuming the length of the string stays at 12)?
The answer is: (1/31) ^ 12
Or more generically: (1/(number of characters)) ^ length
I have data that looks like this:
my #homopol = (
["T","C","CC","G"], # part1
["T","TT","C","G","A"], #part2
["C","CCC","G"], #part3 ...upto part K=~50
);
my #prob = ([1.00,0.63,0.002,1.00,0.83],
[0.72,0.03,1.00, 0.85,1.00],
[1.00,0.97,0.02]);
# Note also that the dimension of #homopol is always exactly the same with #prob.
# Although number of elements can differ from 'part' to 'part'.
What I want to do is to
Generate all combinations of elements in part1 through out partK
Find the product of the corresponding elements in #prob.
Hence at the end we hope to get this output:
T-T-C 1 x 0.72 x 1 = 0.720
T-T-CCC 1 x 0.72 x 0.97 = 0.698
T-T-G 1 x 0.72 x 0.02 = 0.014
...
G-G-G 1 x 0.85 x 0.02 = 0.017
G-A-C 1 x 1 x 1 = 1.000
G-A-CCC 1 x 1 x 0.97 = 0.970
G-A-G 1 x 1 x 0.02 = 0.020
The problem is that the following code of mine does that by hardcoding
the loops. Since the number of parts of #homopol is can be varied and large
(e.g. ~K=50), we need a flexible and compact way to get the same result. Is there any?
I was thinking to use Algorithm::Loops, but not sure how to achieve that.
use strict;
use Data::Dumper;
use Carp;
my #homopol = (["T","C","CC","G"],
["T","TT","C","G","A"],
["C","CCC","G"]);
my #prob = ([1.00,0.63,0.002,1.00,0.83],
[0.72,0.03,1.00, 0.85,1.00],
[1.00,0.97,0.02]);
my $i_of_part1 = -1;
foreach my $base_part1 ( #{ $homopol[0] } ) {
$i_of_part1++;
my $probpart1 = $prob[0]->[$i_of_part1];
my $i_of_part2 =-1;
foreach my $base_part2 ( #{ $homopol[1] } ) {
$i_of_part2++;
my $probpart2 = $prob[1]->[$i_of_part2];
my $i_of_part3 = -1;
foreach my $base_part3 ( #{ $homopol[2] } ) {
$i_of_part3++;
my $probpart3 = $prob[2]->[$i_of_part3];
my $nstr = $base_part1."".$base_part2."".$base_part3;
my $prob_prod = sprintf("%.3f",$probpart1 * $probpart2 *$probpart3);
print "$base_part1-$base_part2-$base_part3 \t";
print "$probpart1 x $probpart2 x $probpart3 = $prob_prod\n";
}
}
}
I would recommend Set::CrossProduct, which will create an iterator to yield the cross product of all of your sets. Because it uses an iterator, it does not need to generate every combination in advance; rather, it yields each one on demand.
use strict;
use warnings;
use Set::CrossProduct;
my #homopol = (
[qw(T C CC G)],
[qw(T TT C G A)],
[qw(C CCC G)],
);
my #prob = (
[1.00,0.63,0.002,1.00],
[0.72,0.03,1.00, 0.85,1.00],
[1.00,0.97,0.02],
);
# Prepare by storing the data in a list of lists of pairs.
my #combined;
for my $i (0 .. $#homopol){
push #combined, [];
push #{$combined[-1]}, [$homopol[$i][$_], $prob[$i][$_]]
for 0 .. #{$homopol[$i]} - 1;
};
my $iterator = Set::CrossProduct->new([ #combined ]);
while( my $tuple = $iterator->get ){
my #h = map { $_->[0] } #$tuple;
my #p = map { $_->[1] } #$tuple;
my $product = 1;
$product *= $_ for #p;
print join('-', #h), ' ', join(' x ', #p), ' = ', $product, "\n";
}
A solution using Algorithm::Loops without changing the input data would look something like:
use Algorithm::Loops;
# Turns ([a, b, c], [d, e], ...) into ([0, 1, 2], [0, 1], ...)
my #lists_of_indices = map { [ 0 .. #$_ ] } #homopol;
NestedLoops( [ #lists_of_indices ], sub {
my #indices = #_;
my $prob_prod = 1; # Multiplicative identity
my #base_string;
my #prob_string;
for my $n (0 .. $#indices) {
push #base_string, $hompol[$n][ $indices[$n] ];
push #prob_string, sprintf("%.3f", $prob[$n][ $indices[$n] ]);
$prob_prod *= $prob[$n][ $indices[$n] ];
}
print join "-", #base_string; print "\t";
print join "x", #prob_string; print " = ";
printf "%.3f\n", $prob_prod;
});
But I think that you could actually make the code clearer by changing the structure to one more like
[
{ T => 1.00, C => 0.63, CC => 0.002, G => 0.83 },
{ T => 0.72, TT => 0.03, ... },
...
]
because without the parallel data structures you can simply iterate over the available base sequences, instead of iterating over indices and then looking up those indices in two different places.
Why don't you use recursion? Pass the depth as a parameter and let the function call itself with depth+1 inside the loop.
you could do it by creating an array of indicies the same length as the #homopol array (N say), to keep track of which combination you are looking at. In fact this array is just like a
number in base N, with the elements being the digits. Iterate in the same way as you would write down consectutive numbers in base N, e.g (0 0 0 ... 0), (0 0 0 ... 1), ...,(0 0 0 ... N-1), (0 0 0 ... 1 0), ....
Approach 1: Calculation from indices
Compute the product of lengths in homopol (length1 * length2 * ... * lengthN). Then, iterate i from zero to the product. Now, the indices you want are i % length1, (i / length1)%length2, (i / length1 / length2) % length3, ...
Approach 2: Recursion
I got beaten to it, see nikie's answer. :-)