Решение задачи компоновки последовательным алгоритмом разбиения графа G=(X,E) на l кусков G_1,…G_l с числом вершин n_1,…n_l в каждом куске

  SetLength(alpha, 0);

  SetLength(indexs, 0);

  for i0 := 0 to Length(msmezh)-1 do

    SetLength(msmezh[i0], 0);

  SetLength(msmezh, 0);

  for i0 := 0 to Length(itog)-1 do

    SetLength(itog[i0], 0);

  SetLength(itog, 0);

end;

 

procedure TForm1.stage1;

begin

  grp2.Enabled:=False;

  grp2.Font.Color:=clGrayText;

  grp3.Enabled:=False;

  grp3.Font.Color:=clGrayText;

  grp4.Enabled:=False;

  grp4.Font.Color:=clGrayText;

  pgc1.Enabled:=False;

  pgc1.Font.Color:=clGrayText;

end;

 

procedure TForm1.stage2;

begin

  stage1();

  grp2.Enabled:=True;

  grp2.Font.Color:=clWindowText;

  pgc1.Enabled:=True;

  pgc1.Font.Color:=clWindowText;

  strngrd1.Options:=strngrd1.Options+[goEditing];

end;

 

procedure TForm1.stage3;

begin

  stage2();

  grp3.Enabled:=True;

  grp3.Font.Color:=clWindowText;

end;

 

procedure TForm1.stage4;

begin

  stage3();

  grp4.Enabled:=True;

  grp4.Font.Color:=clWindowText;

end;

 

procedure TForm1.stage5;

begin

  stage4();

  strngrd1.Options:=strngrd1.Options-[goEditing];

end;

 

procedure TForm1.FormCreate(Sender: TObject);

begin

  Graph:=Tgraph.Create;

  graph.init;

  stage1();

  strngrd2.Rows[0].Append('№ Куска');

  strngrd2.Rows[0].Append('Количество');

end;

 

procedure TForm1.FormDestroy(Sender: TObject);

begin

  graph.release;

  graph.log.Free;

  graph.Free;

end;

 

procedure TForm1.btn3Click(Sender: TObject);

var

  i:Integer;

begin

graph.release;

if (isUInt(edt1.Text)) and (StrToInt(edt1.Text)>0) then begin

  graph.versh := StrToInt(edt1.Text);

  SetLength(graph.msmezh, graph.versh);

  SetLength(graph.ls, graph.versh);

  SetLength(graph.alpha, graph.versh);

  SetLength(graph.indexs, graph.versh);

  SetLength(graph.itog, graph.versh);

  For i:=0 to graph.versh-1 do begin

    SetLength(graph.msmezh[i], graph.versh);

    SetLength(graph.itog[i], graph.versh+1);

    end;

  stage2();

  end

else

  ShowMessage('Некорректное кол-во вершин');

  initmatrix();

end;

 

procedure TForm1.initmatrix;

var

  i,i1:Integer;

begin

strngrd1.ColCount:= graph.versh+1;

strngrd1.RowCount:= graph.versh+1;

strngrd1.Rows[0].Clear;

strngrd1.Rows[0].Append('-');

For i:=1 to graph.versh do begin

  strngrd1.Rows[i].Clear;

  strngrd1.Rows[i].Append('x'+inttostr(i));

  for i1 := 1 to graph.versh do

    strngrd1.Rows[i].Append(IntToStr(graph.msmezh[i-1][i1-1]));

  strngrd1.Cols[i].Append('x'+inttostr(i));

  end;

end;

 

procedure TForm1.btn4Click(Sender: TObject);

var

  i:integer;

begin

if (isUInt(edt2.Text)) and (StrToInt(edt2.Text)>1)

and (StrToInt(edt2.Text) <= graph.versh) then begin

  graph.kuskov := StrToInt(edt2.Text);

  SetLength(graph.vershVKuske, graph.kuskov);

  stage3();

  end

else

  ShowMessage('Некорректное кол-во кусков');

  strngrd2.Cols[0].Clear;

  strngrd2.Cols[1].Clear;

  strngrd2.Rows[0].Append('№ Куска');

  strngrd2.Rows[0].Append('Количество');

  strngrd2.RowCount := graph.kuskov+1;

  for i := 1 to graph.kuskov do

    strngrd2.Cols[0].Append(IntToStr(i));

end;

 

procedure TForm1.btn5Click(Sender: TObject);

var

  i,sum:integer;

begin

  sum := 0;

  for i:= 1 to graph.kuskov do begin

    if (isUInt(strngrd2.Cells[1,i]))

    and (StrToInt(strngrd2.Cells[1,i])>0) then begin

      graph.vershVKuske[i-1] := StrToInt(strngrd2.Cells[1,i]);

      sum:=sum+graph.vershVKuske[i-1];

      end

    else begin

      ShowMessage('Некорректное кол-во вершин для '+InttoStr(i)+'го куска');

      Exit;

    end;

  end;

  if (sum <> graph.versh) then begin

    if (sum < graph.versh) then

      ShowMessage('Количество вершин указанное при распределении'+

      ' меньше указаного при создании на '+Inttostr(graph.versh - sum))

    else

      ShowMessage('Количество вершин указанное при распределении'+

      ' больше указаного при создании на '+Inttostr(sum-graph.versh));

    Exit;

    end;

  stage4();

end;

 

function TForm1.start(turn:boolean):boolean;

var

  i0,i1,sum,smesh:integer;

  tmpstr:string;

