# For matroid M = (E, BB),
#  m := \# E,
#  r := \rank(E),
#  u := \union_{B\in BB} B,
#  i := \intersection_{B\in BB} B,
#  d := \max_{B\in BB} \deg B,
#   where
#    \deg B := \sum_{e\in B} \deg_e B,
#    \deg_e B := \# \{B'\in BB; B - B' = \{e\}\}.
# Note
#  \deg B = \sum_{e\not\in B} \deg^-_e B,
#   where \deg^-_e B := \# \{B'\in BB; B' - B = \{e\}\}.

package matroid;

# Since I want to use nested data structure and closures, I
require 5.003;
use strict 'refs';

require 'site/libmisc.pl';
require 'site/libset.pl';
require 'site/libdebug.pl';

*return0 = *misc'return0;#';
*setset = *set'setset;#';
*setunion = *set'setunion;#';
*setcomplement = *set'setcomplement;#';
*partitions = *set'partitions;#';
*permvv = *set'permvv;#';
*permutations = *set'permutations;#';
*apply_permutation = *set'apply_permutation;#';

$main'verbose = 0 if !defined $main'verbose;

# For a while, we consider only the cases u = m and i = 0.

sub make_init_new {
  local($p, $q, @x);

  foreach (@_) {
    ($p, $q) = @$_;
    push(@x, '1' x $p . '0' . '1' x ($r - 1 - $p) . '0' x $q . '1' . '0' x ($m - $r - 1 - $q));
  }
  push(@result, [@x]);
}

sub make_init_loop {
  local($is_vert, $ri, $ci, $cur, $prev, @pair) = @_;
  local($crest, $prevr);

  for (;;) {
    if ($is_vert) {
      local($prevc, $prevcsum, $nxti, $nxt);

      for (; $ri < $#$row ; $cur += $cn, ++$ri) {
	$prevc = $ci > 0 ? $rowsum[$cur - 1] : 0;
	if ($prevc < $row->[$ri]) {
	  $rowsum[$cur] = $prevc + 1;
	  $colsum[$cur] = $prev + 1;
	  &make_init_loop(1, $ri + 1, $ci, $cur + $cn, $prev + 1, @pair, [$ri, $ci]);
	}
	$rowsum[$cur] = $prevc;
	$colsum[$cur] = $prev;
      }
      if ($ci > 0) {
	$prevcsum = $colsum[$cur - 1];
	return if ($prev > $prevcsum);
	$prevc = $rowsum[$cur - 1];
      }
      else {
	$prevc = 0;
	$prevcsum = $prev + 1;
      }
      if (($nxti = $ci + 1) < $cn) {
	$nxt = $nxti * $cn + $nxti;
	if ($prev < $prevcsum && $prevc < $row->[$ri]) {
	  $rowsum[$cur] = $prevc + 1;
	  $colsum[$cur] = $prev + 1;
	  &make_init_loop(0, $nxti, $nxti, $nxt, $rowsum[$nxt - 1], @pair, [$ri, $ci]);
	}
	$rowsum[$cur] = $prevc;
	$colsum[$cur] = $prev;
	$is_vert = 0;
	$ri = $ci = $nxti;
	$cur = $nxt;
	$prev = $rowsum[$nxt - 1];
      }
      else {
	for ($ri = $ci + 1, $cur = $ri * $cn + $ci ; $ri < $#$row ; ++$ri, $cur += $cn) {
	  return if ($rowsum[$cur] < $row->[$ri]);
	}
	if ($prevc == $row->[-1]) {
	  &make_init_new(@pair);
	}
	elsif ($prev < $prevcsum && $prevc + 1 == $row->[-1]) {
	  &make_init_new(@pair, [$ri, $ci]);
	}
	return;
      }
    }
    $crest = $row->[$ri] - $prev;
    for (; $ci < $cn ; ++$ci, ++$cur) {
      $prevr = $ri > 0 ? $colsum[$cur - $cn] : 0;
      if ($prev < $row->[$ri]) {
	return unless ($cn - $ci >= $crest);
	$rowsum[$cur] = $prev + 1;
	$colsum[$cur] = $prevr + 1;
	&make_init_loop(0, $ri, $ci + 1, $cur + 1, $prev + 1, @pair, [$ri, $ci]);
      }
      return unless ($cn - $ci > $crest);
      $rowsum[$cur] = $prev;
      $colsum[$cur] = $prevr;
    }
    if (++$ri < @$row) {
      $is_vert = 1;
      $ci = $ri - 1;
      $cur = $ri * $cn + $ci;
      $prev = $colsum[$cur - $cn];
    }
    else {
      &make_init_new(@pair);
      return;
    }
  }
}

