| Public Scratchpad | Download, Select Code To D/L |
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
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:
After this point, the 3x1 still remains, and would start the next page.+-+-+-+-+ |?| | | | 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
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:
+---+-+-+ |///|/|/| |///|/|/| |///|/|/| +---+-+-+ |///|/|/| +---+-+-+
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.{ 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; } }
<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>
Simple recursive type inferencing engine. Hopefully this contains enough interesting examples. And hopefully you can parse my language-schizophrenic pseudocode.
The unification part does all the work, but is the easy part to code:# 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) +" );
Putting it together:# 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!";
Sometimes it's possible for two variables/expressions to refer to the same container! We see a form of this when we use references:## 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
In this example, $x and $$y refer to the same container. So modifying something via $x is the same as modifying it via $$y,my $x = 1; my $y = \$x; ## $y is a reference to $x $x = 5; print $$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.
$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...
Since normal scalar assignment doesn't preserve aliases, the sub can't return an aliased copy of $x:my $x = 0; sub { $_[0] = 5 }->($x); print "$x\n";
However, array slots do preserve aliasing, so you can return the alias if it's inside an array(ref):my $x = 0; my $y = sub { $_[0] }->($x); ## my $y = .. assignment operator $y = 5; print "$x\n"; ## still 0
You can even exploit this to make 2 entries in an array aliased to each other!my $x = 0; my $arr = sub { \@_ }->($x); $arr->[0] = 5; print "$x\n"; # 5
my $arr = do { my $x; sub { \@_ }->($x, $x); }; $arr->[0] = 0; print "@$arr\n"; ## 0 0 $arr->[0] = 5; print "@$arr\n"; ## 5 5
my $x = 0; map { $_ = 5 } $x; print "$x\n"; my $x = 0; grep { $_ = 5 } $x; print "$x\n";
my $x = 0; foreach my $y ($x) { $y = 5 } print "$x\n";
In fact, using typeglobs, you can even alias hashes and arrays!my $x = 0; *y = \$x; $y = 5; print "$x\n";
my @x = qw(1 2 3 4); *y = \@x; splice @y, 2, 1, "hi"; print "@x\n";
use Lexical::Alias; my ($x, $y); alias $x, $y; $y = 5; print "$x\n";
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.
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";
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
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!bn^2 + (2x-b)n - 2k = 0
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; }
References: Re: Interpolating DBI/SQL placeholders, DBD-mysqlPP RT--- 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 {
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:$sth = $dbh->prepare("select * from foo where id=?"); $sth->execute( param("id") ); ## execute failed: called with 0 bind variables when 1 are needed
Reference: Re: Problem assigning values to Hash# use CGI 'param'; ## not anymore! use CGI; sub param { scalar CGI::param(@_) }
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:"Robert "Bob" Smith","42","FooBar"
use Text::xSV; sub filter { local $_ = shift; chomp; s/(?<=[^,])\"(?=[^,])/\"\"/g; "$_\n"; } my $csv = Text::xSV->new( filename => "...", filter => \&filter );
Then activate the "always_quote" option.--- 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';