begin

  result:=false;

  if graph.step=0 then begin

    graph.currk:=0;

    graph.state:=0;

    graph.log.Clear;

    strngrd1.ColCount:=graph.versh+2;

    strngrd1.Rows[0].Append('p');

    for i0 := 1 to graph.versh do begin

      graph.indexs[i0-1]:=true;

      graph.alpha[i0-1]:=0;

      graph.itog[i0-1][0]:=0;

      sum := 0;

      for i1 := 1 to graph.versh do

        if isUInt(strngrd1.Cells[i0,i1]) then

          if (StrToInt(strngrd1.Cells[i0,i1])=0){ or (i1=i0) bez petel} then

            graph.msmezh[i0-1,i1-1] := 0

          else begin

            graph.msmezh[i0-1,i1-1] := StrToInt(strngrd1.Cells[i0,i1]);

            sum := sum + graph.msmezh[i0-1,i1-1];

            //Inc(sum);

            end

        else begin

          ShowMessage('Некорректное значение в матрице смежности на позиции '+

          'x'+Inttostr(i0)+', x'+Inttostr(i1));

          Exit;

        end;

      graph.ls[i0-1]:=sum;

      strngrd1.Rows[i0].Append(IntToStr(sum));

      end;

  end;

  graph.razbit(turn);

  mmo1.Lines.Clear;

  for i0 := 1 to graph.kuskov do begin

    tmpstr:= 'Вершины в куске '+IntToStr(i0)+': ';

    for i1 := 1 to graph.itog[i0-1][0] do begin

        tmpstr := tmpstr+'x'+Inttostr(graph.itog[i0-1][i1]+1)+' '

      end;

    mmo1.Lines.Append(tmpstr);

    end;

  if (graph.kuskov = graph.currk)or(graph.step=0) then begin

    initmatrix;

    stage4;

    mmo2.Text:=graph.log.Text;

    Exit;

    end

  else begin

    smesh:=0;

    for i0 := 0 to graph.versh-1 do

      if not graph.indexs[i0] then Inc(smesh);

    strngrd1.RowCount:= graph.versh+1-smesh;

    if graph.teta then

      strngrd1.ColCount:=graph.versh+3-smesh

    else

      strngrd1.ColCount:=graph.versh+2-smesh;

    strngrd1.Rows[0].Clear;

    strngrd1.Rows[0].Append('-');

    smesh:=0;

    For i0:=1 to graph.versh do begin

      if not graph.indexs[i0-1] then begin

        Inc(smesh);

        Continue;

        end;

      strngrd1.Rows[i0-smesh].Clear;

      strngrd1.Rows[i0-smesh].Append('x'+inttostr(i0));

      strngrd1.Cols[i0-smesh].Append('x'+inttostr(i0));

      end;

    strngrd1.Rows[0].Append('p');

    if graph.teta then

      strngrd1.Rows[0].Append('s');

    smesh:=0;

    for i0 := 1 to graph.versh do begin

      if not graph.indexs[i0-1] then begin

        Inc(smesh);

        Continue;

        end;

      for i1 := 1 to graph.versh do begin

        if not graph.indexs[i1-1] then Continue;

        strngrd1.Rows[i0-smesh].Append(IntToStr(graph.msmezh[i0-1][i1-1]));

        end;

      strngrd1.Rows[i0-smesh].Append(IntToStr(graph.ls[i0-1]));

      if graph.teta then

        strngrd1.Rows[i0-smesh].Append(IntToStr(graph.ls[i0-1]-graph.alpha[i0-1]));

      end;

    end;

    mmo2.Text:=graph.log.Text;

  result:=true;

end;

 

procedure TForm1.btn6Click(Sender: TObject);

begin

if start(false) then

stage5;

end;

 

procedure TForm1.strngrd1SetEditText(Sender: TObject; ACol, ARow: Integer;

  const Value: String);

begin

  strngrd1.cells[ARow,ACol]:=Value;

end;

 

procedure TForm1.btn7Click(Sender: TObject);

begin

if start(true) then

stage5;

end;

 

procedure TForm1.btn2Click(Sender: TObject);

var

  f1:Textfile;

  i,i1:Integer;

begin

  if dlgSave1.Execute then begin

    if dlgSave1.FileName='' then exit;

    assignfile(f1,dlgSave1.FileName);

    {$I-}

    Rewrite(f1);

    {$I+}

    if (IOResult <> 0) then begin

      ShowMessage('Не удалось создать файл');

      exit;

      end;

    Writeln(f1, Graph.versh);

    for i:= 0 to Graph.versh-1 do

      for i1:= 0 to Graph.versh-1 do

        Writeln(f1, Strngrd1.cells[i+1,i1+1]);

    CloseFile(f1);

    end;

end;

 

procedure TForm1.btn1Click(Sender: TObject);

var

  f1:Textfile;

  i,i1:Integer;

  tmpstr:string;

begin

  if dlgOpen1.Execute then begin

    if dlgOpen1.FileName='' then exit;

    assignfile(f1,dlgOpen1.FileName);

    {$I-}

    Reset(f1);

    {$I+}

    if (IOResult <> 0) then begin

      ShowMessage('Не удалось открыть файл');

      exit;

      end;

    Readln(f1, Graph.versh);

    edt1.Text:=Inttostr(Graph.versh);

    btn3Click(self);

    for i:= 0 to Graph.versh-1 do

      for i1:= 0 to Graph.versh-1 do begin

        Readln(f1, tmpstr);

        strngrd1.Cells[i+1,i1+1]:=tmpstr;

        end;

    CloseFile(f1);

    end;

end;

 

procedure TForm1.N1Click(Sender: TObject);

begin

  SGCopyToCLP(strngrd1, False);

end;

 

end.