+-+-+-+-+ |?| | | | 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 ##```## +---+-+-+ |///|/|/| |///|/|/| |///|/|/| +---+-+-+ |///|/|/| +---+-+-+ ##``````## { 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; } } ##``````## PM Markup:Result: paragraphs / line breaks <p>first paragraph</p> <p>second paragraph</p> first paragraph second paragraph link to nodes by name Have you tried [Super Search]? Have you tried [Super Search]? Thanks for your help, [tye] Thanks for your help, [tye] Thanks for nothing, [tye|wiseguy] Thanks for nothing, [tye|wiseguy] link to nodes by ID Please consult [id://3989] Please consult [id://3989] other kinds of links([id://43037|more info]) Check out [pad://NodeReaper] Check out [pad://NodeReaper] Did you try [http://google.com|this]? Did you try [http://google.com|this]? Did you check [doc://perlfaq]? Did you check [doc://perlfaq]? including code in text The result is in <c>\$array</c> The result is in \$array The code should read: <c> use strict; use warnings; my @array = ("Hello world\n"); if (@ARGV) { print \$array; } </c> The code should read: use strict; use warnings; my @array = ("Hello world\n"); if (@ARGV) { print \$array; } text/font formatting This will be <b>bold</b> This will be bold This will be <i>italic</i> This will be italic This will be <tt>fixed width</tt> This will be fixed width quoting / indenting A wise monk once said: <blockquote> "Indenting is good" </blockquote> .. and I agree A wise monk once said: "Indenting is good" .. and I agree lists My favorite flavors are: <ul> <li>vanilla</li> <li>chocolate</li> </ul> My favorite flavors are: vanilla chocolate How to make toast: <ol> <li>insert bread</li> <li>press button</li> </ol> How to make toast: insert bread press button ##``````## # 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 constriants ## 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 constraints return ( ListType(type1), constr1 + ... + constrn + "type1==type2" + ... + "type1==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)" ); ##``````## # 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, then 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!"; ##``````## ## 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 ##``````## my \$x = 1; my \$y = \\$x; ## \$y is a reference to \$x \$x = 5; print \$\$y; ##``````## my \$x = 0; sub { \$_ = 5 }->(\$x); print "\$x\n"; ##``````## my \$x = 0; my \$y = sub { \$_ }->(\$x); ## my \$y = .. assignment operator \$y = 5; print "\$x\n"; ## still 0 ##``````## my \$x = 0; my \$arr = sub { \@_ }->(\$x); \$arr-> = 5; print "\$x\n"; # 5 ##``````## my \$arr = do { my \$x; sub { \@_ }->(\$x, \$x); }; \$arr-> = 0; print "@\$arr\n"; ## 0 0 \$arr-> = 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"; ##``````## 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"; ##``````## my \$x = 0; sub weird { --\$_; \@_ } for my \$y (++\$x) { my (\$z) = map { weird(\$_ = 10) } \$y; \$z-> =~ s/9/hello world!/; } print "\$x\n"; ##``````## 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 ##``````## my \$p = UnorderedSetPartition->new( items => ['a'..'f'], blocks => [2,2,1,1], ## arrayref list of blocks, num of blocks, or omitted=unrestricted ); my \$p = OrderedSetPartition->new( items => ['a'..'f'], blocks => [2,2,1,1], ## arrayref list of blocks, num of blocks, 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; } ##``````## use Memoize; memoize 'int_partitions'; ## number of integer partitions of \$N with smallest part \$min sub int_partitions { my (\$N, \$min) = @_; \$min = 1 if not defined \$min; ## only one way to split up 0 return 1 if \$N == 0; ## the smallest item in the partition can be between \$min .. \$N ## and after we fix it, we need to partition the remaining ## \$N-\$_, into pieces that must all be >= \$_ my \$total = 0; for (\$min .. \$N) { \$total += int_partitions(\$N-\$_, \$_); } return \$total; } print int_partitions(shift), \$/; ##``````## use Memoize; memoize 'restricted_partitions'; sub restricted_partitions { my (\$N, @coins) = @_; ## can't do it if \$N is negative (might get called with \$N<0 if ## we have coins bigger than \$N) ## only one way to make change for 0 return 0 if \$N < 0; return 1 if \$N == 0; ## pick any available coin to be the coin with the lowest ID in this ## partition. once we pick that, we have left to partition \$N-\$coin, ## and can't use coins with lower IDs to do it... my \$total = 0; for (0 .. \$#coins) { \$total += restricted_partitions(\$N-\$coins[\$_], @coins[\$_ .. \$#coins]); } return \$total; } print restricted_partitions(@ARGV), \$/; ##``````## --- 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 { ##``````## \$sth = \$dbh->prepare("select * from foo where id=?"); \$sth->execute( param("id") ); ## execute failed: called with 0 bind variables when 1 are needed ##``````## # use CGI 'param'; ## not anymore! use CGI; sub param { scalar CGI::param(@_) } ##``````## "Robert "Bob" Smith","42","FooBar" ##``````## use Text::xSV; sub filter { local \$_ = shift; chomp; s/(?<=[^,])\"(?=[^,])/\"\"/g; "\$_\n"; } my \$csv = Text::xSV->new( filename => "...", filter => \&filter ); ##``````## --- 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'; ```