Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

ambrus's scratchpad

by ambrus (Abbot)
on Jun 01, 2004 at 17:41 UTC ( #358307=scratchpad: print w/ replies, xml ) Need Help??

Word ladder one-way breadth-first search pseudocode stuff for Limbic~Region.

Assume you have read in three pre-computed arrays of integers @adj_edge, @adj_index, @adj_length such that the neigbours of the word of index $i are given by @adj_edge[$adj_index[$i] .. $adj_index[$i] + $adj_length[$i] - 1]

You have found the two words you want to bridge: $start, $goal.

You will need three temporary arrays, each the size of your word list.

@seen = (0)x@adj_index;
This tells what words you have already met.
@previous = (undef)x@adj_index;
This tells the previous word from which we have first met this word. (You could have @seen and @previous in the same array.)
@queue = (undex)x@adj_index; $queue_head = 0; $queue_tail = 0;
This is the queue of words you have to process. Only the portion @queue[$queue_head .. $queue_tail - 1] section is meaningful, the section @queue[0 .. $queue_head] contains used up old items, and @queue[$queue_tail .. @queue] is space for future items.

When you see a word $j on the other side of an edge starting from $i, you mark it to be processed in the future if you haven't yet met it.

$found_goal = 0; sub visit { my($i, $j) = @_; if (!$seen[$j]) { $seen[$j] = 1; $previous[$j] = $i; $queue[$queue_tail++] = $j; if ($goal == $j) { $found_goal = 1; } } }

You start by putting the starting word to the word queue, from a fake starting point.

seeword(-1, $start);

Now in the main loop, you shift a word to be processed from the queue and visit all its neigbours.

while ($queue_head < $queue_tail && !$found_goal) { my $i = $queue[$queue_head++]; for $e (0 .. $adj_length[$i]) { my $j = $adj_edge[$adj_index[$i] + $e]; visit($i, $j); } }

Finally, you must print the word ladder by following the edges backwards.

if ($found_goal) { my $i = $goal; while (-1 != $i) { print $word_string[$i], "\n"; $i = $previous[$i]; } } else { print "no word ladder.\n"; }

(This would be a little bit longer if you wanted to print the words from start to goal, but instead just swap start with goal at program start.)

Sorry for errors in above code, it's untested.


#include <cstdlib> #include <iostream> #include <algorithm> #include "opencv2/core/core.hpp" using std::cerr; using std::abort; using std::min; using std::max; /*! Find a point set in a mask that is nearest (in l^\infty metric) to + a given point. */ /*! \arg `image` is a boolean mask, must be of type `CV_8C` and 2 dime +nsional, nonzero value means true. \arg `center` is the point. \arg `output` becomes the nearest point found. \returns true iff a point is found, false if `image` is all false. */ bool FindNearestPoint(cv::Mat image, cv::Point center, cv::Point &output) { if (CV_8U != image.type() || 2 != image.dims) { cerr << "error: wrong type of matrix passed to FindNearestPoin +ts (type=" << image.type() << ", dims=" << image.dims << ").\n"; abort(); } int sy = image.rows, sx = image.cols; int cy = center.y, cx = center.x; int ldx = cx < 0 ? -cx : sx <= cx ? cx - sx : 0; int ldy = cy < 0 ? -cy : sy <= cy ? cy - sy : 0; int ld = max(ldx, ldy); int hdx = cx < 0 ? sx - cx : sx <= cx ? cx : max(cx, sx - cx); int hdy = cy < 0 ? sy - cy : sy <= cy ? cy : max(cy, sy - cy); int hd = max(hdx, hdy); for (int d = ld; d <= hd; d++) { int ay = cy - d; int ly = max(0, ay); int by = cy + d; int hy = min(sy - 1, by); int ax = cx - d; int lx = max(0, ax); int bx = cx + d; int hx = min(sx - 1, bx); if (0 <= ax && ax < sx) for (int y = ly; y <= hy; y++) if (0 != image.at<unsigned char>(y, ax)) { output = cv::Point(ax, y); return true; } if (0 <= bx && bx < sx) for (int y = ly; y <= hy; y++) if (0 != image.at<unsigned char>(y, bx)) { output = cv::Point(bx, y); return true; } if (0 <= ay && ay < sy) for (int x = lx; x <= hx; x++) if (0 != image.at<unsigned char>(ay, x)) { output = cv::Point(x, ay); return true; } if (0 <= by && by < sy) for (int x = lx; x <= hx; x++) if (0 != image.at<unsigned char>(by, x)) { output = cv::Point(x, by); return true; } } output = cv::Point(0, 0); return false; }

For obfu. The following magic variables intify automatically: $- $= $% $? $! $^E $^F $^T $^D $^H $^P. The following stringify: $0 $^I $^O $\ $^A $:. This boolify: $| $^W $^C.


To Monk_perl:

203527 <+termbot> +bcc vowel.c 203529 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland + International 203529 <+termbot> -vowel.c: 203529 <+termbot> -Error vowel.c 9: Type mismatch in parameter '__s' i +n call to 'fgets' in function main 203529 <+termbot> -Error vowel.c 9: Too few parameters in call to 'fge +ts' in function main 203529 <+termbot> -Error vowel.c 9: Nonportable pointer conversion in +function main 203529 <+termbot> -Warning vowel.c 18: Unreachable code in function ma +in 203529 <+termbot> -Error vowel.c 20: Compound statement missing } in f +unction main 203531 <+termbot> -Warning vowel.c 20: Function should return a value +in function main 203534 <+termbot> -*** 4 errors in Compile *** 203534 <+termbot> -*** 4 errors in Compile *** 203534 <+termbot> - 203535 <+termbot> - Available memory 4081880 203536 <+termbot> - 203537 <+termbot> -C:\MONKPERL> 203542 <@b_jonas> `type vowel.c 203542 <+termbot> +type vowel.c 203542 <+termbot> - #include<stdio.h> 203542 <+termbot> -#include<conio.h> 203542 <+termbot> - main() 203542 <+termbot> - { 203543 <+termbot> - char c; 203545 <+termbot> - int i,n=0; /* n stands for no. of vowel*/ 203547 <+termbot> - clrscr(); 203548 <+termbot> - c=fgets(a[i]); 203549 <+termbot> - for(i=0;i<=a[i];i++) 203550 <+termbot> - { 203551 <+termbot> - switch(c) 203552 <+termbot> - { 203554 <+termbot> - case 'a': case 'e': case 'i': case 'o': c +ase 'u': 203555 <+termbot> - n++; 203556 <+termbot> - break; 203557 <+termbot> - 203558 <+termbot> - getch(); 203559 <+termbot> - } 203600 <+termbot> - } 203600 <+termbot> - 203601 <+termbot> -C:\MONKPERL> </c> <p> Let's fix the call to fgets. <c> 203945 <@b_jonas> `edlin vowel.c 203945 <+termbot> +edlin vowel.c 203946 <+termbot> -End of input file 203946 <+termbot> -* 204002 <@b_jonas> 9 204005 <@b_jonas> `9 204005 <+termbot> +9 204006 <+termbot> - 9:* c=fgets(a[i]); 204006 <+termbot> - 9:* 204017 <@b_jonas> ` fgets(a, 9, stdin); 204017 <+termbot> + fgets(a, 9, stdin); 204017 <+termbot> -* 204023 <@b_jonas> `8,10p 204023 <+termbot> +8,10p 204023 <+termbot> - 8: clrscr(); 204023 <+termbot> - 9: fgets(a, 9, stdin); 204023 <+termbot> - 10:* for(i=0;i<=a[i];i++) 204023 <+termbot> -* 204030 <@b_jonas> `e 204031 <+termbot> +e 204031 <+termbot> - 204031 <+termbot> -C:\MONKPERL> 204039 <@b_jonas> `bcc vowel.c 204039 <+termbot> +bcc vowel.c 204041 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland + International 204041 <+termbot> -vowel.c: 204042 <+termbot> -Warning vowel.c 18: Unreachable code in function ma +in 204042 <+termbot> -Error vowel.c 20: Compound statement missing } in f +unction main 204042 <+termbot> -Warning vowel.c 20: Function should return a value +in function main 204042 <+termbot> -*** 1 errors in Compile *** 204042 <+termbot> - 204042 <+termbot> - Available memory 4081880 204044 <+termbot> - 204044 <+termbot> -C:\MONKPERL> 204406 <@cbstream> [ambrus] ah, that one error I got seems to be a mis +take when I copied the program. I skipped a line. So what did + you get? What does the program do for you? 204132 <@b_jonas> `edlin vowel.c 204132 <+termbot> +edlin vowel.c 204132 <+termbot> -End of input file 204132 <+termbot> -* 204405 <@b_jonas> `17 204406 <+termbot> +17 204406 <+termbot> - 17:* 204406 <+termbot> - 17:* 204407 <@b_jonas> ` } 204407 <+termbot> + } 204407 <+termbot> -* 204409 <@b_jonas> `e 204410 <+termbot> +e 204410 <+termbot> - 204410 <+termbot> -C:\MONKPERL> 204412 <@b_jonas> `bcc vowel.c 204412 <+termbot> +bcc vowel.c 204415 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland + International 204415 <+termbot> -vowel.c: 204415 <+termbot> -Warning vowel.c 20: Function should return a value +in function main 204415 <+termbot> -Turbo Link Version 5.1 Copyright (c) 1992 Borland International 204415 <+termbot> - 204415 <+termbot> - Available memory 4075304 204418 <+termbot> - 204418 <+termbot> -C:\MONKPERL> 204640 <@cbstream> [ambrus] Monk_perl: apart from the wrong condition +in the for loop, I think there are at least two smaller pr +oblems: first, you never output anything, secondly, you cal +l getch() too many times (once for each iteration in the for +loop) 204645 <+termbot> -C:\MONKPERL> 204656 <@b_jonas> `edlin vowel.c 204657 <+termbot> +edlin vowel.c 204657 <+termbot> -End of input file 204657 <+termbot> -* 204704 <@b_jonas> `18d 204704 <+termbot> +18d 204704 <+termbot> -* 204724 <+termbot> -* 204815 <@b_jonas> `19i 204815 <+termbot> +19i 204815 <+termbot> - 19:* 204841 <@b_jonas> `printf("%d",n); 204841 <+termbot> +printf("%d",n); 204841 <+termbot> - 20:* 204844 <@b_jonas> ``o 204844 <+termbot> +^Z 204845 <+termbot> -* 204849 <@b_jonas> `17p 204849 <+termbot> +17p 204849 <+termbot> - 17: } 204849 <+termbot> - 18: } 204849 <+termbot> - 19: printf("%d",n); 204849 <+termbot> - 20:* } 204850 <+termbot> -* 204853 <@b_jonas> `10 204854 <+termbot> +10 204854 <+termbot> - 10:* for(i=0;i<=a[i];i++) 204854 <+termbot> - 10:* 204926 <@b_jonas> ` for (i = 0; 0 != a[i]; i++) 204926 <+termbot> + for (i = 0; 0 != a[i]; i++) 204926 <+termbot> -* 204933 <@b_jonas> `1p 204934 <+termbot> +1p 204934 <+termbot> - 1: #include<stdio.h> 204934 <+termbot> - 2: #include<conio.h> 204934 <+termbot> - 3: main() 204934 <+termbot> - 4: { 204934 <+termbot> - 5: char c; 204934 <+termbot> - 6: char a[9]; 204935 <+termbot> - 7: int i,n=0; /* n stands for no. of vow +el*/ 204935 <+termbot> - 8: clrscr(); 204936 <+termbot> - 9: fgets(a, 9, stdin); 204936 <+termbot> - 10: for (i = 0; 0 != a[i]; i++) 204937 <+termbot> - 11: { 204937 <+termbot> - 12: switch(c) 204938 <+termbot> - 13: { 204938 <+termbot> - 14: case 'a': case 'e': case 'i': c +ase 'o': case 'u': 204939 <+termbot> - 15: n++; 204939 <+termbot> - 16: break; 204940 <+termbot> - 17: } 204940 <+termbot> - 18: } 204942 <+termbot> - 19: printf("%d",n); 204943 <+termbot> - 20:* } 204943 <+termbot> -* 205017 <@b_jonas> `e 205017 <+termbot> +e 205017 <+termbot> - 205018 <+termbot> -C:\MONKPERL> 205025 <@b_jonas> `bcc vowel.c 205025 <+termbot> +bcc vowel.c 205028 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland + International 205028 <+termbot> -vowel.c: 205028 <+termbot> -Warning vowel.c 20: Function should return a value +in function main 205028 <+termbot> -Turbo Link Version 5.1 Copyright (c) 1992 Borland International 205028 <+termbot> - 205028 <+termbot> - Available memory 4074540 205031 <+termbot> - 205031 <+termbot> -C:\MONKPERL> 205320 <@cbstream> [ambrus] right, the problem is, <c>switch(c)</c> do +esn't make sense, since you only assign <c>c</c> once and + in a wrong way at that time. you need to switch on somet +hing that's set to the next character each time. 205319 <@b_jonas> `edlin vowel.c 205320 <+termbot> +edlin vowel.c 205320 <+termbot> -End of input file 205320 <+termbot> -* 205352 <@b_jonas> `12 205352 <+termbot> +12 205352 <+termbot> - 12:* switch(c) 205352 <+termbot> - 12:* 205401 <@b_jonas> ` switch(a[i]) 205401 <+termbot> + switch(a[i]) 205401 <+termbot> -* 205403 <@b_jonas> `e 205403 <+termbot> +e 205403 <+termbot> - 205403 <+termbot> -C:\MONKPERL> 205406 <@b_jonas> `bcc vowel.c 205406 <+termbot> +bcc vowel.c 205408 <+termbot> -Borland C++ Version 3.1 Copyright (c) 1992 Borland + International 205408 <+termbot> -vowel.c: 205408 <+termbot> -Warning vowel.c 20: Function should return a value +in function main 205408 <+termbot> -Turbo Link Version 5.1 Copyright (c) 1992 Borland International 205409 <+termbot> - 205409 <+termbot> - Available memory 4074540 205411 <+termbot> - 205411 <+termbot> -C:\MONKPERL> 205417 <@b_jonas> `vowel 205418 <+termbot> +vowel 205420 <@b_jonas> `semi 205420 <+termbot> -semi 205420 <+termbot> -2 205420 <+termbot> -C:\MONKPERL> 205422 <@b_jonas> `vowel 205422 <+termbot> +vowel 205427 <@b_jonas> eieio 205431 <@b_jonas> `eieio 205432 <+termbot> -eieio 205432 <+termbot> -5 205432 <+termbot> -C:\MONKPERL> 205433 <@b_jonas> `vowel 205433 <+termbot> +vowel 205447 <@b_jonas> strmpf 205453 <@b_jonas> `strmpf 205454 <+termbot> -strmpf 205454 <+termbot> -0 205454 <+termbot> -C:\MONKPERL> 205523 <@cbstream> [ambrus] ah, after all the modifications, my versio +n seems to work now. 205646 <@b_jonas> `type vowel.c 205646 <+termbot> +type vowel.c 205646 <+termbot> - #include<stdio.h> 205646 <+termbot> -#include<conio.h> 205646 <+termbot> - main() 205646 <+termbot> - { 205647 <+termbot> - char c; 205647 <+termbot> - char a[9]; 205648 <+termbot> - int i,n=0; /* n stands for no. of vowel*/ 205648 <+termbot> - clrscr(); 205649 <+termbot> - fgets(a, 9, stdin); 205649 <+termbot> - for (i = 0; 0 != a[i]; i++) 205650 <+termbot> - { 205650 <+termbot> - switch(a[i]) 205651 <+termbot> - { 205651 <+termbot> - case 'a': case 'e': case 'i': case 'o': c +ase 'u': 205652 <+termbot> - n++; 205652 <+termbot> - break; 205653 <+termbot> - } 205653 <+termbot> - } 205654 <+termbot> -printf("%d",n); 205654 <+termbot> - } 205655 <+termbot> - 205655 <+termbot> -C:\MONKPERL>

