permutations.js

function (doc) {
  // subset that doesn't contain current
  var others = function(tags, current, length) {
    var notCurrent = function(x) { return x != current; };
    if (length == 2) {
      return tags.filter(notCurrent).map(function(n){ return [n] });
    } else {
      var _others = [];
      var list = tags.filter(notCurrent);
      var size = length - 1;
      for (var i = 0; i <= (list.length - size); i++) {
        _others.push(list.slice(i, i+size));
      }
      return _others;
    }
  };

  // list of possible tagsets containing current with given length
  var keyList = function(tags, current, length) {
    if (length == 1) {
      return [ [ current ] ];
    } else if (length == tags.length) {
      return [ tags ];
    } else {
      var k = [];
      var _others = others(tags, current, length);
      _others.forEach(function(x, i, list){
        x.push(current);
        x.sort();
        k.push(x); 
      });
      return k;
    }
  };

  // stringify a list of tags
  var key = function(tags) { return tags.join('+'); };

  //// main

  // XXX uncomment line 42 and comment line 43 for jan-felix-style tags
  // var tags = doc.tags.map(function(t){ return t.name });
  var tags = doc.tags;
  tags.sort();
  var permutations = {};
  tags.forEach(function(x, i, list){
    var current = tags[i];
    var j;
    for (j = 1; j <= tags.length; j++) {
      var kl = keyList(tags, current, j)
      kl.forEach(function(v){
        permutations[key(v)] = v;
      });
    }
  });

  var p = []; 
  var v;
  for each (v in permutations) {
    emit(v, doc);
  }
};

permutations.pl

#!/usr/bin/perl

use strict;
use warnings;

my $list = [ qw(a b c) ];
# a
# a b
# a b c
# b
##a b
# b c
##a b c
# c
# a c
##b c
##a b c
#----
# (a) (a b) (a b c) (b) (b c) (c) (a c)

$list = [ qw(a b c d) ];
# a
# a b
# a c
# a b c
# a c d
# a b c d

sub string {
  join("+", @{$_[0]})
}

sub others {
  my ($tags, $current, $length) = @_;
  # $length == 1      will never happen
  # $length == @$tags will never happen
  if ($length == 2) {
    return [ map { [$_] } grep { $_ ne $current } @$tags ];
  } else {
    # fuck - i have to permute AGAIN
    # but! - i luck out due to the tags being sorted
    # all I need is a sliding window with $size == ($length - 1)
    my @others;
    my $list = [ grep { $_ ne $current } @$tags ];
    my $size = $length - 1;
    for (0 .. (@$list - $size)) {
      push @others, [ @$list[$_ .. ($_ + $size - 1)] ];
    }
    return \@others;
  }
}

sub key_list {
  my ($tags, $current, $length) = @_;
  if ($length == 1) {
    return [$current];
  } elsif ($length == @$tags) {
    return $tags;
  } else {
    # this is the tricky part
    my @k;
    my $others = others($tags, $current, $length);
    for (@$others) {
      push @k, [ sort($current, @$_) ];
    }
    return @k;
  }
}

sub sorted_permutations {
  my $tags = [ sort @{$_[0]} ]; # assume each tag is already unique
  my %permutations;
  # $i == the index into @$tags
  # $j == the length of the key
  for my $i (0 .. (@$tags - 1)) {
    my $current = $tags->[$i];
    for my $j (1 .. @$tags) {
      for my $key (key_list($tags, $current, $j)) {
        $permutations{string($key)} = $key;
      }
    }
  }
  my @p;
  for (sort keys %permutations) {
    push @p, $permutations{$_};
  }
  @p;
}