#!/usr/bin/perl
  use strict;
  use warnings;

  use Math::Combinatorics;

  my $cardNo     = 20;      # No. of cards to create
  my $cardFields =  6;      # fields at one card
  my @terms      = qw( term1 term2 term3 term4 term5 term6 term7 term8 term9 term10 );

  # check if order possible
  if ( $cardFields > scalar @terms ) {
    die 'There are not enough terms ('
        ,scalar @terms
        ,") for $cardFields fields per card\n"
        ,$!;
  }
  # Edit 1: folgende Fehlerabfrage wurde nachträglich eingefügt
  elsif ( $cardNo*$cardFields < scalar @terms ) {
    die  "$cardNo cards with $cardFields fields haven`t "
        ,'enought place for ',scalar @terms,' terms.',$!;
  }

  my @termNo     = (0..scalar @terms-1); # just a help for keynames

  # Terms counter for a uniform distribution
  # %countTerms wird als Referenz genutzt,
  # um die Häufigkeit der verwendeten Begriffe
  # zu zählen
  my %countTerms = ();
  @countTerms{@termNo} = split ',',('0,' x scalar @termNo);

  # get all combinations as referenz
  my %allCombi   = ();
  my $combinat = Math::Combinatorics->new( 'count' => $cardFields,
                                           'data'  => [@termNo],
                                         );
  while(my @combo = $combinat->next_combination){
    my $combo = join '-',sort{$a <=> $b}@combo;
    $allCombi{$combo} = 0;
  }

  # check if order possible
  my $possibleCards = scalar( keys %allCombi );
  if ( $possibleCards < $cardNo) {
    die 'There are only '
        ,$possibleCards
        ," combinations possible.\n"
        ,'but you ordered '
        ,$cardNo, " cards.\n"
        ,$!;
  }

  # just a info
  print "There are $possibleCards combinations possible.\n\n";

  # if all possible combinations in use
  # eine Abkürzung, wenn wirklich alle Kombinationen benötigt werden
  if ( $cardNo == $possibleCards ) {
    giveOut(\%allCombi);
    exit 0;
  }

  # Eine erste Karte zu erstellen wäre wahrscheinlich nicht nötig
  # kam mir aber als gute Idee vor
  # get a random first card
  my $firstCard = (keys %allCombi)[ int( rand()*$possibleCards ) ];
  my %myCards   = ($firstCard => 1);
  delete $allCombi{$firstCard};                   # setup referenz
  map{ $countTerms{$_}++ }(split '-',$firstCard); # setup term counting referenz

  # creating cards
  my $card = 1;
  while ( $card < $cardNo) {
    # setting up a lookup for rare terms
    my @rareTerms   = sort{ $countTerms{$a} <=> $countTerms{$b} } keys %countTerms;
    my @newFields   = @rareTerms[0..$cardFields-1];
    my $newCard     = join '-',sort{$a <=> $b}@newFields;
    my @searchCards = ();

    # if combination in use, look up a similar combination 
    unless ( exists $allCombi{$newCard} ) {
      $newCard      = '';
      while ( scalar @newFields > 0 ) {
        # spätestens wenn alle Begriffe entfernt wurden,
        # sollte es eigentlich
        # irgendeine Kombination finden. - so werden dann hoffentlich
        # die Bedingungen für die seltensten Kombinationen im Notfall
        # neu gemischt.
        # trotzdem habe ich irgendwie Sorgen wegen einer Endlosschleife 
        pop @newFields;
        my $searchCard  = join '-',sort{$a <=> $b}@newFields;
        @searchCards = grep{/^$searchCard/} keys %allCombi;
        if ( scalar @searchCards ) {
          $newCard = $searchCards[0];
          last;
        }
      }
    }

    # found a unused card
    if ( $newCard ) {
      $myCards{$newCard} = 1;
      delete $allCombi{$newCard};                   # setup referenz
      map{ $countTerms{$_}++ }(split '-',$newCard); # setup term counting referenz
      $card++;
    }
  }

  giveOut(\%myCards);
  exit 0;

  ####################################
  # give out
  # separiert, da es später ein Modul werden soll
  sub giveOut {
    my $myCards   = shift;
    my %usedTerms = ();
    print '='x40,"\n";
    print 'These ',$cardNo,' combinations are selected:',"\n";

    foreach my $c ( keys %{$myCards} ) {
      my @t = map{$terms[$_]}(split '-',$c);
      print join ',',@t,"\n";

      map{ $usedTerms{$_}++ }@t; # count used terms
    }

    print "\n",'='x40,"\n";
    print 'These terms are in use:',"\n";
    foreach my $t ( sort keys %usedTerms ) {
      print $t,': ',$usedTerms{$t},"x\n"
    }

  }