To Xiong:

use warnings; use Scalar::Util "blessed"; { package Error::Base; sub new { my($class, $str, @rest) = @_; my %o = (str => $str, @rest); # you may store backtrace info too bless \%o, $class; } use overload q/""/ => "strify"; sub strify { my($self) = @_; $$self{str} . "\n"; # you may append a user-readable form of the b +acktrace } sub crash { my($self, @rest) = @_; die $self->new(@rest); } } my $wt = -140; if ($wt < 0) { Error::Base->crash("creature weight negative", negative_creature_weight => 1, creature_name => "dragon", creature_weight => -140, ); } __END__
Output:
creature weight negative

To Monk_perl:
  1. Solve Write any natural number as sum of three triangular numbers.
  2. Write a C program that inputs a list of fourteen integers separated by whitespace, then prints their alternating sign sum.

    Example input: 44 57 31 29 51 29 59 48 82 18 95 11 45 64. Output for this input: 151

  3. Without running it on a computer, determine what this program would print if ran.
    #include <stdio.h> int main(void) { int n = 0; while (n < 10) { if (n < 5) { n = n + 3; } else { n = n + 2; printf("%d\n", n); } } return 0; }

List of perl modules I have, for Xiong. This is inclusive like your list, there are some modules in here that I haven't really tried.

Some dependencies are not listed, even if I've used them directly. Also, assume that I mean the latest stable versions of each of these modules and of the perl core.

  • Mark Lehmann's modules: AnyEvent, EV, AnyEvent::HTTP, Coro, Compress::LZF, EV::Loop::Async, JSON::XS, EV::ADNS, IO::Socket::SSL, AnyEvent::HTTP. (If you want to be inclusive, just install all his modules :)
  • Email parsing and creation: Mime::Tools, Email::Mime.
  • Internationalization stuff: Unicode::Collate.
  • modules whose functions have been integrated to core lately but you can still use them if you want your code to run on older perls unchanged: Socket::GetAddrInfo, MRO::Compat, Hash::Util::FieldHash::Compat, WWW::Curl.
  • OS interface: BSD::Resource, Socket::MsgHdr.
  • Date module: Date::Manip.
  • Toolkit stuff: Glib, Gtk2, Wx, Tk.
  • web and XML and related stuff: CGI, HTML::Tree, XML::Twig, XML::LibXML, XML::XSH2, XML::XPath, LWP, URI, Net::Curl::Simple, Mozilla::CA.
  • Perl data structures stuff: Data::Diver, Data::Dump::Streamer.
  • Perl internals magic stuff: Sub::Name.
  • Regexp::Common.
  • Numeric: Math::BigInt::GMP, Math::Int64, Math::Libm, PDL.
  • Serialization: YAML (I don't recommend this one, but it's popular), YAML::Syck, JSON.
  • Various other modules I have downloaded to look at their docs but have never used them and possibly never even installed them (this is true to some of the previous modules too): Astro::MoonPhase, B::Keywords, File::HomeDir, File::ShareDir, Sane.
  • Paul Evan's modules (I haven't really tried any of these): Async-MergePoint, IO::Async, AnyEvent::IRC, Term::TermKey.
  • (Update:) This one I install only because I'm the maintainer: Object::Import.

Code in pre tags around code tags

first line second third fourth

Poll idea draft

I can't imagine how I could live all my childhood without: mobile phone, electric toothbrush, el. pencil sharpener, notebook computer, Euro, smartphone, wireless mouse, dishwasher, ….


To cythin, based on cythin's scratchpad and The story of a strange line of code: pos($_) = pos($_);:
use warnings; use strict; my $regex1 = qr/([a-zA-Z]+(\d*)+)|((\d*)+[a-zA-Z]+)/; #default +words, and words with numbers my $regex2 = qr/(\w|\d|\.)+@(\w|\d|\.)+/; #email addresses my $regex3 = qr/(\w+)\s?(\d)+/; #word and number co +mbinations: Number 1, Assignment 2, Vol my $regex4 = qr/(\w+)'(\w){0,2}/; #contractions in Engl +ish my $regex5 = qr/(\w)(\/|&)(\w)/; #abbreviations with sl +ash: c/o, i/o, etc. my $regex6 = qr/(M).{1,2}\.(\s([A-Z]{1}[a-z]+))?/; #formal titl +es: Dr., Mr., Mrs. Agenstein, etc. my $regex7 = qr/(\w+)-(\w+)(-\w+)?/; #hyphenated words: + cat-like, face-to-face, etc. my $regex8 = qr/([A-Z]\.?){3}/; #3-letter abbreviat +ions, using uppercase only, no space, my $regex9 = qr/[a-zA-Z]{3}\.\s?(\d+)/; #3-letter abbre +viations containing numbers, mixed case, my $regex10 = qr/\$\d+/; #money expressions $xxxx f +ormat my $regex11 = qr/\$\d+(.\d{2})?/; #money expressions $x +xxx.xx format my $regex12 = qr/(http:\/\/.*)|(w{3}\.(.)*)/; #websites beg +inning with www. or http:// my $regex13 = qr/(\(\d{3}\)\s(\d{3})-(\d{4}))/; #phone numb +ers, no country code (xxx) xxx-xxxx my @regarray = ($regex13, $regex12, $regex11, $regex10, $regex9, $rege +x8, $regex7, $regex6, $regex5, $regex4, $regex3, $regex2, $regex1); $/ = undef; my $text = <DATA>; TOK: while(1) { for my $i (0 .. @regarray-1) { my $re = $regarray[$i]; if ($text =~ /\G($re)/gc) { my $word = $1; if (12 != $i) { printf "%02d (%s)\n", $i, $word; } next TOK; } } if ($text =~ /\G./gcs) { 1; } elsif ($text =~ /\G\z/gc) { print "end of text\n"; last; } else { die; } } __DATA__ Some text here

Custom CSS I use with the Dark theme. This is grey on black text. One problem with it is that I can't change the colors of the checkboxes and option buttons, so they look ugly. (I'm using various versions of Firefox mostly.)

