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
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:
So my questions are the following:
- 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.
- 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...
{
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.
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>
<p>first paragraph</p>
<p>second paragraph</p>
</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 [Super Search]?
</pre>
</td><td>
Have you tried [Super Search]?
</td></tr>
<tr><td>
<pre>
Thanks for your help, [tye]
</pre>
</td><td>
Thanks for your help, [tye]
</td></tr>
<tr><td>
<pre>
Thanks for nothing, [tye|wiseguy]
</pre>
</td><td>
Thanks for nothing, [tye|wiseguy]
</td></tr>
<tr><td>link to nodes by ID</td><td>
<pre>
Please consult [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 [pad://NodeReaper]
</pre>
</td><td>
Check out [pad://NodeReaper]
</td></tr>
<tr><td>
<pre>
Did you try [http://google.com|this]?
</pre>
</td><td>
Did you try [http://google.com|this]?
</td></tr>
<tr><td>
<pre>
Did you check [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 <c>$array[0]</c>
</pre>
</td><td>
The result is in <c>$array[0]</c>
</td></tr>
<tr><td>
<pre>
The code should read:
<c>
use strict;
use warnings;
my @array = ("Hello world\n");
if (@ARGV) {
print $array[0];
}
</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 <b>bold</b>
</pre>
</td><td>
This will be <b>bold</b>
</td></tr>
<tr><td>
<pre>
This will be <i>italic</i>
</pre>
</td><td>
This will be <i>italic</i>
</td></tr>
<tr><td>
<pre>
This will be <tt>fixed width</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:
<blockquote>
"Indenting is good"
</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:
<ul>
<li>vanilla</li>
<li>chocolate</li>
</ul>
</pre>
</td><td>
My favorite flavors are:
<ul>
<li>vanilla</li>
<li>chocolate</li>
</ul>
</td></tr>
<tr><td>
<pre>
How to make toast:
<ol>
<li>insert bread</li>
<li>press button</li>
</ol>
</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.
|
