Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

blokhead's scratchpad

by blokhead (Monsignor)
on Jun 01, 2004 at 18:39 UTC ( #358374=scratchpad: print w/ replies, xml ) Need Help??

I have set up on a Manchester computer a small programme using only 1000 units of storage, whereby the machine supplied with one sixteen figure number replies with another within two seconds. I would defy anyone to learn from these replies sufficient about the programme to be able to predict any replies to untried values. -- Alan Turing

for Limbic~Region

Here is a somewhat open-ended computational question/puzzle. Bear with me!

I'm working on laying out an online photo gallery containing photos of various dimensions. The photos will be laid out in a grid, and each photo has varied dimensions that are multiples of the grid size. So you can think of the photos as sized 1x1, 2x3, 1x4, etc.

I came across a Flash app that can display a list of photos in a grid spanning multiple "pages". Since the photos have varied dimensions, you can't just place photos blindly in the grid. So this app goes from left-to-right, top-to-bottom, across the available grid locations, and inserts the first photo in the list that fits legally. When a page is full (or no photos can fit in it anymore), we start the next page.

Example: Suppose there's a 4x3 grid to fill, and the photos have dimensions (2x2, 3x1, 1x1, 1x2, 2x1, 1x2, 1x1), in that order:

+-+-+-+-+ |?| | | | first step: place a photo in the "?" cell +-+-+-+-+ | | | | | available photos: 2x2, 3x1, 1x1, 1x2, 2x1, 1x2, 1x1 +-+-+-+-+ *** | | | | | +-+-+-+-+ first photo that fits is the 2x2 +---+-+-+ |///|?| | next step: place a photo in the "?" cell |///+-+-+ |///| | | available photos: 3x1, 1x1, 1x2, 2x1, 1x2, 1x1 +-+-+-+-+ *** | | | | | +-+-+-+-+ first photo that fits is the 1x1 +---+-+-+ |///|/|?| next step: place a photo in the "?" cell |///+-+-+ |///| | | available photos: 3x1, 1x2, 2x1, 1x2, 1x1 +-+-+-+-+ *** | | | | | +-+-+-+-+ first photo that fits is the 1x2 +---+-+-+ |///|/|/| next step: place a photo in the "?" cell |///+-+/| |///|?|/| available photos: 3x1, 2x1, 1x2, 1x1 +-+-+-+-+ *** | | | | | +-+-+-+-+ first photo that fits is the 1x2 +---+-+-+ |///|/|/| next step: place a photo in the "?" cell |///+-+/| |///|/|/| available photos: 3x1, 2x1, 1x1 +-+-+/+-+ *** |?| |/| | +-+-+-+-+ first photo that fits is the 2x1 +---+-+-+ |///|/|/| next step: place a photo in the "?" cell |///+-+/| |///|/|/| available photos: 3x1, 1x1 +---+/+-+ *** |///|/|?| +---+-+-+ first photo that fits is the 1x1
After this point, the 3x1 still remains, and would start the next page.

Now, the photos look best when the arrangement and dimensions are varied. So the problem is to find an arrangement (permutation) of the given images that looks best. But it's challenging to come up with a metric for what looks good. Ideas I've had so far:

  • minimize the number of corners in which 4 photos touch (totaled across all pages). The example above is a nice one, since this never happens. But switching two of the photos would give the following arrangement, with 2 "bad" corners:
    +---+-+-+ |///|/|/| |///|/|/| |///|/|/| +---+-+-+ |///|/|/| +---+-+-+
  • maximize the number of different photo sizes used per page
  • minimize the number of times the most common image size is used on a page (to reward having an even distribution among a variety of sizes)
  • a weighted combination of all of the above
So my questions are the following:
  1. Given a list of photo dimensions and the size of the grid, find a permutation that results in the best layout. It need not be the globally optimal arrangement, but I would be interested in any approach better than trying a bunch of random permutations and taking the best one.
  2. Can you recommend a better metric for measuring the "visual appeal" of an arrangement?
Observations so far:
  • To keep track of a "bad" corner, just do the following. Every time you place a photo with top-left corner at position (x,y), check whether there is a photo whose bottom-right corner is at (x-1,y-1).
I do have some code that computes the arrangement, given the list of dimensions. And I have an OK scoring metric. But I'm not doing anything smarter than doing lots of random permutations and taking the best one...

for Limbic~Region

{ my %seen; my %onstack; my @list; sub how_to_uninstall { my $target = shift; (@list, %seen, %onstack) = (); _traverse($target); return @list; } sub _traverse { my $x = shift; $seen{$x} = $onstack{$x} = 1; foreach package $y that depends on $x { die "cyclic!" if $onstack{$y}; # back edge _traverse($y) unless $seen{$y}; } push @list, $x; $onstack{$x} = 0; } }
Returns a topologically sorted list of the packages that must be uninstalled in order to uninstall $target. Convention: If package $y depends on package $x, then package $y must be uninstalled before $x.

for ww

The raw PM markup souce for Re: RFC: Monastery Markup Introduction:
<table border=1> <tr><td></td><th>PM Markup:</th><th>Result:</th></tr> <tr><td>paragraphs / line breaks</td><td> <pre> &lt;p&gt;first paragraph&lt;/p&gt; &lt;p&gt;second paragraph&lt;/p&gt; </pre> </td><td> <p>first paragraph</p> <p>second paragraph</p> </td></tr> <tr><td rowspan=3>link to nodes by name</td><td> <pre> Have you tried &#91;Super Search]? </pre> </td><td> Have you tried [Super Search]? </td></tr> <tr><td> <pre> Thanks for your help, &#91;tye] </pre> </td><td> Thanks for your help, [tye] </td></tr> <tr><td> <pre> Thanks for nothing, &#91;tye|wiseguy] </pre> </td><td> Thanks for nothing, [tye|wiseguy] </td></tr> <tr><td>link to nodes by ID</td><td> <pre> Please consult &#91;id://3989] </pre> </td><td> Please consult [id://3989] </td></tr> <tr><td rowspan=3>other kinds of links<p>([id://43037|more info])</td> +<td> <pre> Check out &#91;pad://NodeReaper] </pre> </td><td> Check out [pad://NodeReaper] </td></tr> <tr><td> <pre> Did you try &#91;http://google.com|this]? </pre> </td><td> Did you try [http://google.com|this]? </td></tr> <tr><td> <pre> Did you check &#91;doc://perlfaq]? </pre> </td><td> Did you check [doc://perlfaq]? </td></tr> <tr><td rowspan=2>including code in text</td><td> <pre> The result is in &lt;c>$array[0]&lt;/c> </pre> </td><td> The result is in <c>$array[0]</c> </td></tr> <tr><td> <pre> The code should read: &lt;c> use strict; use warnings; my @array = ("Hello world\n"); if (@ARGV) { print $array&#91;0]; } &lt;/c> </pre> </td><td> The code should read: <c> use strict; use warnings; my @array = ("Hello world\n"); if (@ARGV) { print $array[0]; } </c> </td></tr> <tr><td rowspan=3>text/font formatting</td><td> <pre> This will be &lt;b>bold&lt;/b> </pre> </td><td> This will be <b>bold</b> </td></tr> <tr><td> <pre> This will be &lt;i>italic&lt;/i> </pre> </td><td> This will be <i>italic</i> </td></tr> <tr><td> <pre> This will be &lt;tt>fixed width&lt;/tt> </pre> </td><td> This will be <tt>fixed width</tt> </td></tr> <tr><td>quoting / indenting</td><td> <pre> A wise monk once said: &lt;blockquote> "Indenting is good" &lt;/blockquote> .. and I agree </pre> </td><td> A wise monk once said: <blockquote> "Indenting is good" </blockquote> .. and I agree </td></tr> <tr><td rowspan=2>lists</td><td> <pre> My favorite flavors are: &lt;ul&gt; &lt;li&gt;vanilla&lt;/li&gt; &lt;li&gt;chocolate&lt;/li&gt; &lt;/ul&gt; </pre> </td><td> My favorite flavors are: <ul> <li>vanilla</li> <li>chocolate</li> </ul> </td></tr> <tr><td> <pre> How to make toast: &lt;ol&gt; &lt;li&gt;insert bread&lt;/li&gt; &lt;li&gt;press button&lt;/li&gt; &lt;/ol&gt; </pre> </td><td> How to make toast: <ol> <li>insert bread</li> <li>press button</li> </ol> </td></tr> </table>

For Petruchio:

Simple recursive type inferencing engine. Hopefully this contains enough interesting examples. And hopefully you can parse my language-schizophrenic pseudocode.

# input: # - env = mapping of variable names to types # - expr = an expression (AST) # # output: # - type = a type "judgment" # - constraints = a list of type constraints that must be satisfied def infer_type( env, expr ): case expr: ## wow, a literal integer has type IntType! LiteralIntExpr( thenumber ): return ( IntType, {} ); # no constraints ## similar rules for other kinds of literals ... ## here's an interesting one: ## empty lists are polymorphic EmptyListExpr(): return( ListExpr( fresh PolymorphicType ), {} ); # no cons +triants ## fresh PolymorphicType means make a new PolymorphicType with ## a never-before-used identifying number/letter ## list expression: [item1, ... itemn] ## - infer the type of each item ## - pass along constraints from the subexpressions ## - add constraints that all items have the same type ListExpr( item1, ... itemn ): (type1, constr1) = infer_type( env, item1 ); ... (typen, constrn) = infer_type( env, itemn ); ## union of these lists of const +raints return ( ListType(type1), constr1 + ... + constrn + "type1==type2" + ... + "type +1==typen" ); ## someone names a variable? if it doesn't have a type ## in our environment, we are hosed! otherwise, the ## environment contains a type mapping for the variable VariableExpression( varname ): croak if not exists env{varname}; return ( env{varname}, {} ) # no constraints ## for addition expression: ## - return IntType ## - constrain both args to be IntType ## - pass along constraints from subexpressions AdditionExpression( subexpr1, subexpr2 ): (type1, constr1) = infer_type( env, subexpr1 ); (type2, constr2) = infer_type( env, subexpr2 ); ## union of these lists of constraints return (IntType, constr1 + constr2 + "type1==IntType" + "type2==IntType") +; ## for concatenation: ## - same as above, but with StrType ConcatExpression( subexpr1, subexpr2 ): (type1, constr1) = infer_type( env, subexpr1 ); (type2, constr2) = infer_type( env, subexpr2 ); ## union of these lists of constraints return ( StrType, constr1 + constr2 + "type1==StrType" + "type2==StrType" +); ## list cons expression: i.e,: head::tail ## - return the same type as the tail ## - ensure that the head has the same type as ## tail's elements ListConsExpression( head, tail ): (type1, constr1) = infer_type( env, head ); (type2, constr2) = infer_type( env, tail ); return ( type2, constr1 + constr2 + "type2==ListType(type1 +)" ); ## fun var -> body ## - assign var a fresh type ## - infer the type of the body in a modified environment ## - return an appropriate function type FuncDefExpression( var, body ): vartype = fresh PolymorphicType; (bodytype, bodyconstr) = infer_type( env + "var:vartype", body ); return (FuncType(vartype,bodytype), bodyconstr); ## func(arg): ## - constrain that the argument's type is appropriate ## - this expression's type is the return value type of func ## - easiest to do this by introducing a new polymorphic type FuncAppExpression( func, arg ): (type1, constr1) = infer_type( env, head ); (type2, constr2) = infer_type( env, tail ); resulttype = fresh PolymorphicType; return ( resulttype, constr1 + constr2 + "type1==FuncType(type2,resulttype) +" );
The unification part does all the work, but is the easy part to code:
# unify a list of constraints: # - input = list of constraints of the form "lhs==rhs" # - output = list of constraints # a unification is an assignment of values to variable that satisfies # the constraints in the most general way. in our case, variables # are the PolymorphicType guys, and values are any Types def unify( constraints ): return [] if constraints is an empty list; (lhs,rhs) = shift constraints; ## if they are already equal, do nothing if lhs = rhs then return unify(constraints); ## orient "variables" on the lhs if lhs is not a PolymorphicType, but rhs is, then (lhs,rhs) = (rhs,lhs); if lhs = PolymorphicType(id) then if PolymorphicType(id) occurs anywhere within constraints, the +n croak "you're asking for a recursive type!" constraints = map { replace each PolymorphicType(id) with rhs } constraints; ## output this assignment as part of the solution! return "id:rhs" + unify(constraints); ## for 2 FuncTypes to be equal, their components must be equal, ## so add new constraints if lhs = FuncType(l1,l2) and rhs = FuncType(r1,r2) then return unify(constraints + "l1==r1" + "l2==r2"); if lhs = ListType(l1) and rhs = ListType(r1) then return unify(constraints + "l1==r1"); ## we get here if you try to constrain a ListType to equal a ## FuncType, or other such impossible feats else croak "unification impossible!";
Putting it together:
  • First use infer_type to get a type judgment and constraints on the expression.
  • Unify the constraints.
  • Substitute all the PolymorphicTypes in the judgment according to the unification.
  • Enjoy.

What is an alias?

In Perl, a variable is like a container that holds a value. The variable's name is a way to refer to the container. If two different containers hold the same value, they are really holding two separate copies -- changing the value in one container doesn't affect the other. This is what we're used to almost all of the time:
## two containers that have the same value my $x = 1; my $y = 1; $x = 5; ## change the value in one container ... print $y; ## the other container is unaffected
Sometimes it's possible for two variables/expressions to refer to the same container! We see a form of this when we use references:
my $x = 1; my $y = \$x; ## $y is a reference to $x $x = 5; print $$y;
In this example, $x and $$y refer to the same container. So modifying something via $x is the same as modifying it via $$y,

However, there is a more subtle way this can happen in Perl, without using references! In other words, you can have two plain scalars that refer to the same container. Changing one changes the other. This is called an alias.

How do I make an alias?

Before going into how to make an alias, let's see why they are so subtle. The biggest reason is that the assignment operator does not preserve aliases!

$x = $y means "take a copy of the value in the $y$ container and put it in the $x container." In particular, this does not mean "make $x and $y point to the same container."

So aliases are somewhat fragile...

Putting an alias into a variable

Some operations in Perl result in one variable being aliased to another:
Argument Passing
When a sub is called, its arguments are aliased to the elements of @_:
my $x = 0; sub { $_[0] = 5 }->($x); print "$x\n";
Since normal scalar assignment doesn't preserve aliases, the sub can't return an aliased copy of $x:
my $x = 0; my $y = sub { $_[0] }->($x); ## my $y = .. assignment operator $y = 5; print "$x\n"; ## still 0
However, array slots do preserve aliasing, so you can return the alias if it's inside an array(ref):
my $x = 0; my $arr = sub { \@_ }->($x); $arr->[0] = 5; print "$x\n"; # 5
You can even exploit this to make 2 entries in an array aliased to each other!
my $arr = do { my $x; sub { \@_ }->($x, $x); }; $arr->[0] = 0; print "@$arr\n"; ## 0 0 $arr->[0] = 5; print "@$arr\n"; ## 5 5
map & grep
The block gets called once for each element of the list. Each time $_ is aliased to the next element of the list.
my $x = 0; map { $_ = 5 } $x; print "$x\n"; my $x = 0; grep { $_ = 5 } $x; print "$x\n";
foreach
The foreach-style loop has essentially the same aliasing behavior as map and grep. Each time through the loop, the loop variable is aliased to the next item in the list. Of course, with foreach, the loop variable doesn't have to be named $_.
my $x = 0; foreach my $y ($x) { $y = 5 } print "$x\n";
Typeglobs
my $x = 0; *y = \$x; $y = 5; print "$x\n";
In fact, using typeglobs, you can even alias hashes and arrays!
my @x = qw(1 2 3 4); *y = \@x; splice @y, 2, 1, "hi"; print "@x\n";
Lexical::Alias
The typeglob trick only works with symbol-table variables, and not lexicals. The Lexical::Alias module uses some magic to let you do it with lexicals too.
use Lexical::Alias; my ($x, $y); alias $x, $y; $y = 5; print "$x\n";

Anonymous aliases

An expression's return value can be aliased. Using it directly as an lvalue works just as if you were using an aliased variable. Assigning scalars $y=EXPR doesn't preserve alias nature of EXPR. The only way to put this kind of an alias in a variable is to use alias-preserving operations like above.

  • assignment statement: sub { $_[0] = 5}->($x = 1); print $x;
  • pre-increment, pre-decrement: $x=5; sub { $_[0] = 1 }->(++$x); print $x;

Lots of aliasing!

How many levels of aliasing do you see here?
my $x = 0; sub weird { --$_[0]; \@_ } for my $y (++$x) { my ($z) = map { weird($_ = 10) } $y; $z->[0] =~ s/9/hello world!/; } print "$x\n";




For Limbic~Region:

Linear progression (with steps of size b, starting at x) looks like:

x + (x+b) + ... + (x+(n-1)b) = k nx + b(1 + 2 + .. + (n-1)) = k nx + b(n(n-1)/2) = k
==>
bn^2 + (2x-b)n - 2k = 0
Depending on what you want to do, this may help... if you know n,k,b, you can solve for x... otherwise if you know just n,k, you can probably solve for a space of valid x,b pairs (what remains is a linear constraint in x,b) ... i'm out of time though!

semi-unified interface to all kinds of set partitions we know about:

my $p = UnorderedSetPartition->new( items => ['a'..'f'], blocks => [2,2,1,1], ## arrayref list of blocks, num of bl +ocks, or omitted=unrestricted ); my $p = OrderedSetPartition->new( items => ['a'..'f'], blocks => [2,2,1,1], ## arrayref list of blocks, num of bl +ocks, or omitted=unrestricted ); ## or perhaps: ## SetPartition->new( ... ordered => 0 ... ); my $iter = $p->iterator( order => "lex", ## "lex", "colex", "gray", "fastest", +etc... representation => "rg", ## "rg", "AoA", etc.. ); @output = $iter->next; $iter->skip($n); $iter->prev; # ?? $iter->reset; ## to the beginning $iter->reset( $some_saved_rank_or_widget ); #### @output = $p->list( order => "lex", representation => "rg" ); ## same as iterator, but returns list of *all* widgets ## maybe allow for a callback #### $r = $p->rank( order => "lex", representation => "rg", $widget ); $widget = $p->rank( order => "lex", representation => "rg", $r ); ## code repetition here? $how_many_partitions = $p->count;



sub binomial { my ($n, $k) = @_; my $c = 1; for (0 .. $k-1) { $c *= $n-$_; $c /= $_+1; } $c; }

Fix DBD::mysqlPP's ridiculous placeholders bug

--- mysqlPP.pm.orig 2005-02-16 23:40:15.000000000 -0600 +++ mysqlPP.pm 2005-02-16 23:41:17.000000000 -0600 @@ -347,10 +347,10 @@ # ... } my $statement = $sth->{Statement}; - for (my $i = 0; $i < $num_param; $i++) { + { my $dbh = $sth->{Database}; - my $quoted_param = $dbh->quote($params->[$i]); - $statement =~ s/\?/$quoted_param/e; + my $i = 0; + $statement =~ s/\?/$dbh->quote($params->[$i++])/ge; } my $mysql = $sth->FETCH('mysqlpp_handle'); my $result = eval {
References: Re: Interpolating DBI/SQL placeholders, DBD-mysqlPP RT

Do yourself a favor & make CGI::param non-context-aware

I think we've all been bitten with something like
$sth = $dbh->prepare("select * from foo where id=?"); $sth->execute( param("id") ); ## execute failed: called with 0 bind variables when 1 are needed
Of course, the problem is that param is in list context and so may return an empty list. The solution is to always say scalar param(..). But I almost never write forms that require param to return multiple items. So from now on, I'm going to start all CGI scripts like this:
# use CGI 'param'; ## not anymore! use CGI; sub param { scalar CGI::param(@_) }
Reference: Re: Problem assigning values to Hash

"Fix" bad CSV

I had to work with some legacy CSV that was poorly-formed. It had many records like this (notice the non-escaped double quotes):
"Robert "Bob" Smith","42","FooBar"
Fields containing double quotes were themselves quoted. So assuming we don't have any fields where a comma is adjacent to a quote in the data (this makes me shudder), we can get Text::xSV to read it as intended like this:
use Text::xSV; sub filter { local $_ = shift; chomp; s/(?<=[^,])\"(?=[^,])/\"\"/g; "$_\n"; } my $csv = Text::xSV->new( filename => "...", filter => \&filter );

Patch Text::xSV - quote all output fields

--- xSV-old.pm 2004-05-26 20:13:12.000000000 -0500 +++ xSV.pm 2004-05-26 20:32:48.000000000 -0500 @@ -172,17 +172,18 @@ } my $sep = $self->{sep}; + my $quote = $self->{always_quote}; my @row; foreach my $value (@_) { if (not defined($value)) { # Empty fields are undef - push @row, ""; + push @row, $quote ? qq("") : ""; } elsif ("" eq $value) { # The empty string has to be quoted. push @row, qq(""); } - elsif ($value =~ /\s|\Q$sep\E|"/) { + elsif ($value =~ /\s|\Q$sep\E|"/ or $quote) { # quote it local $_ = $value; s/"/""/g; @@ -321,7 +322,7 @@ my @normal_accessors = qw( close_fh error_handler warning_handler filename filter fh - row_size row_size_warning + row_size row_size_warning always_quote ); foreach my $accessor (@normal_accessors) { no strict 'refs';
Then activate the "always_quote" option.
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 wandering the Monastery: (5)
As of 2014-08-30 15:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (293 votes), past polls