/* css for ambrus in perlmonks.com */ /* color, supplementing the Dark theme */ input, textarea, select { background-color: #000000; color: #cccccc } input[type="submit"] { background-color: #000000; color: #ffffff } a:link { color: #8080ff } a:visited { color: #a060d0 } /* posts */ div.notetext { font-size: 100% } tr.reply-body ul.indent font[size="2"] { font-size: 100% } div.readmore { background-color: transparent; padding-left: 2px; borde +r-left-width: 2px; border-left-color: #080; border-left-style: solid +} /* nodelets */ tbody.nodelet td { font-size: 100%; background-color: #000000 } #XP_Nodelet sup { vertical-align: text-top } tbody.nodelet .inline-list > li:before { content: " "; } tbody.nodelet#Find_Nodes .inline-list > li { display: block; } .nodelet#Leftovers ul#external { display: none; } /* cb messages */ tbody.nodelet td.highlight { /* background-color: transparent */ } tr.cb_msg td, tr.cb_me td { padding: 0px; text-indent: -0.6em; padding +-left: 0.6em; } /* cb speakers: */ span.chat span.cb_author *:link, span.chat span.cb_author *:visited { +font-size: 111% } span.chat i > span.cb_author *:link , span.chat i > span.cb_author *:v +isited { font-size: 111%; font-style: italic } /* cb separators span.chat span.cb_author:before { content: "\3d" } span.chat i > span.cb_author:before { content: "\3d" } span.chat span.cb_author:after { content: "\3d" } span.chat i > span.cb_author:after { content: "" } */ span.chat span.cb_sq_br:first-child , span.chat span.cb_sq_br , span. +chat span.cb_me_bullet { display: none } /* span.chat span.cb_sep { } */ /* cb sidebar */ body#id-481185 input[name="message"] { width: 100%; } body#id-481181 table.cb_table td { font-size: 17px } /* increase some text areas */ *.user-settings textarea[name="setstyle"] { width: 80ex; height: 20em +} /* show levels next to attributions */ /*.attribution-title { display: inline; }*/ /* misc */ div.ss-criteria-summary { display: none } /* TEMP */ /*"http://cruft.de/lr.css"*/ /*tbody[id="XP_Nodelet"] { display: none; color: lime }*/ /*.nnt-line-incidental .nnt-link { background-color: orange; }*/ /*ul ul ul { padding-left: 0px }*/ /* body#id-11911 .nodelets { display: none } */
Rat gradient is 80ff80;8080ff.

Testing: ea ια ou őű low control  space control del  cp1252 –… invalid byte ‘€ end.


Languages in order of portability on unix systems, for when I want to write a cross-language obfu. (These are off the top of my head, check package lists of distros if you want to be sure.)

  • Almost all unixen: bash or ksh, sed or awk, gcc.
  • Almost all linuxen: bash, gsed, gawk, perl.
  • Linuxen where you build: g++, gmake.
  • Linuxen where you develop: m4 (autotools uses it), lex, yacc, makeinfo, some C libraries.
  • Traditional unices (but not some modern linux desktops): make, dc, bc, ex.
  • Many unices where you typeset: metafont, tex, latex, gs (ghostscript).
  • Many linuxes: python2, ruby1.8, firefox or konqueror.

Possible rumours about the unohly opwer.

I've removed the actual list, because jdporter started the service..

We may want to cycle these so a new random rumour appears every day on the group page.

Special thanks to ww for some of the ideas.

Guidelines for inclusion: (yes, I know, these contradict each other and the list of quips I gave)

  • No Chuck Norris facts
  • Plausible ones, so that if someone casually visits the node only on one day, he probably doesn't get too suspicious.
  • Ones that won't make a casual onlooker outraged because of violation of their privacy or other pertained rights if they take the quip seriously, eg. no "can read your private messages".
  • No powers that specific Cabal groups (other than gods) have.
  • Be vague
  • Some unholy tone
  • Funny

Template and list removed

The following are to consider whether they can be added.

  • edit the lists of top of page quips and xp quips and silence messages and borgisms and unholy power rumours
  • to edit theme CSS
  • Fermat joke
  • Microbrewery

Funny warning syntax that inlines to nothing:
use warnings; use strict; + no warnings qw"void"; + sub DEBUG () {} { package Dbglt; use overload "<", sub {}; } *< = sub { bless {}, Dbglt::; }; # for not debugging, uncomment: sub dbg () { "" } # for debugging, uncomment: #sub dbg { "" } dbg & <<'DEBUG;'; warn "debugging message"; DEBUG; warn "normal message"; __END__

# bash functions for manipulating the path shopt -s extglob # addpath appends a directory to the path unless it is already there # eg: addpath ~/bin addpath(){ local a p=":$PATH:"; for a; do case "$p" in (*:"${a%/}"?(/):*);; (*) p="$p$a:";; esac; done; p="${p#:}"; PATH="${p%:}"; } # delpath deletes a dir from the path delpath(){ local a p=":$PATH:"; for a; do a="${a%/}"; p=${p/:"${a}"?(\/):/:}; done; p="${p#:}"; PATH="${p%:}"; } #END

To Xiong: removing filter by calling unimport works as expected:

[am]king ~/a/tmp$ cat a.pl { package Filter::Transcript; use Filter::Util::Call; sub filter { my $s = filter_read; warn "TRANSCRIPT: $_"; $s; } sub import { filter_add(\&filter); } sub unimport { filter_del() } BEGIN { $INC{"Filter/Transcript.pm"}++; } } print "hello, world\n"; use Filter::Transcript; for (0, 1) { print "this part of the code is transscribed\n"; } no Filter::Transcript; print "good bye\n"; __END__ [am]king ~/a/tmp$ perl a.pl TRANSCRIPT: TRANSCRIPT: for (0, 1) { TRANSCRIPT: print "this part of the code is transscribed\n"; TRANSCRIPT: } TRANSCRIPT: TRANSCRIPT: no Filter::Transcript; hello, world this part of the code is transscribed this part of the code is transscribed good bye [am]king ~/a/tmp$ perl -v This is perl 5, version 12, subversion 1 (v5.12.1) built for x86_64-li +nux Copyright 1987-2010, Larry Wall Perl may be copied only under the terms of either the Artistic License + or the GNU General Public License, which may be found in the Perl 5 source ki +t. Complete documentation for Perl, including FAQ lists, should be found +on this system using "man perl" or "perldoc perl". If you have access to + the Internet, point your browser at http://www.perl.org/, the Perl Home Pa +ge. [am]king ~/a/tmp$

The link from the internationalized About Google page http://www.google.hu/intl/hu/about.html to the Google Blog is broken. It says "Google Blog" but actually points to the google search main page http://www.google.com/.

I can't figure out where to send a report about this. I looked at the Google Help Center at first, but in http://www.google.com/support/bin/static.py?page=portal_more.cs I couldn't find a category that matched the about page. Then I tried the "Contacting Us" page, but it seems there's no general contact page, only ones tied to each google product like Web search (http://www.google.com/support/websearch/bin/request.py?contact_type=contact_policy), which sent me to the Help forum. However, the Help forum http://www.google.com/support/forum?hl=en is also separated to pages for each google product, and it seems there's no generic forum about topics that don't fit elsewhere, nor a forum about the Help Center or the Help forum itself (nor a Help Center category about the forum etc), so now I completely don't have any idea on who to ask.

On the Google Blog page itself they say "We Love Feedback" with an email addres, and they're probably interested in the link pointing to them (so readers can find the blog), so finally I sent a mail to that address in case they can help, but I still don't think that's the right place.

So, dear monks, help me figure out who I should ask about this thing.


Why am I getting this warning?

$ perl -we 'my %rule = ("suffix1", "foo", "succ1", "bar"); warn join(" +/", @rule{qw"suffix1 succ1"})' Scalar value @rule{qw"suffix1 succ1"} better written as $rule{qw"suffi +x1 succ1"} at -e line 1. foo/bar at -e line 1. $ perl -v This is perl, v5.10.1 (*) built for x86_64-linux ...

Word ladder, perl quiz of the week expert edition week 22. See report of solutions and task specification, my submission, and other mails in these two mailing lists.


RE The Oldest Plays the Piano

There's Re: Simple primality testing which links to an older node prime factorization using base 1.

Then there's the amazing dc.sed script which implements arbitrary precision numeric calculations in decimal base in sed – you can find its source here or inside the tarball of gnu sed as a test. I don't really understand how it does the multiplication and division, but I could do the addittion on my own in a slightly more complicated way in Re^2: --- adding a column of integers (it's a loop of four substitutions, dc.sed has two and the teasing comment "could be done in one s/// if we could have >9 back-refs..." which I don't really believe).

How about fibonacci numbers? Some snipets like Re: Fibonacci golf with one state variable use regex substitutions but then they're not really using the power of the regex engine. There must be some way to actually use the regular expression engine to generate fibonacci numbers though. Searching yields fibonacci regex and Fibonacci Regex. These test for fibonacci numbers rather than generating them but there's probably some way to convert them. Another idea is to use something like this but probably there's some nicer way to phrase it:

perl -le'$==1,(1x$_)=~/(^)(1|11\1)*(?{$=++})^/,print$=for 0..20'

good localtime


Here's some code to show that IO::Socket inherits the creation methods (new, new_from_fd, fdopen) from IO::Handle.

perl -we 'use warnings; use strict; use 5.010; use IO "Socket"; use So +cket; use Fcntl; my($L, $R) = IO::Socket->socketpair(PF_UNIX, SOCK_ST +REAM, 0) or die; $L->fcntl(F_SETFD, $L->fcntl(F_GETFD, 0) &~ FD_CLOEX +EC); defined(my $p = fork) or die "fork"; if (!$p) { exec @ARGV, $L-> +fileno; die "exec"; } $L->close; print "reading... "; my $x = $R->get +line; say "got: $x"; 0 < waitpid $p,0 or die "wait";' perl -we 'use w +arnings; use strict; use 5.010; use IO::Socket; sleep 1; my $h = shif +t; say "fileno: $h"; my $O = IO::Socket->new_from_fd($h, ">") or die +"fdopen $!"; $O->printflush("hello"); $O->shutdown(SHUT_WR); say "wri +tten"; sleep 1; say "done";'

To Tanktalus, who is lazy to read the irc RFCs.

perl -we 'use Socket; use IO::Handle; socket $C, PF_INET(), SOCK_STREA +M(), 0 or die; connect $C, sockaddr_in(6667, inet_aton("irc.freenode. +net")) or die; printf $C "user 0 0 0 x\nnick cbu%04x\njoin #cbstream\ +n", rand(2**16) or die; flush $C; while (<$C>) { y/\r//; /\A(?::\S+)? +\s+(?:4|ERROR)/ and die $_; /\A:cbstream!\S+\s+PRIVMSG\s+#cbstream\s+ +:?(.*)/si and print $1; }'
New, corrected version:
perl -we 'use Socket; use IO::Handle; socket $C, PF_INET(), SOCK_STREA +M(), 0 or die; connect $C, sockaddr_in(6667, inet_aton("irc.freenode. +net")) or die; printf $C "user 0 0 0 x\nnick cbu%04x\njoin #cbstream\ +n", rand(2**16) or die; flush $C; while (<$C>) { y/\r//; /\A(?::\S+)? +\s+(?:4(?!77)|ERROR)/ and die $_; /\A:cbstream!\S+\s+PRIVMSG\s+#cbstr +eam\s+:?(.*)/si and print $1; }'

Numerology. If you don't cheat by using random operations and only add the letters of each verse then 442 is the most frequent sum in the bible.

442 thorns(19+7+14+17+13+18) also(0+11+18+14) An(0+13) thistlez(19 ++7+8+18+19+11+4+25) gun(6+20+13) it(8+19) brin(1+17+8+13) forth(5+14+ +17+19+7) 2 u(20); -- Genesis 3:18 442 Ceiling(2+4+8+11+8+13+6) Cat(2+0+19) sed(18+4+3), "yr(24+17) h +er(7+4+17) bukkit(1+20+10+10+8+19) holder(7+14+11+3+4+17), go(6+14) h +old(7+14+11+3) her(7+4+17) bukkit(1+20+10+10+8+19)." -- Genesis 16:9 442 An(0+13) he(7+4) sed(18+4+3) "Abraham(0+1+17+0+7+0+12) ur(20+1 +7) gud(6+20+3) kitteh(10+8+19+19+4+7). U(20) wud(22+20+3) givd(6+8+21 ++3) me(12+4) ur(20+17) kitteh(10+8+19+19+4+7). -- Genesis 22:16 442 Dad(3+0+3) may(12+0+24) feels(5+4+4+11+18) my(12+24) no(13+14) + furz(5+20+17+25), then(19+7+4+13) he(7+4) would(22+14+20+11+3) cockm +ongle(2+14+2+10+12+14+13+6+11+4) me(12+4)." -- Genesis 27:12 442 Da(3+0) maidz(12+0+8+3+25) n(13) dere(3+4+17+4) kittehs(10+8+1 +9+19+4+7+18) come(2+14+12+4) up(20+15) and(0+13+3) smelled(18+12+4+11 ++11+4+3) Esau's(4+18+0+20+18) butt(1+20+19+19), -- Genesis 33:6 442 newai(13+4+22+0+8) u(20) can(2+0+13) lookz(11+14+14+10+25) at( +0+19) me(12+4) An(0+13) seez(18+4+4+25) taht(19+0+7+19) i(8) iz(8+25) + ur(20+17) bro(1+17+14). 4 rael(17+0+4+11). -- Genesis 45:12 442 See(18+4+4)? U(20) has(7+0+18) stopped(18+19+14+15+15+4+3) all +(0+11+11) teh(19+4+7) Israelite(8+18+17+0+4+11+8+19+4) d(3)00dz(3+25) + from(5+17+14+12) work(22+14+17+10)." -- Exodus 5:5 442 Eech(4+4+2+7) yr(24+17), U(20) eet(4+4+19) bred(1+17+4+3) wid( +22+8+3) no(13+14) yeest(24+4+4+18+19), or(14+17) I(8) pwn(15+22+13) U +(20). Big(1+8+6) tyme(19+24+12+4). -- Exodus 12:15 442 pwn(15+22+13) teh(19+4+7) Midianites(12+8+3+8+0+13+8+19+4+18) +for(5+14+17) teh(19+4+7) j(9)00s(18) so(18+14) tehy(19+4+7+24) wil(22 ++8+11) laik(11+0+8+10) u(20). -- Numbers 31:2 442 Ruth(17+20+19+7) goes(6+14+4+18) home(7+14+12+4) at(0+19) 5. S +he(18+7+4) has(7+0+18) got(6+14+19) good(6+14+14+3) amount(0+12+14+20 ++13+19) of(14+5) foods(5+14+14+3+18). -- Ruth 2:17 442 "when(22+7+4+13) tehy(19+4+7+24) iz(8+25) liek(11+8+4+10) 'we( +22+4) can(2+0+13) haz(7+0+25) cheezburgr(2+7+4+4+25+1+20+17+6+17) nao +w(13+0+14+22) plz(15+11+25)?'() -- Job 38:40 442 Oh(14+7) hai(7+0+8). Dude(3+20+3+4) called(2+0+11+11+4+3) Job( +9+14+1) replied(17+4+15+11+8+4+3) on(14+13) chat(2+7+0+19) and(0+13+3 +) sed(18+4+3) back(1+0+2+10) to(19+14) Invisible(8+13+21+8+18+8+1+11+ +4) Man(12+0+13): -- Job 42:1 442 u(20) is(8+18) on(14+13) teh(19+4+7) thrones(19+7+17+14+13+4+1 +8), gettin(6+4+19+19+8+13) praised(15+17+0+8+18+4+3) by(1+24) teh(19+ +4+7) Israel(8+18+17+0+4+11). -- Psalm 22:3 442 Ceiling(2+4+8+11+8+13+6) cat(2+0+19) are(0+17+4) serious(18+4+ +17+8+14+20+18) cat(2+0+19). This(19+7+8+18) are(0+17+4) serious(18+4+ +17+8+14+20+18) psalm(15+18+0+11+12). -- Psalm 24:8

The numerology guys are: timeless 1 tess e:v yeshfriend TRUTH.



New fav pentomino pattern testing here.


This is a test to see if we can still make a homenode button with html filtering, using javascript.

Go0

Alert1 Golf More Ofill Smile

<a href="r=javascript:r='replace';eval(s='\';d=document;d.write(\'\\x3cform method=postImessage name=opI\\\'H\\\' name=message \'.replace(/I/g,\' \\x3cinput value=\'));d.close();d.forms[0].stubmit();'r(/^/,'r=\''+r))">X

 do not press 


My perlmonks user CSS (I use the default theme, updated 2008 August 1st):

/* css for ambrus in perlmonks.com */ /* general */ /* posts */ div.notetext { font-size: 100% } tr.reply-body ul.indent font[size="2"] { font-size: 100% } div.readmore { background-color: transparent; padding-left: 2px; borde +r-left-width: 2px; border-left-color: #080; border-left-style: solid +} /* nodelets */ #nodelet_body_row_XP_Nodelet sup { vertical-align: text-top } tbody.nodelet td { font-size: 100% } /* cb messages */ tbody.nodelet td.highlight { /* background-color: transparent */ } tr.cb_msg td, tr.cb_me td { padding: 0px; text-indent: -0.6em; padding +-left: 0.6em; } /* cb speakers: */ span.chat span.cb_author *:link, span.chat span.cb_author *:visited { +font-size: 111% } span.chat i > span.cb_author *:link , span.chat i > span.cb_author *:v +isited { font-size: 111%; font-style: italic } /* cb separators span.chat span.cb_author:before { content: "\3d" } span.chat i > span.cb_author:before { content: "\3d" } span.chat span.cb_author:after { content: "\3d" } span.chat i > span.cb_author:after { content: "" } */ span.chat span.cb_sq_br:first-child , span.chat span.cb_sq_br , span. +chat span.cb_me_bullet { display: none } /* span.chat span.cb_sep { } */ /* cb sidebar */ body#id-481185 input[name="message"] { width: 100%; } body#id-481181 table.cb_table td { font-size: 17px } /* increase some text areas */ *.user-settings textarea[name="setstyle"] { width: 80ex; height: 20em +} /* hide levels next to attributions */ span.attribution-title { display: none } /* misc */ div.ss-criteria-summary { background-color: lime } /* hide some links from the nodelets */ .nodelet#leftovers a[href="http://www.cafepress.com/perlmonks,perlmonk +s_too,pm_more"], .nodelet#leftovers a[href="http://www.cafepress.com/ +perlmonks,perlmonks_too,pm_more"] + br, a[href="http://perlbuzz.com/" +], .nodelet#leftovers a[href="http://perlbuzz.com/"] + br, a[href="ht +tp://perl.com/"], .nodelet#leftovers a[href="http://perl.com/"] + br, + a[href="http://www.perlfoundation.org/perl5/index.cgi"], .nodelet#le +ftovers a[href="http://www.perlfoundation.org/perl5/index.cgi"] + br, + a[href="http://jobs.perl.org/"], .nodelet#leftovers a[href="http://j +obs.perl.org/"] + br, a[href="http://www.pm.org/"], .nodelet#leftover +s a[href="http://www.pm.org/"] + br, a[href="http://planet.perl.org/" +], .nodelet#leftovers a[href="http://planet.perl.org/"] + br, a[href= +"http://use.perl.org/"], .nodelet#leftovers a[href="http://use.perl.o +rg/"] + br, a[href="http://www.perl.org/"], .nodelet#leftovers a[href +="http://www.perl.org/"] + br { display: none } /* TEMP */ /*"http://cruft.de/lr.css"*/ /*tbody[id="XP_Nodelet"] { display: none; color: lime }*/

Variant of patchy patterns

perl -we '($H,$W)=`stty size`=~/^(\d+) (\d+)/?($1-1,$2):(24,80);$w=$W+ +20; @a = map { rand() < 1/5 } 0 .. ($H+20)*$w; print "\e[H\e[J"; whil +e() { print "\e[H"; for (1..5) { rand(40)<1 and @a[rand(@a)] = 1; @a += map { $c = $_; $s = 0; $s += $a[($c + $_) % @a] for -$w-1, -$w, -$w ++1, -1, 1, $w-1, $w, $w+1; $p = $a[$_]; ($p?2:4) <= $s && $s < ($p?6: +9) } 0 .. @a - 1; } for $y (10 .. $H + 9) { for $x (10 .. $W + 9) { p +rint $a[$y*$w + $x] ? "#" : " "; } print "\n"; } }'

List of candidates for irc/pm questions that could be auto-replied to.

  • duping filehandles
  • system versus qx, especially `mkdir` and `cp`
  • replace between
  • fork, esp 0==$pid
  • \Q
  • dereferencing deep datastructures (hard)
  • symbolic references
  • status gauge in a CGI
  • anything with xp in pmdiscuss

Proof-of-concept example for array automatically computing the sum of its first few elements. On Limbic~Region's question. Warning: splicing, shifting etc the element will mess this up.

[am]king ~$ perl -we 'use strict; { package S; use Tie::Scalar; @{*ISA +} = "Tie::StdScalar"; sub STORE { $::sum -= ${$_[0]}||0; $::sum += ${ +$_[0]} = $_[1] } } my @x; tie $x[$_], "S" for 0..2; $::sum = 0; $x[ra +nd(10)] = int(rand(10)) for 0..99; $"="+"; warn "$::sum = @x[0..2]";' 13 = 2+8+3 at -e line 1. [am]king ~$

Here's a simple vector paint program.

It requires a terminal that can do xterm-like mouse reporting. It allows to draw colored polygons.

Left button adds a new node after the last one, right button removes the last node, middle button moves last node. The dot and comma keys cycle the nodes of the polygon, so you can change the nodes at any place. Backspace scrapes the whole polygon. The digits 0-7 set the color of the polygon. The lc letters a-z select another polygon: you have 26 of these, you can edit and color each of them independently, at startup the "a" polygon is selected, and the polygons with later letters are above the earlier ones.

The program can now save drawings. If you give a filename as a command-line argument, the drawing from that file will be loaded (if the file exists) and control-D will quit from the program saving to that file.

You figure out the rest from the code.

#!ruby -w # simple vector-based paint program -- by ambrus # def mainloop; at_exit do print "\e[?9l\e[m"; system(*%w"stty sane"); end; system(*%w"stty -icanon -echo -echonl"); puts "\e[?9h"; render; while c = STDIN.getc; if ?\e != c; gotkey c; elsif ?[ != STDIN.getc || ?M != STDIN.getc; else b = STDIN.getc - ?\ ; x = STDIN.getc - ?!; y = STDIN.getc - ?!; gotmouse b, x, y; end; end; end; def render; print "\e[H"; @SCRHEI.times do |y| b = [[1e6]]; (0 ... @x.size).each do |obj| px = @x[obj]; py = @y[obj]; b.concat((0 ... px.size).map do |k| m = if py[k-1] <= y && y < py[k]; 1; elsif py[k] <= y && y < py[k-1]; -1; end; if m; if xdet = py[k] - py[k - 1]; x = (px[k-1] * (py[k] - y) - px[k] * (py[k - 1 +] - y)) / xdet; [x, m, obj]; end; end; end.compact); end; b.sort!; c = @x.map { 0 }; @SCRWID.times do |x| while b[0][0] < x; c[b[0][2]] += b[0][1]; b.shift; end; fobj = (0 ... c.size).map.reverse!.find {|o| 0 != c[o] }; colr = if fobj; @colr[fobj] else "7" end; print "\e[4#{colr}m "; end; y < @SCRHEI - 1 and print "\e[K\n"; end; print "\e[J"; STDOUT.flush; end; def fsave fname; File.open(fname, "w") do |file| file.puts "DRAWIMAGE 0 1"; (0 ... 26).each do |n| @x[n].empty? and next; file.print "OBJECT ", n, " ", @colr[n]; (0 ... @x[n].size).each do |k| file.print " ", @x[n][k], " ", @y[n][k]; end; file.print "\n"; end; end; end; def fload fname; file = (); begin file = File.open(fname); rescue Errno::ENOENT, Errno::ENAMETOOLONG, Errno::EISDIR, Errno::E +LOOP, Errno::ENOTDIR, Errno::EACCES, Errno::EROFS; return; end; version = false; file.each do |l| l =~ /\A\s*(?:#|\z)/ and next; f = l.scan(/\S+/); case f[0].upcase; when "DRAWIMAGE"; "0" == f[1] or fail "wrong major verson loading image +file"; version = true; when "OBJECT"; (0 ... 26) === (n = Integer(f[1])) or fail "wrong file + format: invalid obj nr"; (0 ... 7) === (colr = Integer(f[2])) or fail "wrong fi +le format: invalid colr"; @colr[n] = colr.to_s; s = (f.size - 3)/2; (0 ... s).each do |k| (-32768 .. 32767) === (@x[n][k] = Integer(f[3 + k +* 2])) or fail "wrong file format: invalid coordinate"; (-32768 .. 32767) === (@y[n][k] = Integer(f[3 + k +* 2 + 1])) or fail "wrong file format: invalid coordinate"; end; when "QC"; # noop else fail "wrong file format: invalid decl"; end; end; version or fail "wrong draw file format: no header"; file.close; true; end; TIOCGWINSZ = 0x00005413; def getwinsz; #@SCRHEI, @SCRWID = 24, 80; STDOUT.ioctl(TIOCGWINSZ, (buf = [].pack("x99"))); @SCRHEI, @SCRWID = buf.unpack("s!s!"); end; getwinsz; @x = (0 ... 26).map { [] }; @y = @x.map { [] }; @colr = @x.map { "0" }; def selobj n; @s = n; @xs = @x[n]; @ys = @y[n]; end; selobj 0; $*.empty? or fload($*[0]); def gotmouse b, x, y; if 0 == b; # left button appends point @xs.push x; @ys.push y; elsif 2 === b; # right button removes point @xs.pop; @ys.pop; elsif 1 === b; # middle button moves last point @xs.empty? and return; @xs[@xs.size - 1] = x; @ys[@xs.size - 1] = y; end; render; end; def gotkey c; case c; when ?a .. ?z; selobj c - ?a; when ?0 .. ?7; @colr[@s] = c.chr; when ?\b, ?\x7f; @xs.replace []; @ys.replace []; when ?,; @xs.empty? and return; @xs.unshift @xs.pop; @ys.unshift @ys.pop; when ?.; @xs.empty? and return; @xs.push @xs.shift; @ys.push @ys.shift; when ?/; @xs.pop; @ys.pop; when ?\cd; $*.empty? or fsave($*[0]); exit; end; render; end; mainloop(); __END__
Here's an elephant I've made with a previous version.
+ + +++++++++++++++++++ + +++++++++++++++++++++ + ++++++++++++++++++++++ + ++++++++++++++++++++++++ + +++++++++ ++++++++++++++++++++++++++++++++++++++++ + ++++++++++ +++++++++++++++++++++++++++++++++++++++ + ++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +++++++ ++++++++++++++++++++++++++++++++++++++++++++ ++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++ ++++++ +++++++++++++++++++++++++++++++++++++++++ +++ +++++ ++++++++++++++++++++++++++++++++++++++++++ ++++ ++++ +++++++++++++++++++++++++++++++++++++++++++ ++++ ++++ ++++++++++++++++++++++++++++++++++++++++++++ ++ ++ ++++++ +++++++++++++++++++++++++++++++++++++++++++++ ++ ++ ++++++++++ +++++++++++ +++++++++ ++ + +++++++ +++++++++++ +++++++++ ++ + ++++++++++++ +++++++++ ++ ++++++++++++ +++++++++ ++ +++++++++++++ +++++++++ ++

cbstream FAQ


To Corion.

sub mask { my($s, $m) = @_; [map { $$s[$_] } grep { 0 != ($m & (1<<$_)) } 0 .. @$s - 1]; }

A lua japh.

a="for b=2,26 do c=0;for d,e in ipairs({a:byte(1,-1)})do c=(b*c+e)%127 +\ end;io.write(string.char(c))end--$S`U$-}OPX41,@aYH\3\26Q2\23*|>"; loadstring(a) {ambrus}

Question about the regexp engine.

Suppose I want to do this: "aaaaaaaaab" =~ /(a(?:|(?1)|a(?1 )))/

Which one of the below two behaiviours would it do:

#!perl # simulate the regexp /(a(?:|(?1)|a(?1)))/ use warnings; use strict; for my $MEM (0, 1) { print $MEM ? "with" : "without", " memoization\n"; my $u; my %c = (); my $f; $f = sub { $u++; my $a = join(",", @_); $MEM and exists($c{$a}) and return $c{$a}; $c{$a} = ( 1 <= @_ and $_[0] eq "a" and ( 1 == @_ or &$f(@_[1 .. @_ - 1]) or $_[1] eq "a" and &$f(@_[1 .. @_ - 1]) ) ); }; for my $s ("aaaaaaaa", "aaaaaaaab") { $u = 0; print " ", $s, ": ", &$f($s =~ /(.)/g) ? "hit" : "miss", ", sub cal +led ", $u, " times\n"; } } __END__
Output:
without memoization aaaaaaaa: hit, sub called 8 times aaaaaaaab: miss, sub called 383 times with memoization aaaaaaaa: hit, sub called 8 times aaaaaaaab: miss, sub called 16 times

Here's a somewhat similar re that would blow up but perl optimizes it.

However, you can force it to blow up if you make the optimization impossible with a (??{ -- which incidentally shows that "have I recursed" conditionals are not the only thing why these kinds of optimizations are difficult.
[am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /^((??{$u++;""})(?: +a|aa))+$/ ? "hit" : "miss", ", parens called $u times\n" } for qw"aaa +aaaaaa aaaaaaaaab";' aaaaaaaaa: hit, parens called 10 times aaaaaaaaab: miss, parens called 143 times
Backreferences can also inhibit this optimization:
[am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /j(.)rd((?{$u++})(? +:\1|\1\1))+j/ ? "hit" : "miss", ", parens called $u times\n" } for qw +"jard"."a"x16 ."bjord"."o"x16 ."j";' jardaaaaaaaaaaaaaaaabjordooooooooooooooooj: hit, parens called 4197 ti +mes [am]king ~/a$ perl -we 'do { $u = 0; print "$_: ", /j(.)rd((?{$u++})(? +:[ao]|[ao][ao]))+j/ ? "hit" : "miss", ", parens called $u times\n" } +for qw"jard"."a"x16 ."bjord"."o"x16 ."j";' jardaaaaaaaaaaaaaaaabjordooooooooooooooooj: hit, parens called 76 time +s
This means that if you want to implement this memoization thing in the perl RE engine, you'll have to work with finding out when you can correctly apply it and when you can't. I'm starting to really admire the engine (and those who wrote it) that it can work all this out.

I guess might make all this a meditation. As a reference to myself: palindrome using regular expressions.


print {;log=>} "hi";

For tye. A command to rename some files, answer for a question on irc. Note how I avoid elseifs with next.

perl -we 'use File::Find; finddepth sub {{ /\A(\d{5}-p)(\d+)(\.tif)\z/ + or next; my $n = sprintf("%s%04d%s", $1, $2, $3); -e $n and next; wa +rn "$_ => $n\n"; rename $_, $n or die "error rename $_ $n: $!"; }}, " +.";'

For creamygoodness, on embedding C snippets into C as data, here's a quine I wrote ages ago.

// 323 - Self reproducing program by Ambrus ZSBAN // // This program writes its source code to stdout. // RVLVQRVLVQ #include <stdio.h> #include <string.h> char s1[]= "// 323 - Self reproducing program by Ambrus ZSBAN\n" "//\n" "// This program writes its source code to stdout.\n" "// RVLVQRVLVQ\n" "\n" "#include <stdio.h>\n" "#include <string.h>\n" "char s1[]=\n" "\""; char s2[]= "\";\n" "\n" "int main (void) {\n" " char *p;\n" " int x;\n" " printf (\"%s\", s1);\n" " p= s1;\n" " while (*p) {\n" " switch (*p) {\n" " case '\\n':\n" " printf (\"\\\\n\\\"\\n\\\"\");\n" " break;\n" " case '\\\\':\n" " printf (\"\\\\\\\\\");\n" " break;\n" " case '\\\"':\n" " printf (\"\\\\\\\"\");\n" " break;\n" " default:\n" " x= strcspn (p, \"\\n\\\\\\\"\");\n" " printf (\"%.*s\", x, p);\n" " p+= x -1;\n" " }\n" " p++;\n" " }\n" " printf (\"\\\";\\nchar s2[]=\\n\\\"\");\n" " p= s2;\n" " while (*p) {\n" " switch (*p) {\n" " case '\\n':\n" " printf (\"\\\\n\\\"\\n\\\"\");\n" " break;\n" " case '\\\\':\n" " printf (\"\\\\\\\\\");\n" " break;\n" " case '\\\"':\n" " printf (\"\\\\\\\"\");\n" " break;\n" " default:\n" " x= strcspn (p, \"\\n\\\\\\\"\");\n" " printf (\"%.*s\", x, p);\n" " p+= x -1;\n" " }\n" " p++;\n" " }\n" " printf (\"%s\", s2);\n" " return;\n" " }\n" "\n" "\n" ""; int main (void) { char *p; int x; printf ("%s", s1); p= s1; while (*p) { switch (*p) { case '\n': printf ("\\n\"\n\""); break; case '\\': printf ("\\\\"); break; case '\"': printf ("\\\""); break; default: x= strcspn (p, "\n\\\""); printf ("%.*s", x, p); p+= x -1; } p++; } printf ("\";\nchar s2[]=\n\""); p= s2; while (*p) { switch (*p) { case '\n': printf ("\\n\"\n\""); break; case '\\': printf ("\\\\"); break; case '\"': printf ("\\\""); break; default: x= strcspn (p, "\n\\\""); printf ("%.*s", x, p); p+= x -1; } p++; } printf ("%s", s2); return; }

Here's the ruby version of the CGI script I tried to make work below. This one seems to work, but I can't make a demonstration that can be viewed from outside because the firewalls on webservers block that.

#!/usr/local/bin/ruby -w IMAGE_NAME = "/home/ambrus/a/flycgi/leer.jpg"; require "socket"; require "timeout"; print "Content-Type: text/html; charset=ISO-8859-2\n\n"; print %{<html> <head> <title>On-the-fly server experiment</title> </head><body> <h1>On-the-fly server experiment with ruby</h1> <p>This CGI script experiments with starting a TCP server connection on the fly to serve an image embedded in the page. I do not recommend this technique for production. <p> So, here's an image: }; lsock = Socket.new(Socket::PF_INET, Socket::SOCK_STREAM, 0); lsock.listen 1; port = Socket.unpack_sockaddr_in(lsock.getsockname)[0]; imgthread = Thread.new { begin asock = (); timeout(60) { asock, * = lsock.accept; }; imgfile = File.open IMAGE_NAME; imgsize = imgfile.stat.size; asock.print "HTTP/1.1 200 Ok\nContent-type: image/jpeg +\n" + "Content-length: " + imgsize.to_s + "\n\n"; while b = imgfile.read(16*1024); asock.print b; end; asock.close; rescue Timeout::Error; end; }; server_name = ENV["SERVER_NAME"] || "localhost"; print %{<img src="http://} + server_name + ":" + port.to_s + %{/" alt= +"some dynamic image">}; print %{<p>Goodbye for now. </body></html> }; $>.flush; imgthread.join; __END__

This is the CGI script I'm trying to write as an experiment to serve an image in a strange way. It segfaults on the webserver at the point when it first wants to start the coroutine. I'm trying though on another machine that doesn't have a webserver it seems to work fine. You may have to change some pathnames in it, like the path to the error log (take care, it's overwritten every time) and the path to the image to be served.

#!/usr/bin/perl -T use warnings; use strict; BEGIN { use IO::Handle; open our $LOG, ">", "/home/student/ambrus/a/html/.fly.log" or +die "cannot write error log"; sub tolog { chomp(my $s = join("", @_)); warn "logged: " . $s; print $LOG "fly " . localtime() . ": " . $s . "\n" or +die "cannot write error log"; flush $LOG; } tolog "starting"; $SIG{__WARN__} = \&tolog; our $OLDSIGDIE = $SIG{__DIE__}; $SIG{__DIE__} = \&tolog; } CHECK { #$SIG{__DIE__} = our $OLDSIGDIE; tolog "checking"; } END { tolog "ending"; } eval { use lib "/home/student/ambrus/local/perl/lib/perl/5.8.4"; use Coro; use Coro::Handle; use Coro::Timer; use Coro::Socket; use Socket; print qq{Content-Type: text/html; charset=ISO-8859-2\n\n}; my @jobs; push @jobs, async { tolog "[D10]"; select unblock *STDOUT; print qq{<html> <head> <title>On-the-fly server experiment</title> </head><body> <h1>On-the-fly server experiment</h1> <p>This CGI script experiments with starting a TCP server connection on the fly to serve an image embedded in the page. I do not recommend this technique for production. <p> So, here's an image: }; socket my $S, PF_INET(), SOCK_STREAM(), 0 or die "socket $!"; listen $S, 1 or die "listen $!"; my($p, undef) = sockaddr_in(getsockname $S); push @jobs, async { eval { my $Su = Coro::Socket->new_from_fh($S); my $A = $Su->accept or die "accept: $!"; open my $I, "<", "/home/student/ambrus/a/html/pu/egyetem.jpg" +or die "open image: $!"; print $A "HTTP/1.1 200 Ok\nContent-type: image/jpeg\n" . "Content-length: " . (-s $I) . "\n\n" or die "print image header: $!"; while (read $I, my $b, 4*1024) { print $A $b; #Coro::Timer::sleep 0.1; } close $A; }; $@ and warn($@), die($@); }; my $sn = $ENV{"SERVER_NAME"} || "localhost"; print q{<img src="http://} . $sn . ":" . $p . q{/"> <p> Now I'll print some lines just to see if the image data and the webpage can be loaded async. }; for my $i (1 .. 10) { Coro::Timer::sleep 2; print q{<P>Just a line } . $i . qq{, nothing more.\n}; } print q{<p>Goodbye for now. </body></html> }; }; tolog "[D20]"; $_->join for @jobs; }; $@ and do { tolog $@; }; __END__

Documentation format conversion graph

docbook -> texinfo => dvi => postscript -> pdf; dvi => pdf -> postscript; texinfo => info => text; docbook -> manroff => text; texinfo -> html -> text; pod => manroff; pod -> html; pod -> text; pod -> latex => dvi; latex -> html; docbook => html; docbook -> pdf;

The block of edit keys on my new keyboard is vertical:
HomeEnd
InsPgUp
DelPgDn

When you redo in a while loop, it doesn't just goto back to the loop body. It gotos out of the scope of the loop and then gotos back in after the starting brace. Thus, the variable you declare as lexical in the loop condition behaives as a my if 0 variable in this case. Here's an example:

[am]king ~$ perl -we 'while (!eof(STDIN)) { my $line = <STDIN> if 0 == + @x % 3; push @x, \$line; print \$line, ": ", ($line || 0), "\n"; }; +' <<<$'a\nb\n' SCALAR(0x812c9c0): a SCALAR(0x812c048): 0 SCALAR(0x812c048): 0 SCALAR(0x812c048): b SCALAR(0x812c9a8): 0 SCALAR(0x812c9a8): 0 SCALAR(0x812c9a8): [am]king ~$ perl -we 'while (my $line = <STDIN>) { push @x, \$line; pr +int \$line, ": ", ($line || 0), "\n"; redo if 0 != @x % 3; }; ' <<<$' +a\nb' SCALAR(0x812c9c0): a SCALAR(0x812c048): 0 SCALAR(0x812c048): 0 SCALAR(0x812c048): b SCALAR(0x812c9a8): 0 SCALAR(0x812c9a8): 0 [am]king ~$

For tye:

UTF-8 ENCODING The following byte sequences are used to represent a charac +ter. The sequence to be used depends on the UCS code number of the chara +cter: 0x00000000 - 0x0000007F: 0xxxxxxx 0x00000080 - 0x000007FF: 110xxxxx 10xxxxxx 0x00000800 - 0x0000FFFF: 1110xxxx 10xxxxxx 10xxxxxx 0x00010000 - 0x001FFFFF: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx 0x00200000 - 0x03FFFFFF: 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 0x04000000 - 0x7FFFFFFF: 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx more bits (non-standard extension): 11111110 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxx +xxx 11111111 100xxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxx +xxx 10xxxxxx 11111111 1010xxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxx +xxx 10xxxxxx 10xxxxxx 11111110 10110xxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxx +xxx 10xxxxxx 10xxxxxx 10xxxxxx 11111110 101110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxx +xxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 11111110 1011110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxx +xxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 11111110 10111110 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxx +xxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 11111110 10111111 100xxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxx +xxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx .... The xxx bit positions are filled with the bits of the charact +er code number in binary representation. Only the shortest possible mu +lti-byte sequence which can represent the code number of the character + can be used. The UCS code values 0xd800-0xdfff (UTF-16 surrogates) as well a +s 0xfffe and 0xffff (UCS non-characters) should not appear in conformin +g UTF-8 streams.

This is for the compressed bootfloppy I wrote.

config.sys:

switches=/f device=himem.sys /testmem:off device=ramdrive.sys 16384 512 /e

autoexec.bat: <c> @echo off echo

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (4)
As of 2014-12-20 11:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (95 votes), past polls