DouKaku?

match([_], []).
match([X|Xs], Ys) :-
    group_pairs_by_key(Y, [X-Xs]), append(Y, Y1, Ys), match(Xs, Y1).

game([], G, G).
game([X1-X2|Xs], Ys, G) :-
    append(Y1, [Y|Y2], Ys), \+ memberchk(Y, Y2),
    \+ memberchk(X1-_, Y), \+ memberchk(_-X1, Y),
    \+ memberchk(X2-_, Y), \+ memberchk(_-X2, Y),
    append(Y1, [[X1-X2|Y]|Y2], Z), game(Xs, Z, G).

round_robin(N, G) :- N mod 2 =:= 0,
    numlist(1, N, X), match(X, Y), N1 is N - 1,
    length(G0, N1), maplist(ord_empty, G0), game(Y, G0, G).

:-  writeln('4 teams'), forall(round_robin(4, G), writeln(G)),
    writeln('6 teams'), forall(round_robin(6, G), writeln(G)).

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

void leage(int n){
    int i,j,k;
    int mapsize;
    int *map;
    mapsize=(n-1)*(n-1)*sizeof(int);
    map=(int*)malloc(mapsize);
    memset(map,0,mapsize);
/*
表の割り当て
実際は半分の容量でよい
      j=   0 1 2 ..n-2
         1 2 3 4 ..n
 i=0  1 XX
   1  2 XXXX
   2  3 XXXXXX
   3  4 XXXXXXXX
   :  :
  n-1 n
*/
    for(i=0;i<n-1;i++){    //行方向のループ
        for(j=i;j<n-1;j++){//列方向のループ
            if(i==0){
            //1のチームはシンプルな組み合わせとし、
            //この部分はチームスケジュールフラグとする
                map[j]=1<<j;
            }else{
                //あいている日程の検索
                //とりあえず、上の欄の次にしてみる
                k=map[(i-1)*(n-1)+j];

                if((k*=2)&((1<<(n-1))-1)==0) k=1;    //左にビットローテーション

                
                while((map[j]|map[i-1])&k){    //両チームの予定が埋まってたら次の日程で
                    if((k*=2)&((1<<(n-1))-1)==0) k=1;    //左にビットローテーション
                }
                //日程の決定
                map[i*(n-1)+j]=k;
                //チームスケジュールの登録
                map[j]|=k;
            }
        }
    }
    //スケジュールの表示
    for(k=0;k<n-1;k++){    //日程のループ
        //1のチームはシンプルな組み合わせにする。
        printf("%d:1-%d ",k+1,k+2);
        //それ以外のチームの検索
        for(i=1;i<n-1;i++){    //行方向のループ
            for(j=i;j<n-1;j++){//列方向のループ
                if(map[i*(n-1)+j]==(1<<k))    //予定日だったら表示
                    printf("%d-%d ",i+1,j+2);
            }
        }
        printf("\n");
    }
    printf("\n");
    free(map);
}

int main(){
    
    leage(2);
    leage(4);
    leage(6);
    return 0;
}

//http://ja.doukaku.org/149/　投稿用
using System;
using System.Collections.Generic;

class Program {
    static void Main(string[] args) {
        int teamCount = int.Parse(args[0]);
        List<List<int[]>> leageSchedule = Leage(teamCount);

        //出力
        for(int day = 0; day < leageSchedule.Count; day++) {
            for(int game = 0; game < leageSchedule[day].Count; game++) {
                int min = Math.Min(leageSchedule[day][game][0], leageSchedule[day][game][1]);
                int max = Math.Max(leageSchedule[day][game][0], leageSchedule[day][game][1]);
                Console.Write("{0}-{1} ", min, max);
            }
            Console.WriteLine();
        }
        Console.ReadLine();
    }

    static List<List<int[]>> Leage(int teamCount) {
        //チームリスト生成
        List<int> teamList = new List<int>();
        for(int teamNumber = 1; teamNumber <= teamCount; teamNumber++) {
            teamList.Add(teamNumber);
        }

        //各組み合わせを生成
        List<List<int[]>> leageSchedule = new List<List<int[]>>();
        for(int day = 0; day < teamCount - 1; day++) {
            List<int[]> daySchedule = new List<int[]>();
            daySchedule.Add(new int[] { teamList[0], teamList[1] });
            for(int game = 1; game <= teamCount / 2 - 1; game++) {
                daySchedule.Add(new int[] { teamList[1 + game], teamList[teamList.Count - game] });
            }
            leageSchedule.Add(daySchedule);
            teamList.Add(teamList[1]);
            teamList.RemoveAt(1);
        }
        return leageSchedule;
    }
}

module Main
    where

n = 6

firsts = [(1, x) | x <- [2..n]]
rests = [(x, y) | x <- [2..n], y <- [(x+1)..n]]

