http://blog.gmane.org/gmane.comp.lang.perl.qotw.discuss hourly 1 1901-01-01T00:00+00:00 http://gmane.org/img/gmane-25t.png http://gmane.org http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2644 IMPORTANT: Please do not post solutions, hints, or other spoilers until at least 60 hours after the date of this message. Thanks. Kakuro (a.k.a Cross-sums) is a kind of puzzle game: http://en.wikipedia.org/wiki/Kakuro In it, one fills in squares in a crossword-like grid that sum to their sums. One can fill in the digits from 1 to 9, and no digit can be repeated twice. Your object is that given a Kakuro board in a text format described below, then output the final solution. You can find some sample layouts from kakuro.com here: http://www.shlomifish.org/Files/files/text/kakuro.com-layouts/ and there's a new daily puzzle everyday there. (Requires Flash) There are also some more layouts googleable or on the wikipedia page. The layout has the following format: 1. It consists of $Height lines. 2. Each line has $Width squares. Whitespace inside each line is ignored. 3. Each square starts with [ and ends with ]. 4. A square that contains a \ is a blocked square (i.e: a square that cannot have any digit). If a number appears to the left of the \ it is the sum of the digits below the square. If a number appears to the right of the \ it is the sum of the digits to the right of the square. 5. A square that contains a single digit is filled with this digit. Such digits may be used in the solutions or for hints. ------------------- The examples on http://www.shlomifish.org/Files/files/text/kakuro.com-layouts/ should be the most illustrative. The output should be the same with all the non-blocked square containing digits. Bonus points for: 1. Intermediate solutions. 2. Reasonings. Good luck! Shlomi Fish --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/ I'm not an actor - I just play one on T.V. Shlomi Fish 2008-03-27T22:38:08 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2634 IMPORTANT: Please do not post solutions, hints, or other spoilers until at least 60 hours after the date of this message. Thanks. I was told the "What does this code do?" quizzes were not as good as a new programming task, so here's a more traditional QOTW that I came up with. In this quiz you'll try to solve the following Sokoban ( http://en.wikipedia.org/wiki/Sokoban ) puzzle using Perl: {{{{{{{{{{{{{{ #### # # # #### ###$.$ # # .< at >. # # $.$### #### # # # #### }}}}}}}}}}}}}} If you're not familiar with the notation, then "#" are walls, "$" are the initial positions of the boxes to be moved, "." are the destinations and "< at >" is the initial position of the player. This level is the Microban level No. 142 in the levels collection of KSokoban. You may want to solve it yourself before using Perl to do so. You can load it into a Sokoban clone by saving it into a file and then using the "load" command. Good luck and happy new year! Regards, Shlomi Fish --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/ I'm not an actor - I just play one on T.V. Shlomi Fish 2007-12-28T11:31:02 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2633 Hi all! Here's another "What does this code do?" Quiz. I obfuscated the names of the variable names to prevent hinting their purpose, but the code itself is not obfuscated. You have to guess what the "m2()" function does. Good luck! Please post spoilers as response to this post with "SPOILER". Regards, Shlomi Fish <<<<<<<<<<<<<<<<<<<<< use strict; use warnings; sub m2 { my $c = shift; my $d = sub { my $e = shift; return +(ref($e) eq "ARRAY") ? $e->[1] : $e; }; my $f = sub { my $e = shift; return +(ref($e) eq "ARRAY") ? $e->[0] : 1; }; my $g; $g = sub { my ($h, $i, $j) = < at >_; if (($h == < at >$c) && ($j == 0)) { return (); } elsif ($j == 0) { return $g->($h+1, $d->($c->[$h]), $f->($c->[$h]) ); } else { return ($i, $g->($h, $i, $j-1)); } }; return [ $g->(0, 0, 0) ]; } 1; Regards, Shlomi Fish --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/ If it's not in my E-mail it doesn't happen. And if my E-mail is saying one thing, and everything else says something else - E-mail will conquer. -- An Israeli Linuxer Shlomi Fish 2007-10-28T17:06:31 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2624 Hi all! Here's another "What does this code do?" Quiz. I obfuscated the names of the variable names to provide hinting on their purpose, but the code itself is not obfuscated. You have to guess what the "z()" function does. Good luck! Please post spoilers as response to this post with "SPOILER". Regards, Shlomi Fish <<<<<<<<<<<<<<<<<<<<< use strict; use warnings; use List::MoreUtils (qw(uniq)); our %_t = (); sub t { my $c = shift; if (exists($_t{$c})) { return $_t{$c}; } no strict 'refs'; my < at >h = $c; my < at >d = < at >{$c. '::ISA'}; while (my $p = shift(< at >d)) { push < at >h, $p; push < at >d, < at >{$p. '::ISA'}; } my < at >u = uniq(< at >h); return $_t{$c} = [ sort { $a->isa($b) ? -1 : $b->isa($a) ? +1 : 0 } < at >u ]; } sub z { my ($self, $args) = < at >_; my $mn = $args->{mn}; my $c = ((ref($self) eq "") ? $self : ref($self)); my $h= t($c); my < at >r; foreach my $i (< at >$h) { no strict 'refs'; my $m = ${$i . "::"}{$mn}; if (defined($m)) { push < at >r, < at >{$m->($self)}; } } return \< at >r; } Regards, Shlomi Fish --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/ If it's not in my E-mail it doesn't happen. And if my E-mail is saying one thing, and everything else says something else - E-mail will conquer. -- An Israeli Linuxer Shlomi Fish 2007-06-27T19:05:53 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2609 Things have been pretty quiet on this list, so I'm bringing up a question I thought would interest you all. Ovid, on perlmonks, asks[1] if this code is doing too much on one line: my $country = $card->country; $country = $country eq 'gbr' ? '' : uc "[$country]" if $country; How would you write it? Feel free to respond here or in the perlmonks thread. No need to wait 60 hours. [1] Ovid's question, without the (already quite a few) replies: http://perlmonks.org/?displaytype=print;node_id=621769 Yitzchak Scott-Thoennes 2007-06-18T18:18:00 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2594 Hi all and Happy New Year! Here's a quiz for the new year. My sister received this challenge for her college homework, and had to write some Standard ML code to solve it, a task which I helped her with. I hope you enjoy it too. ======================================= IMPORTANT: Please do not post solutions, hints, or other spoilers until at least 60 hours after the date of this message. Thanks. We can represent a non-directed graph[1] (in the computer science sense) by the following representation: 1. Every node (or vertex) will have an integer assinged to it. 2. Every link (or edge) will be represented as a pair of two integers - those that were assigned to the the nodes it connects. Their order doesn't matter, but as you see below should be preserved. 3. The entire graph will be represented as a list of such pairs representing all the links of the graph. So for example the following graph: A--B--F D--C | / |/ E Can be represnted by the following array ref: [[$A,$B],[$B,$E],[$B,$F],[$D,$C],[$F,$E]] You should implement a function called "connected" that will receive such an input and return its connected components, where a connected component is such that for every two nodes in it, there's a path from one to the other. So for the graph above the function will return: [ [[$A,$B],[$B,$E],[$B,$F],[$F,$E]], [[$D,$C]], ] One constraint is that the output should be ordered according to the order of the links in the input. I.e: 1) the order of each link in each connected component correspondence to their order in the input, and 2) the order of the first links from each connected components corresponds to their order in the input. Input: ------ connected($list), where $list = \< at >list, and < at >list is made entirely of [$i,$j] where $i and $j are integers. Output: ------- $ret = connected($list) where: < at >comp1 = [ [$i1,$j1], [$i2, $j2], [$i3, $j3] ]; < at >comp2 = [ [$k1,$l1], [$k2, $l2],... ]; < at >components = ( \< at >comp1, \< at >comp2,... ); $ret = [ < at >components ]; --------------------------- Have fun! Regards, Shlomi Fish [1] - http://en.wikipedia.org/wiki/Graph_theory --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/ Chuck Norris wrote a complete Perl 6 implementation in a day but then destroyed all evidence with his bare hands, so no one will know his secrets. Shlomi Fish 2006-12-29T19:41:15 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2567 I'm getting failed sends of my list submissions. Methinks those should stay with the list maintainer, or? Charles Abney 2006-12-13T22:26:56 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2562 Hi all! Well, it's been a while since we had a quiz so here's another what does this code do quiz: {{{{{{ my (< at >list) = ( grep { $cgi->param("$prefix$_") } map { /^${prefix}(\d+)$/ ? ($1) : () } $cgi->param() ); }}}}}} $cgi is a CGI.pm instance. (in case you couldn't guess.) A friend of mine whose perl is quite rusty had problems understanding this code. What does this code do? And can you guess in what context it was used? I'll reveal the solution after a 60 hours quota, and until then please send them to me in private. Regards, Shlomi Fish --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/ Chuck Norris wrote a complete Perl 6 implementation in a day but then destroyed all evidence with his bare hands, so no one will know his secrets. Shlomi Fish 2006-12-01T14:35:44 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2561 Hi, I read your quiz solution and can see how this program could apply to a problem I have. How might I modify this program so that I can get results for the longest repeated substring in 1.5 million "random" digits? And print right within the program. Thanks in advance, Dan #!C:/Perl/bin/perl.exe -w sub repeated_substring { my $size = length $_[0]; my $maxsize = int ($size / 2); my ($f_index, $f_offset) = (0,0); OUTER: for (my $index=0; $index < $size; $index++) { # The big optimizer # (added a bounds check to keep us from going beyond the # end of the data) if ($f_offset > 20 && $index + $f_offset <= $size) { for (my $t_index = $index + $f_offset - 15; $t_index >= $index; $t_index = $t_index - 15) { if (index($_[0], substr($_[0], $t_index, $index+$f_offset-$t_index), $index+$f_offset) == -1) { $index = $t_index; next OUTER; } } } for (my $offset=$f_offset+1; $offset <= $maxsize && $index + $offset <= $size; $offset++) { if (index($_[0], substr($_[0], $index, $offset), $index+$offset) >= 0) { $f_index = $index; $f_offset = $offset; } else { last; } } } return substr($_[0], $f_index, $f_offset); } --------------------------------- Do you Yahoo!? Get on board. You're invited to try the new Yahoo! Mail Beta. Daniel Wesenberg 2006-07-12T16:52:39 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2553 IMPORTANT: Please do not post solutions, hints, or other spoilers until at least 60 hours after the date of this message. Thanks. Cooking often involves multiplication and rounding of fractions, at least for those of us stuck under the tyranny of U.S. customary units. For instance, to make oatmeal, I use 7 parts water to 4 parts thick-cut rolled oats. If I have 1 2/3 cups oats, about how much water should I use? 5/3 * 7/4 = 35/12 = ~3 cups. Your task: create a script that prompts for a ratio of two integers and a quantity given as a whole number and/or a fraction (e.g. "1 3/5", "12", "3/7") and print out a rounded result of multiplying the quantity by the ratio in the same format. The result should be rounded to the nearest half, third, or fourth, whichever is most accurate (in cases exactly between two quantities, using the lowest denominator). You may assume none of the integers are overly large. Yitzchak Scott-Thoennes 2006-04-02T20:21:17 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2548 In the Israeli Perl Mongers mailing list we used to hold quizzes in which I would paste Perl code snippets and people needed to understand what they did, and possibly guess for what purpose they served. I am going to import this tradition here, and have a "What does this code do?" quiz. You are given the following Perl program, and have to understand what it does, and why was it written. Here goes: <<<< #!/usr/bin/perl use strict; use warnings; my $string = shift; foreach (< at >ARGV) { if (/^([^=]+)=(.*)$/) { my ($v, $s) = ($1,$2); if (substr($string, 0, length($s)) eq $s) { if ((length($string) > length($s)) ? (substr($string,length($s), 1) eq "/") : 1 ) { print $v . substr($string, length($s)); exit(0); } } } else { die "Bad"; } } print $string; Before the 60 hours quota is over, you can send your solutions to me in person (shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org). Regards, Shlomi Fish --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/ 95% of the programmers consider 95% of the code they did not write, in the bottom 5%. Shlomi Fish 2006-01-03T12:36:39 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2544 IMPORTANT: Please do not post solutions, hints, or other spoilers         until at least 60 hours after the date of this message.           Thanks. Well, the previous quiz did not seem to be very popular. Even I started writing it, and then abandoned. I also reached the conclusion that I'd be better off adapting Template Toolkit or whatever for this. In any case here's a fresh new quiz inspired by a question someone asked on the IRC. (Freenode #perl's channel today) You are given a large number of ranges (A[i],B[i]) where B[i] > A[i] for every i, and A[i] and B[i] are real. The ranges are not supplied in any particular order. You are then given a sequence of real numbers X[0], X[1], X[2] one by one. For each number, you have to determine whether it falls inside at least one of the ranges. For bonus points, you need to supply the user with a set of the indices of matching ranges. Phrasing it Perlishly: Write the following functions: 1. my $handle = prepare_ranges_handle($array_ref); $array_ref is an array ref of array refs each containing two elements, being the numbers of the ranges. It returns $handle, which is a reference used for further querying. 2. my $ret = lookup_ranges($handle, $x); Looks up $x in the ranges which were input to $handle. $ret is a hash ref that should contain a field 'verdict' that is a boolean specifying if any of the ranges contain $x. It may also contain 'match_set' which points to a reference to a hash whose keys are the indexes of the matching ranges. Have fun! Regards, Shlomi Fish --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/ Hacker sees bug. Hacker fixes bug. Shlomi Fish 2005-05-06T20:16:36 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2540 IMPORTANT: Please do not post solutions, hints, or other spoilers         until at least 60 hours after the date of this message.           Thanks. First of all a note: MJD is alive and kicking. He has been quite active in the mailing list dedicated to discussions of his newly published book "Higher Order Perl". Hopefully he can play a more active role here as well in the future. (Hi Mark!) In any case, for today's quiz, you will write a preprocessor for Cascading Style Sheets. Cascading Style Sheets (or CSS) are a W3C standard for controlling the look of HTML and other XML standards (like SVG). You can find more information on CSS here: http://www.htmlhelp.com/reference/css/ - an excellent introduction to CSS, albeit somewhat dated by now. http://www.w3.org/Style/CSS/ - the W3C's CSS Home. http://www.w3.org/TR/REC-CSS2/ - the W3C's CSS 2 Recommendation. http://www.w3schools.com/css/default.asp - CSS in W3Schools. More up-to-date information and resources than htmlhelp.com. (Note just that W3Schools have a somewhat bad reputation.) http://www.csszengarden.com/ - The CSS Zen Garden. Same HTML, different CSS Stylesheets, with incredible results. ------------------ Now for the preprocessor itself. It will follow the following conventions: 1. ${ ... } is a preprocessor directive. Note that it does not necessarily terminate on the first "}". There could instead be a } embedded within the expression so the expression would need to be processed first. 2. ${include-local "other.css"} includes a file starting at the current working directory. 3. ${include-abs "/home/shlomi/.latemp/css/myfile.css"} includes a file based on an absolute pathname. 4. ${include-search "myfile.css"} includes files by searching in the include directories (see below). 5. ${include-system "header.css"} includes files by searching first in the system directories (see below) and then in the include directories. 6. -I /path/to/dir parameters to the program designate an include directory. The include directories are searched from right to left. 7. -S /path/to/dir is a system directory. 8. One can assign to a variable by using the set command: ${set myvar ".navbar"} 9. One can retreive the value of a variable by using ${=myvar} or ${print myvar}: <<<<<<< ${set myvar ".navbar"} ${= myvar} { padding-left: 1em; } ${print myvar} > p { background-color: blue; } This is equivalent to writing: .navbar { padding-left: 1em; } .navbar > p { background-color: blue; } 10. Here documents. One can define a here document within an expression: <<<<<<<< ${set a <<"EOF"} .navbar { Take it or leave it. } EOF This will cause the value of a to be what between the ".navbar" up to and excluding the EOF line. 11. One can set values to variables from the command line using the -Dvar=value flag: css-pp -Dvar=hello mytemplate.css Will initilize var to the be the string hello. 12. The --include=mytemplate.css flag will cause the CSS preprocessor to include the file mytemplate.css before beginning the processing of the main file. 13. A dollar preceded by a \ denotes an actual dollar sign. 15. {$# .... } is a comment. 14. Any other feature you'd like to have there. (!) For bonus points, also write vim syntax and filetype configurations to conveniently edit the preprocessor input. Regards, Shlomi Fish Caveat Emptor: part of the reason I'm proposing this quiz is because I actually need such a preprocessor. The other reason is that I think it would be a fun quiz. --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/ Hacker sees bug. Hacker fixes bug. Shlomi Fish 2005-04-26T19:30:10 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2527 Hi all! Attached is: 1. DivideFsm.pm - a file that implements the aforementioned function. 2. Test.t - a fiel that tests it. Enjoy! Regards, Shlomi Fish --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/ Hacker sees bug. Hacker fixes bug. Shlomi Fish 2005-03-28T18:10:38 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2526 Since I was completely unable to solve the "hard" qotw as described, I solved the "easy" version instead, which MSB first. The solution is that each state $_ is the remainder ($_ % $N), so the transition is to left shift the state and add the input (modulo $N). Of course, the start state is 0 (0 % $N). sub gen_is_divisible_fsm { my ($N) = < at >_; return (0, [ map { { ret => $_, next_states => [ ((2 * $_) + 0) % $N, ((2 * $_) + 1) % $N ] } } (0 .. $N - 1) ]); } # Colin Colin Rafferty 2005-03-28T15:29:04 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2523 I also initially solved the problem for MSB first, rather than LSB. Part of the confusion, I think, stems from the fact that the example state machine for $N=3 works in both cases! Anyway, there's an obvious pattern for the MSB FSM, because it's easy to track the remainder. For the LSB FSM, you can't track the remainder anymore, but there's still a pattern. As Greg said, when $N is odd the LSB FSM is simply the MSB FSM with the transitions reversed. So, here's my solution: sub gen_is_divisible_fsm { my($n) = < at >_; my < at >states; foreach (0 .. $n - 1) { push < at >states, { ret => $_, next_states => [( $_ * ($n+1) / 2) % $n, (($_ + $n-1) * ($n+1) / 2) % $n], }; } return(0, \< at >states); } Here's a script that dumps the FSM and tests it on the supplied input. This one also supports MSB-first and even numbers. #!/usr/local/bin/perl -w use strict; use Data::Dump qw/ dump /; my $n = shift or die "Must specify number to generate FSM.\n"; my $input = shift or die "Must specify input to FSM.\n"; my $most_first = shift; my($initial, $states) = gen_is_divisible_fsm($n, $most_first); print dump($states), "\n"; my $binary = sprintf("%b", $input); $binary = reverse $binary if !$most_first; my $result = run_numeric_fsm($initial, $states, $binary); print "$input = $binary: $result\n"; sub gen_is_divisible_fsm { my($n, $most_first) = < at >_; my < at >states; if ($most_first) { my $next = 0; foreach (0 .. $n-1) { push < at >states, { ret => $_, next_states => [$next++ % $n, $next++ % $n], }; } } elsif ($n % 2) { foreach (0 .. $n - 1) { push < at >states, { ret => $_, next_states => [( $_ * ($n+1) / 2) % $n, (($_ + $n-1) * ($n+1) / 2) % $n], }; } } else { foreach (0 .. $n/2 - 1) { push < at >states, { ret => 0, next_states => [$_ + 1, $n/2+1], }; } push < at >states, { ret => 0, next_states => [$n/2, $n/2], }; push < at >states, { ret => 1, next_states => [$n/2+1, $n/2+1], }; } return(0, \< at >states); } sub run_numeric_fsm { my($initial, $states, $string) = < at >_; my $state = $initial; while ($string =~ /(.)/gs) { my $input = $1; my $next_state = $states->[$state]{'next_states'}[$input]; defined $next_state or die "No such input '$input' in state '$state'.\n"; $state = $next_state; } return $states->[$state]{'ret'}; } __END__ Ronald Ronald J Kimball 2005-03-25T17:20:34 http://comments.gmane.org/gmane.comp.lang.perl.qotw.discuss/2521 At first: sorry for my bad english and my bad perl ;) I solved the problem for the LSB-FSM and I must say it was really a hard task. The main problem was not to write the generator-function but to design the FSM itself. My first solution was an FSM with about O(n^2) ("n" is that FSM-number) states. It's a straightforward solution from the theory. Then i tried to minimize the FSM with a standard minimization-algorithm (i.e. I wrote an algorithm replacing equivalent states by a new one). This leads to my first real solution. This one is written in ruby because it was too hard for me to translate it into good perl. The main problem of this solution is that it has a complexity of O(n^4) because the minimization algorithm has a complexity of O(n^2), too. But I made an observation leading to my final solution which is pretty small. The minimized FSM for "n" has alwasy n states. So I tried to find a way to create the equivalent states and their connections directly without using the minimization algorithm. Although that solution is really nice, it was a long way to get it ;). I don't know if someone is interested in me explaining my thoughts in a more detailed way, but this would be a long mail. If so, let me know. I also created a simple third solution that is an extension to my second one. This one also works for even n by checking for 2^k prime-factors first and then do the standard algorithm on the odd rest (in fact, it's essential for the standard FSM that n is not even). Greetings Frank Fischer === first solution: O(n^2)-states with minimization (ruby) === # simulate the FSM def run_fsm(states, n) n = n.to_i cur = 0 while n > 0 cur = states[cur]['next_states'][n & 0x1] n >>= 1 end return states[cur]['ret'] end # create the FSM def gen_is_divisible_fsm(n) n = n.to_i # no even numbers till now raise "n must not be even" if n % 2 == 0 states = [] # the states states_by_pq = { } # the (p,q) => state-number map # create the (p,q)=>number map for all possible values of (p,q) for p in 0...n do for q in 1...n do states_by_pq[[p,q]] = states_by_pq.size end end # now create the arcs for each state from state (p,q) # if we read a "0", go to (p,q*2) # if we read a "1", got to (p+q,q*2) # if we reach an accept-state (0,x), always use (0,1) states_by_pq.each_pair do |pq, idx| p,q = pq next_0 = [p, (q*2)%n] next_1 = [(p+q)%n, (q*2)%n] new_state = { 'next_states' => [ states_by_pq[next_0], states_by_pq[next_1] ], 'ret' => p } states[idx] = new_state end # return the states return states end # minimize the FSM by replacing all equivalent states by one def minimize(states) n_old_states = states.size # first we remove unreachable states # this is not really necessary for our FSM, but it's good in general remove_unreachable!( states ) clear_states!( states ) # clean the states-array # the "marks"-map has a value of true for all pairs of states that are not # equivalent, false otherwise (i.e. if two states are equivalent, # marks[ [a,b] ] == false # at the beginning, two states are equivalent if and only if both # are accepting states or both are no accepting states marks = {} for p in 0...states.size do if states[p] for q in p...states.size do if states[q] marks[[p,q]] = (states[p]['ret'] == 0) != (states[q]['ret'] == 0) end end end end # now we loop as long as we found two states that are not equivalent # i.e. as long as we can reduce the number of states begin new_mark = false marks.each_pair do |pair, mark| unless mark # only check if the may be equivalent s1 = states[pair[0]] s2 = states[pair[1]] # two states are not equivalent if at least "0" or "1" leads to # two not-equivalent states (i.e. marked states) if marks[ [s1['next_states'][0], s2['next_states'][0]].sort ] or marks[ [s1['next_states'][1], s2['next_states'][1]].sort ] then marks[pair] = true # mark that pair as not equivalent new_mark = true # we reduced the number of stated end end end end while new_mark # now remove all equivalent states but one (of each equivalence class) map = Hash.new { |h,k| k } marks.delete_if { |k,v| v } marks.keys.sort.each { |pair| map[pair[1]] = map[pair[0]] } for idx in 0...states.size if states[idx] if map[idx] == idx then # repoint the first states[idx]['next_states'].map! { |n| map[n] } else states[idx] = nil # delete the others end end end clear_states!( states ) # clean up return states, n_old_states-states.size end # do a simple depth-first-search to find unreachable states (which are removed) def remove_unreachable!(states) reached = Hash.new(false) stack = [0] while !stack.empty? do idx = stack.pop reached[idx] = true states[idx]['next_states'].each do |next_state| stack.push next_state unless reached[next_state] end end states.each_index do |idx| states[idx] = nil unless reached[idx] end return states end # remove nil-states from the array and fix the numbering def clear_states!(states) i = 0 map = {} states.each_index do |idx| s = states[idx] unless s.nil? map[idx] = i i += 1 end end states.delete_if { |s| s.nil? } states.each do |s| s['next_states'].map! { |idx| map[idx] } end return states end # create FSM m = gen_is_divisible_fsm( ARGV[0] ) # minimize FSM m, n_removed = minimize( m ) # show it m.each do |s| puts s.inspect end puts "States: #{m.size}, removed: #{n_removed}" # a simple test: check the FSM for some numbers n = ARGV[0].to_i for i in 0..10000 rest = i%n result = run_fsm( m, i ) if (rest == 0 and result != 0) or (rest != 0 and result == 0) raise "Error: #{i}" end end === second solution: O(n)-states and really nice === use Carp; sub gen_is_divisible_fsm { my $n = $_[0]; my < at >states = (); croak "Number must not be even\n" if $n % 2 == 0; for (my $i = 0; $i < $n; $i++) { push(< at >states, { "next_states" => [ ($i*($n+1)/2) % $n, (($i+1)*($n+1)/2) % $n ], "ret" => $i }); } return \< at >states } sub run_fsm { my ($states, $n) = < at >_; my $cur = 0; while ($n > 0) { $cur = $$states[$cur]->{next_states}[$n & 0x1]; $n >>= 1; } return $$states[$cur]->{ret} } my $n = $ARGV[0]; my $m = gen_is_divisible_fsm($n); print "States: ", $#$m+1, "\n"; for (my $i = 0; $i < 10000; $i++) { my $rest = $i % $n; my $result = run_fsm( $m, $i ); if ( ($rest == 0 && $result != 0) or ($rest != 0 && $result == 0) ) { print $i, " ", $rest, " ", $result, "\n"; croak "Invalid FSM\n"; } } print "Test passed\n"; === third solution: n states with even numbers === sub gen_is_divisible_fsm { my $n = $_[0]; my < at >states = (); my $epow = 0; while ($n > 0 && $n % 2 == 0) { $epow++; $n >>= 1; } for (my $i = 0; $i < $epow; $i++) { push(< at >states, { "next_states" => [ $i+1, $epow + $n ], "ret" => 0 }); } for (my $i = 0; $i < $n; $i++) { push(< at >states, { "next_states" => [ ($i*($n+1)/2) % $n + $epow, (($i+1)*($n+1)/2) % $n + $epow ], "ret" => $i }); } push(< at >states, { "next_states" => [ $n + $epow, $n + $epow ], "ret" => 1 }) if ($epow > 0); return \< at >states } ================================================== Frank Fischer 2005-03-25T10:58:37 Search the mailing list at Gmane query http://search.gmane.org/?group=$group=gmane.comp.lang.perl.qotw.discuss