我的思路:
设一表(table):
运动员名称  |  参赛号  |  跑道  |  专业 | 参赛项目 | 是否已分配 (boolean)
设跑道为 8 跑道var rs:recordset ,
major (记录当前专业)
allocated:integer  //已分配学生数目 
runNumber : integer //跑道号
读入某参赛项目参加人数的资料 :
rs.open ('select * from table where 参赛项目=某参赛项目 order by 专业')
runnumber:=1;
//major :=rs.fields['专业'].value //第一记录的专业为默认专业
while allocated<rs.recordcount do 
  begin
    if major<> rs.fields['专业'].value  then //按专业排列地选择,能达到最平均的效果
     begin
      major:=rs.fields['专业'].value  ;
      rs.fields['跑道  ']:=runnumer;
      allcated:=allocated+1;
      runnumber:=runnumber+1;
        if runnumber=9 then runnumber:=1;//循环跑道1--8         
     end;
    rs.movenext;
   if rs.eof then rs.movefirst;
  end;
大概是这样, 如要再分开几组进行同一项目比赛的话可自己再加多一个数据项应该 OK

解决方案 »

  1.   

    不好意思 , 有缺陷,
    当只剩下同一个专业几个参赛选手时出现死循环,请等等,今天没时间想,明天答复
    请留低你的email
      

  2.   

    const
      RaceWayNum=8;
    procedure TForm1.BitBtn1Click(Sender: TObject);
    var
      arrStudent:array[0..22] of integer;
      arrDepart:array[0..5] of integer;
      arrRaceWay:array of array of integer;
      arrRaceTemp:array of integer;
      i,j,k,l:integer;
      iNumOfDepart,iNumOfStudent:integer;
      iMaxOfRaceNum:integer;
    begin
      for i:=0 to 2 do
        arrStudent[i]:=0; //0系 共3人
      for i:=3 to 7 do
        arrStudent[i]:=1; //1系 共5人
      arrStudent[8]:=2;   //2系 共1人
      for i:=9 to 10 do
        arrStudent[i]:=3; //3系 共2人
      for i:=11 to 20 do
        arrStudent[i]:=4; //4系 共10人
      for i:=21 to 22 do
        arrStudent[i]:=5; //5系 共2人
      iNumOfStudent:=23;  //共24人
      iNumOfDepart:=6;//共6个系
      for i:=0 to iNumOfDepart-1 do
        arrDepart[i]:=0;
      for i:=0 to iNumOfStudent-1 do
        Inc(arrDepart[arrStudent[i]]);
      //计算最大组数
      iMaxOfRaceNum:=iNumOfStudent div RaceWayNum;
      if iNumOfStudent mod RaceWayNum>0 then
        iMaxOfRaceNum:=iMaxOfRaceNum+1;
      SetLength(arrRaceWay,iMaxOfRaceNum,8);
      SetLength(arrRaceTemp,iMaxOfRaceNum);
      //-1表示空位
      for i:=0 to iMaxOfRaceNum-1 do
        arrRaceTemp[i]:=-1;
      for i:=0 to iMaxOfRaceNum-1 do
        for j:=0 to RaceWayNum-1 do
          arrRaceWay[i][j]:=-1;
      //将同系的人尽可能的分开
      for i:=0 to iNumOfDepart-1 do
      begin
        k:=0;
        for j:=0 to iNumOfStudent-1 do
          if arrStudent[j]=i then
          begin
            if (k<iMaxOfRaceNum-1) and (arrRaceTemp[k]<iMaxOfRaceNum-1) then
            begin
              arrRaceTemp[k]:=arrRaceTemp[k]+1;
              arrRaceWay[k,arrRaceTemp[k]]:=j;
            end
            else
            begin
              l:=iMaxOfRaceNum-1;
              while arrRaceTemp[l]=RaceWayNum-1 do
                l:=l-1;
              arrRaceTemp[l]:=arrRaceTemp[l]+1;
              arrRaceWay[l,arrRaceTemp[l]]:=j;
            end;
            k:=k+1;
          end;
      end;
      //将后面组的人提到前面空位
      j:=0;
      i:=iMaxOfRaceNum-1;
      while i>j do
      begin
        while arrRaceTemp[j]<RaceWayNum-1 do
        begin
          arrRaceTemp[j]:=arrRaceTemp[j]+1;
          arrRaceWay[j,arrRaceTemp[j]]:=arrRaceWay[i,arrRaceTemp[i]];
          arrRaceWay[i,arrRaceTemp[i]]:=-1;
          arrRaceTemp[i]:=arrRaceTemp[i]-1;
        end;
        j:=j+1;
      end;
      ShowMessage('OK');
      //arrRaceWay数组就是结果
    end;
      

  3.   

    to zng:这个不是靠谁,而是想多找几个思路,我自己也能做出来的,
    但是毕竟一个人的思维还是有所定式的,如果有几个人能够共同探讨,
    那就好多了,而且也能得到一个最优化的算法!大家说是不是!谢谢
    大家的参与!