cMatchesPerDay = n `div` 2

filterCollision :: [(Int, Int)] -> (Int, Int) -> [(Int, Int)]
filterCollision lst (x, y) = filter (matchxory.fst) $ filter (matchxory.snd) lst
    where 
        matchxory :: Int -> Bool
        matchxory a = (a /= x) && (a /= y)

dayMatches :: [(Int, Int)] -> Int -> [(Int, Int)] -> [(Int, Int)]
dayMatches (x:xs) 1 t = t ++ [x]
dayMatches [] _ t = t

dayMatches restsFiltered@(x:xs) c daymatch
    | (length next) /= cMatchesPerDay = dayMatches xs c daymatch
    | otherwise = next
    where
        next = dayMatches (filterCollision xs x) (c - 1) (daymatch ++ [x])

generateTournament :: (Int, Int) -> [(Int, Int)] -> ([(Int, Int)], [(Int, Int)])
generateTournament firstMatch moves = (tournament, moves')
    where
        tournament = dayMatches (filterCollision moves firstMatch) (cMatchesPerDay - 1) [firstMatch]
        moves' = filter (\x -> not $ elem x tournament) moves

mapToFirsts [] _ = []
mapToFirsts (x:xs) moves = (tournament : mapToFirsts xs moves')
    where
        (tournament, moves') = generateTournament x moves

showMatches lst = mapM_ (putStrLn.show) lst

main = showMatches $ mapToFirsts firsts rests

def scheduling(n)
  teams = [1] + (2..n).to_a.reverse
  half = n / 2
  (n - 1).times do
    p teams[0, half].zip teams[half, half].reverse
    teams = [1] + teams[2..-1].push(teams[1])
  end
end

| チーム数 全試合 待ち行列 全結果 |
チーム数 := 6.
全試合 := OrderedCollection new.
(1 to: チーム数) combinations: 2 atATimeDo: [:対戦ペア | 全試合 add: 対戦ペア copy].
待ち行列 := OrderedCollection with: {Set new. Set new. 1 to: チーム数. 全試合}.
全結果 := Set new.
[待ち行列 notEmpty] whileTrue: [
    | 分岐点 |
    分岐点 := 待ち行列 removeFirst.
    分岐点 third
        ifEmpty: [待ち行列 add: {分岐点 first, {分岐点 second}. Set new. 1 to: チーム数. 分岐点 last}] 
        ifNotEmpty: [
            分岐点 last ifEmpty: [全結果 add: 分岐点 first] ifNotEmpty: [
                分岐点 second
                    ifEmpty: [
                        | next |
                        next := 分岐点 last detect: [:each | 分岐点 third includesAllOf: each].
                        待ち行列 add: {
                            分岐点 first.
                            Set with: next.
                            分岐点 third copyWithoutAll: next.
                            分岐点 last copyWithout: next}]
                    ifNotEmpty: [
                        (分岐点 last reject: [:対戦 |
                                分岐点 second anySatisfy: [:確定分 |
                                    対戦 includesAnyOf: 確定分]]) do: [:次の試合 |
                            待ち行列 add: {
                                分岐点 first.
                                分岐点 second copyWith: 次の試合.
                                分岐点 third copyWithoutAll: 次の試合.
                                分岐点 last copyWithout: 次の試合}]]]]].
^全結果 asArray collect: [:リーグ |
    リーグ asArray collect: [:日程 |
        日程 asArray collect: [:対戦ペア | 対戦ペア first @ 対戦ペア second]]]

"=> {
{{1@2. 4@5. 3@6}. {2@6. 1@4. 3@5}. {2@3. 1@5. 4@6}. {2@5. 1@6. 3@4}. {2@4. 1@3. 5@6}}. 
{{2@6. 1@4. 3@5}. {2@4. 1@5. 3@6}. {2@3. 1@6. 4@5}. {2@5. 1@3. 4@6}. {1@2. 5@6. 3@4}}. 
{{1@2. 5@6. 3@4}. {2@3. 1@5. 4@6}. {2@6. 1@3. 4@5}. {2@4. 1@6. 3@5}. {2@5. 1@4. 3@6}}. 
{{1@2. 4@6. 3@5}. {2@6. 1@5. 3@4}. {2@4. 1@3. 5@6}. {2@3. 1@6. 4@5}. {2@5. 1@4. 3@6}}. 
{{1@2. 4@6. 3@5}. {2@4. 1@5. 3@6}. {2@6. 1@3. 4@5}. {2@3. 1@4. 5@6}. {2@5. 1@6. 3@4}}. 
{{1@2. 4@5. 3@6}. {2@3. 1@4. 5@6}. {2@6. 1@5. 3@4}. {2@5. 1@3. 4@6}. {2@4. 1@6. 3@5}}} "

from itertools import izip

def matchmake1(team):
    for i in xrange(1, team):
        yield [1, i + 1]
        
def matchmake2(i, j, team):
    def next_day(k):
        while 1:
            yield k
            k = k + 1 if k < team else 2

    for match in izip(next_day(i), next_day(j)):
        yield list(match)

def schedule(team):
    leagu = [matchmake1(team)]
    for i, j in izip(xrange(3, team / 2 + 2), xrange(team, 0, -1)):
        leagu.append(matchmake2(i, j, team))

    for match in izip(*leagu):
        print list(match)

if __name__ == '__main__':
    schedule(6)

def cycleS[T](a:Seq[T],i:int,j:int) = Stream.const(a).flatMap(v=>v).slice(i,j)
def sportsScheduling(n:int) = {
  List((1 to n)).map{ lst => 
    val x = n/2-1;val root = lst(0)
    (0 to n-2).map{i =>
      println(i)
      val c = cycleS(cycleS(lst, 1, n), i+x+1, i+x+n)
      (root, c(x))::((1 to x).map{j => (c(x+j), c(x-j))}.toList)
    }.toList
  }.toList
}

def allsche(num)
  teams = (1..num).to_a
  headteam = teams[0,1]
  anotherteams = teams[1..-1]
  anotherteams.permutations.inject([]) {|result, ar|
    result << match_sche(headteam, ar)
  }
end

def match_sche(headteam , anotherteams)
  (1..anotherteams.length).inject([]) {|result, notuse|
    teams = headteam + anotherteams
    anotherteams = anotherteams.rotate
    spar = teams.split(teams.length / 2)
    result << spar[0].zip(spar[1].reverse)
  }
end

class Array
  def permutations
    if empty?
      [[]]
    else
      inject([]) {|result, item|
        minusone = self - [item]
        subperms = minusone.permutations
        newperms = subperms.map{|pm| [item] + pm }
        result + newperms
      }
    end
  end

  def rotate(n = 1)
    (1..n).inject(self.dup) {|result, notuse| [result.pop] + result }
  end
  
  def split(n)
    [self[0,n], self[n..-1]]
  end
end

# MAIN
require 'pp'
allsche =  allsche(ARGV[0].to_i)
puts allsche.length
pp allsche[0]

import Control.Monad (guard)
import Data.List ((\\))

list _ [] = [[]]
list (n,_) xs = concat [f x y | x <- xs, y <- xs, n < x, x < y]
  where f x y = map ((x,y):) (list (x,y) (xs \\ [x,y]))

pairs (x:xs) = map (\y -> pairs' x y (xs \\ [y])) xs
  where pairs' x y xs = map ((x,y):) (list (0,0) xs)

schedules _ [] = [[]]
schedules prev (xs:xss) = concat $ do
  x <- xs
  guard $ and $ map (\e -> e `notElem` prev) x
  return $ map (x:) (schedules (prev ++ x) xss)

main = mapM_ print (schedules [] (pairs [1..6]))

(define (kirkman-2 n)
  (define (first n)
    (append '((1 2)) (comb 3 n)))
  (define (comb low high)
    (if (= (- high low) 1)
    (list (list low high))
    (cons (list low high)(comb (+ low 1) (- high 1)))))
  (define (rotate m n list)
    (map
     (lambda (ilist) (map (lambda (i) (+ (% (+ i m) n) 1)) ilist))
     list))

  (define (iter-rotate m datalist)
    (if (= m 0)
    '()
    (cons (rotate m n datalist) (iter-rotate (- m 1) datalist))))
  (iter-rotate n (first n)))
(display (kirkman-2 6))
(newline)

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>総当たり戦の日程作成</title>
<script type="text/javascript">
/**
 * 配列を回転する
 */
function rotateArray(aOld) {
    var iLast = aOld.length - 1;
    return [aOld[iLast]].concat(aOld.slice(0, iLast));
}

/**
 * 総当たり戦のスケジュール作成
 */
function getLeageSchedule(aTeam) {
    var aResult = [];
    if(aTeam.length%2 != 0) {
        aTeam.push('');
    }
    var vFirst = aTeam[0];
    var aCycle = aTeam.slice(1);
    var iHalfLen = aTeam.length/2;
    for(var i=0; i<aCycle.length; i++) {
        var aLeft = [vFirst].concat(aCycle.slice(iHalfLen).reverse());
        var aRight = aCycle.slice(0, iHalfLen);
        var aGames = [];
        for(var j=0; j<aLeft.length; j++) {
            if(aLeft[j] != '' && aRight[j] != '') {
                aGames.push(aLeft[j] + '-' + aRight[j]);
            }
        }
        aResult.push(aGames);
        aCycle = rotateArray(aCycle);
    }
    return aResult;
}

//テスト
var aTeam = [1,2,3,4,5,6];
var aSchedule = getLeageSchedule(aTeam);
for(var i=0; i<aSchedule.length; i++) {
    document.write(aSchedule[i].join('  ') + '<br/>');
}
</script>
</head>
<body>
</body>
</html>

object sche {
  def match_sche[T](t:List[T]) = match_sche_loop(List(), t)
  def match_sche_loop[T](acc:List[List[(T,T)]], l:List[T]):List[List[(T,T)]] = {
    if (acc.length == (l.length-1)) acc
    else {
      val sp     = l.splitAt(l.length/2)
      val newacc = sp._1.zip(sp._2.reverse) :: acc
      val newl   = l.head :: l.tail.tail ::: List(l.tail.head)
      match_sche_loop(newacc, newl)
    }
  }

  def main(args: Array[String]) {
    val n = args(0).toInt
    match_sche((1 to n).toList).foreach {println(_)}
  }
}

public class Sample {
    boolean[][] match;
    int[][] pair;
    int num;
    public Sample(int num) {
        match = new boolean[num][num];
        pair = new int[num - 1][num/2];
        this.num = num;
    }
    public void work(int count) {
        if (count < num - 1) {
            boolean[] done = new boolean[num];
            work1(count, done, 0, 0);
        } else {
            for (int i = 0; i < num - 1; i++) {
                for (int j = 0; j < num / 2; j++) {
                    System.out.printf("%d-%d ", (pair[i][j] >> 8) + 1, (pair[i][j] & 255) + 1);
                }
                System.out.println();
            }
            System.out.println();
        }
    }
    public void work1(int count, boolean[] done, int coat, int origin) {
        if (coat < num / 2) {
            for (int i = origin; i < num; i++) {
                if (!done[i]) {
                    for (int j = i + 1; j < num; j++) {
                        if (!done[j] && !match[i][j]) {
                            done[i] = done[j] = match[i][j] = true;
                            pair[count][coat] = (i << 8) + j;
                            work1(count, done, coat + 1, i + 1);
                            done[i] = done[j] = match[i][j] = false;
                        }
                    }
                }
            }
        } else {
            work(count + 1);
        }
    }
    public static void main(String[] args) {
        Sample s = new Sample(Integer.parseInt(args[0]));
        s.work(0);
    }
}

#include <string>
#include <sstream>
#include <vector>
#include <iostream>
using namespace std;

typedef vector <string> VS;

VS kirkman(int n) {
  VS result;
  int ring[n-1], vertex[n-1]; 

  for (int i(0); i<n-1; i++)
    ring[i] = i+2;

  for (int i(0); i<n-1; i++) {
    // rotate ring
    for (int j(0); j<n-1; j++)
      vertex[j] = ring[(j+i) % (n-1)];

    stringstream ss("");
    // 1 is special case
    ss << "1-" << vertex[0] << ' ';

    for (int j(0); j<n/2-1; j++)
      ss << vertex[j+1] << '-' << vertex[n-2-j] << ' ';

    string s(ss.str());
    result.push_back(string(s, 0, s.size()-1)); // chop tail ','
  }

  return result;
}

void test(string expected[], int n) {
  VS vs(expected, expected+n-1);
  VS result(kirkman(n)); 
  if (vs != result) {
    cerr << "failed:" << endl;
    cerr << "  expected: ";
    for (VS::iterator i(vs.begin()); i!=vs.end(); i++) {
      cerr << *i << ", ";
    } cerr << endl;
    cerr << "  actual: ";
    for (VS::iterator i(result.begin()); i!=result.end(); i++) {
      cerr << *i << ", ";
    } cerr << endl;
  }
}

void test_0() {
  string ss[] = {"1-2 3-4", "1-3 4-2", "1-4 2-3"};
  test(ss, 4);
}

void test_1() {
  string ss[] = {
    "1-2 3-6 4-5", "1-3 4-2 5-6", "1-4 5-3 6-2",
    "1-5 6-4 2-3", "1-6 2-5 3-4"};
  test(ss, 6);
}

int main(int argc, char **argv) {
  test_0();
  test_1();
  return 0;
}

#!/usr/bin/perl
use strict;

sub league{
    my ($team) = shift;
    my @rev  = (2 .. $team, 2 .. $team);
    for(my $h=0; $h<($team-1); $h++){
        print "[1,$rev[$h]]";
        for(my $i=1; $i<($team-1)/2; $i++){
            print "[$rev[$i+$h],$rev[-($i-$h)]]";
        }
        print "\n";
    }
}

league(6);

-module(match_sche).
-export([make/1]).

make(L) -> make_loop([], L).

make_loop(Acc, [H|L]) ->
  if
    length(Acc) =:= length(L) -> Acc;
    true -> 
      {A,B}   = lists:split(round(length([H|L])/2),