sub make_init {
  local($m, $r, $d) = @_;
  local($row, @rowsum, @colsum, $cn, @result); 

  $cn = $m - $r;
  foreach $row (&partitions($d, $r, $r, $m - $r)) {
    @rowsum = @colsum = ('0') x (($m - $r) * ($#$row + 1));
    &make_init_loop(0, 0, 0, 0, 0);
  }
  @result;
}

sub iso {
  local($x, $y) = @_;

  if (%$x == %$y) {
    local(@x) = sort(values(%$x));
    local(@y) = sort(values(%$y));
    local($i, @permv, $perm);

    while (@x) {
      return undef if (shift(@x) ne shift(@y));
    }
    @x = keys(%$x);
    $i = length($x[0]);
    for (; $i > 1 ;) {
      @permv = @{$permvv[--$i]};
    perm:
      foreach $perm (@permv) {
	foreach (@x) {
	  next perm if ($$x{$_} != $$y{join('', (split(//, $_, $i + 2))[@$perm, $i + 1])});
	}
	return 1;
      }
    }
  }
  undef;
}

sub nontrivial_bases_test {
  local($a, @rest) = @_;
  local($no, $b, $ab, @ab, @ba, $i, $j);

test:
  foreach $b (@rest) {
    @ab = @ba = ();
    for ($i = 0 ; $i < $m ; ++$i) {
      $ab = substr($a, $i, 1) . substr($b, $i, 1);
      if ($ab eq '10') {
	push(@ab, $i);
      }
      elsif ($ab eq '01') {
	push(@ba, $i);
      }
    }
    if (@ab > 1) {
    test_ab:
      foreach $i (@ab) {
	foreach $j (@ba) {
	  next test_ab if (defined($new{&setset($a, $i, 0, $j, 1)}));
	}
	if ($new{'todo'}->{$a}) {
	  $new{'todo'}->{$a}->{$b} = 1;
	}
	else {
	  $new{'todo'}->{$a} = +{$b => 1};
	}
	++$no;
	next test;
      }
    test_ba:
      foreach $i (@ba) {
	foreach $j (@ab) {
	  next test_ba if (defined($new{&setset($b, $i, 0, $j, 1)}));
	}
	if ($new{'todo'}->{$a}) {
	  $new{'todo'}->{$a}->{$b} = 1;
	}
	else {
	  $new{'todo'}->{$a} = +{$b => 1};
	}
	++$no;
	next test;
      }
    }
    elsif (@ab == 1) {
      return undef unless ($new{$b} < $d);
      ++$new{$b};
      return undef unless ($new{$a} < $d);
      ++$new{$a};
    }
  }
  !$no;
}

sub nontrivial_bases_neighbors {
  local($matroid, $vertex, $sum, $row, $col, $rowsum, $i, $j, @neighbor) = @_;

  if ($sum < $d) {
    local($p, $q, $new, @new);
    local($make_new) = sub {
      ($p, $q) = ($$row[$i], $$col[$j]);
      $new = &setset($vertex, $p, '0', $q, '1');
    };
    local($more) = sub {
      if ($$matroid{$new}) {
	++$sum;
	++$rowsum;
	$sum < $d ? 1 : undef;
      }
      else {
	push(@new, &nontrivial_bases_neighbors($matroid, $vertex, $sum + 1, $row, $col, $rowsum + 1, $i, $j + 1,
					      @neighbor, $new));
	1;
      }
    };

    unless ($j < @$col) {
      ++$i;
      $j = 0;
      $rowsum = 0;
    }
  rows:
    for (; $i < @$row ; ++$i) {
      for (; $j < $#$col ; ++$j) {
	&$make_new;
	last rows unless (&$more);
      }
      &$make_new;
      if ($rowsum > 0) {
	last unless (&$more);
      }
      else {
	++$sum;
	++$rowsum;
	push(@neighbor, $new) unless ($$matroid{$new});
	last unless ($sum < $d);
      }
      $rowsum = $j = 0;
    }
    push(@new, [@neighbor]) if (@neighbor && ($i > $#$row || ($i == $#$row && $rowsum > 0)));
    @new;
  }
  elsif ($i == $#$row && $rowsum > 0 && @neighbor) {
    ([@neighbor]);
  }
  else {
    ();
  }
}

sub nontrivial_bases_loop {
  local($old, $union, $vertex, $neighbor, @src) = @_;
  local(%new, %todo, @base, @rest, $a, $b, $yes, $no, %src, $i, $j, @row, @col);

  %new = %$old;
  %todo= %{$$old{'todo'}};
  delete($new{'todo'});
  @base = keys(%new);
  $new{'todo'} = +{};
  $union = &setunion($union, $vertex, @$neighbor);
  foreach (@$neighbor) {
    $new{$_} = 0;
  }
  for (@rest = @$neighbor ; @rest ;) {
    $a = shift(@rest);
    $yes = &nontrivial_bases_test($a, @rest);
    return if (!defined($yes));
    $no += !$yes;
    $yes = &nontrivial_bases_test($a, @base);
    return if (!defined($yes));
    $no += !$yes;
  }
  foreach $a (keys(%todo)) {
    $yes = &nontrivial_bases_test($a, keys(%{$todo{$a}}));
    return if (!defined($yes));
    $no += !$yes;
  }
  unless ($no || $union =~ /0/) {
    delete($new{'todo'});
    foreach (@matroids) {
      if (&iso($_, \%new)) {
	$no = 1;
	last;
      }
    }
    unless ($no) {
      push(@matroids, +{%new});
      &ddump('%new') if ($main'verbose);
    }
    $new{'todo'} = +{};
  }
  push(@src, grep($new{$_} < $d, @$neighbor));
  while (@src) {
    $vertex = shift(@src);
    @row = @col = ();
    for ($i = 0 ; $i < $m ; ++$i) {
      if (substr($vertex, $i, 1) eq '0') {
	push(@col, $i);
      }
      else {
	push(@row, $i);
      }
    }
    foreach (&nontrivial_bases_neighbors(\%new, $vertex, 0, [@row], [@col], 0, 0, 0)) {
      &nontrivial_bases_loop(\%new, $union, $vertex, $_, @src);
    }
  }
}

sub nontrivial_bases {
  local($m, $r, $d) = @_;
  local($ivertex) = '1' x $r . '0' x ($m - $r);
  local($ihash, $zero) = (+{$ivertex => 0, 'todo' => +{}}, $zero);
  local(@matroids);

  &permutations($m);
  foreach (&make_init) {
    &nontrivial_bases_loop($ihash, $zero, $ivertex, $_);
  }
  @matroids;
}

sub print_nontrivial_bases {
  local(@s, @d, $set, $deg, $n);

  foreach (&nontrivial_bases(@_)) {
    @s = %$_;
    @d = ();
    while (@s) {
      ($set, $deg) = splice(@s, 0, 2);
      push(@d, sprintf("%03d:%s", $deg, $set));
    }
    foreach (reverse(sort(@d))) {
      ($deg, $set) = split(/:/, $_);
      push(@s, sprintf("%s => %d", $set, $deg + 0));
    }
    print "{", join(', ', @s), "}\n";
    ++$n;
  }
  $n;
}

# Now we can generate all the matroids.
# The matroids for (m, r, d, u, i) are in one-to-one correspondence with
# the matroids for (u, r, d, u, 0) through
# (E, BB) <--> (\union BB \setminus \intersection BB, \{ B \setminus \intersectin BB ; B \in BB \}).

sub all_bases {
  local(%matroids, $m, $r, $d, $u, $i, $maxdeg, $key);
  local(@matroidvv, @matroidv, $ones, $zeros, $uu, $re, $rb, @foo, @bar);

  foreach $m (@_) {
    if ($m > 1) {
      for ($u = 1 ; $u <= $m ; ++$u) {
	for ($r = int(($u + 1) / 2) ; $r < $u ; ++$r) {
	  for ($d = $r, $maxdeg = $r * ($u - $r) ; $d <= $maxdeg ; ++$d) {
	    $key = sprintf("%d:%d:%d", $u, $r, $d);
	    $matroids{$key} = [&nontrivial_bases($u, $r, $d)] unless ($matroids{$key});
	  }
	}
      }
    }
  }
  foreach $m (@_) {
    if ($m < 1) {
      push(@matroidvv, [['']]);
    }
    elsif ($m == 1) {
      push(@matroidvv, [['0'], ['1']]);
    }
    elsif ($m > 1) {
      @matroidv = (['0' x $m]);
      for ($u = 1 ; $u <= $m ; ++$u) {
	$zeros = '0' x ($m - $u);
	for ($i = 0 ; $i < $u ; ++$i) {
	  $uu = $u - $i;
	  $ones = '1' x $i;
	  for ($re = $uu - 1, $rb = 1 ; $re > $rb ; --$re, ++$rb) {
	    for ($d = $re, $maxdeg = $re * ($uu - $re) ; $d <= $maxdeg ; ++$d) {
	      $key = sprintf("%d:%d:%d", $uu, $re, $d);
	      foreach (@{$matroids{$key}}) {
		@foo = @bar = ();
		foreach (sort(keys(%$_))) {
		  push(@foo, "$zeros$_$ones");
		  push(@bar, $zeros . &setcomplement($_) . $ones);
		}
		push(@matroidv, [@foo], [reverse(@bar)]);
	      }
	    }
	  }
	  unless ($re < $rb) {
	    for ($d = $re, $maxdeg = $re * ($uu - $re) ; $d <= $maxdeg ; ++$d) {
	      $key = sprintf("%d:%d:%d", $uu, $re, $d);
	      foreach (@{$matroids{$key}}) {
		@foo = ();
		foreach (sort(keys(%$_))) {
		  push(@foo, "$zeros$_$ones");
		}
		push(@matroidv, [@foo]);
	      }
	    }
	  }
	}
	push(@matroidv, [$zeros . '1' x $u]);
      }
      push(@matroidvv, [@matroidv]);
    }
  }
  &return0(@matroidvv);
}

sub print_all_bases {
  local($foo, @foo, $n);

  foreach (@_) {
    $foo = &all_bases($_);
    foreach (@$foo) {
      push(@foo, sprintf("%04d:%s", scalar(@$_), join(', ', sort(@$_))));
    }
    foreach (sort(@foo)) {
      s/^(\d+)://;
      print "[$_]\n";
      ++$n;
    }
  }
  $n;
}

sub ddump {&debug'vardump if $main'debug;}

1;

__END__
