одномерный массив Опции

[falcon]

Помогите пожалуйста со следующей задачей: Разделить одномерный массив на 3 части, которые по возможности имеют минимальное расхождение сумм. Например: исходный массив - 1 2 3 4 5 6, полученые массивы - 6 1, 5 2, 3 4. Необязательно чтоб в полученном массиве было одинаковое количество чисел. Я пробывал что-то сделать но ответ выводится неправильно. Не понял только как сделать так чтобы выводились 3 массива которые бы включали все введенные числа.

uses crt;
var
   a,b:array[1..100] of integer;
   n:byte;
   sym:integer;sum,k:real;
   f:boolean;
   i,j,h,s,rab:integer;
begin
     {Vvodim vse podryat}
     clrscr;
     Writeln('Vvedite kolichestvo elimentov massiva<=100');
     Readln(n);
     for i:=1 to n do
     begin
     writeln(i,' :eliment');
     readln(a[i]);
     end;
      {sortirovka elementov}
      begin
      for j:=1 to n-1 do
      for i:=1 to n-1 do
      if a[i]>a[i+1] then begin
      rab:=a[i];
      a[i]:=a[i+1];
      a[i+1]:=rab;
      end;
     end; 
     sym:=0;
     for i:=1 to n do
     sym:=sym+a[i];
     sum:=sym/3; 
     {Nachinaetsya glavniji cikl
     idem sverhu v niz}
     for i:=n downto 1 do
     begin
         s:=1;
         b[1]:=a[i];
         repeat
         h:=1;
         k:=sum-a[i]; {vichitaem naibol'shiji eliment podposledovatel'nosti
                      i nachinaem proveryat' so sledueshigo}
         if k=0 then begin write(a[i]);break;end {dobavil proverku pered
                                                  ciklom}
         else
         begin
         for j:=i-s downto 1 do
         begin
             if k<a[j] then continue else   {esli eliment bol'she k, to
                                                  idem k sleduushimu}
             begin
             k:=k-a[j];
             inc(h);b[h]:=a[j];            {sohronyaem na vsyakji sluchaji}
             if k=0 then break;            {esli k=0 vihodim iz cikla}
             end;
         end;
         if k=0 then          {proviryam esli k=0, to raspichativaem
                              posledovatel'nost', esli net
                              to posledovatel'nosti s dannim
                              naibol'shim chlenom izchrponi, perehodim k
                              sleduushimu}
         begin
             writeln;
             for j:=1 to h do write(b[j],' ');f:=true;inc(s);
         end else f:=false;
         end; {konec dobavki}
         until not f;
     end;
     repeat until keypressed;
end.  

Заранее благодарен

[klem4]

разделение одномерного массива

Хотя нет, там немного другое условие дробления ...

Сообщение отредактировано: klem4 - 9.05.2007 13:37

[falcon]

По той ссылке задача решена но немножко не так. При том массиве что там в программе( 12345 ) в ответе выводится 1->1,2->2,3->5. а по программе должно выводится 5 14 23

[klem4]

По той ссылке задача решена но немножко не так

Там все решено _так_ просто условие задачи там отличается от твоего, там надо было разбить исходный массив на 3 блока, не перемещая его элементы.

[falcon]

Решил сам программу до конца. Выкладываю код. Возможно кому-то понадобится в будущем.

uses crt;
var a:array[1..100] of integer;
    a1,a2,a3:array[1..34] of integer;
    prom,n,prom_n:integer;
    n1,n2,n3:integer;
    sum,nn:real;
    i,k,j,m:integer;
begin
 clrscr;
 write('vvedite kolichestvo elementov massiva(<=100):');
 readln(n);
 for i:=1 to n do
 begin
 write('vvedite',i,'element massiva:');
 readln(a[i]);
 end;
 {-------------}
   for i:=2 to n do
   begin
   for j:=1 to i-1 do
   begin
   if (a[i]>a[j]) then
   begin
     prom:=a[i];
     for k:=i-1 downto j do a[k+1]:=a[k];
     a[j]:=prom;
   end;
 end;
end;
{sum:=0;
for i:1 to n do sum:=sum+a[i];
sum:=sum/3;}
nn:=n/3;
if (frac(nn)=0) then
   begin
     prom_n:=trunc(nn);
     if((prom_n mod 2)=0) then
       begin
       n1:=trunc(prom_n/2);
       n2:=trunc(prom_n/2);
       {first array}
       j:=1;
       for i:=1 to n1 do
       begin
	 a1[j]:=a[i];
	 j:=j+1;
	 a1[j]:=a[n-i+1];
	 j:=j+1;
       end;
       {second array}
       j:=1;
       for i:=n1+1 to n1+n2 do
       begin
	 a2[j]:=a[i];
	 j:=j+1;
	 a2[j]:=a[n-i+1];
	 j:=j+1;
       end;
       {third array}
       j:=1;
       for i:=n1+n2+1 to n-n1-n2 do
       begin
	 a3[j]:=a[i];
	 j:=j+1;
       end;
       n1:=prom_n;
       n2:=prom_n;
       n3:=prom_n;
     end
     else
     begin
       n1:=trunc(prom_n/2)+1;
       n2:=trunc(prom_n/2)+1;
       {first array}
       j:=1;
       for i:=1 to n1 do
       begin
	 if(i<n1) then
	 begin
	   a1[j]:=a[i];
	   j:=j+1;
	   a1[j]:=a[n-i+1];
	   j:=j+1;
	 end
	 else
	 begin
	   a1[j]:=a[n-i+1];
	   j:=j+1;
	 end;
       end;
       {second array}
       j:=1;
       for i:=n1 to n1+n2-1 do
       begin
       if(i<(n1+n2-1)) then
       begin
	 a2[j]:=a[i];
	 j:=j+1;
	 a2[j]:=a[n-i];
	 j:=j+1;
       end
       else
       begin
	 a2[j]:=a[n-i];
	 j:=j+1;
       end;
     end;
     {third array}
     j:=1;
     for i:=n1+n2 to n-n1-n2+1 do
       begin
	 a3[j]:=a[n-i];
	 j:=j+1;
       end;
     n1:=prom_n;
     n2:=prom_n;
     n3:=n-n1-n2;
   end;
end
else
  begin
  prom_n:=trunc(nn)+1;
  if ((prom_n mod 2)=0) then
  begin
    n1:=trunc(prom_n/2);
    n2:=trunc(prom_n/2);
    {first array}
    j:=1;
    for i:=1 to n1 do
    begin
      a1[j]:=a[i];
      j:=j+1;
      a1[j]:=a[n-i+1];
      j:=j+1;
    end;
    {second array}
    j:=1;
    for i:=n1+1 to n1+n2 do
    begin
      a2[j]:=a[i];
      j:=j+1;
      a2[j]:=a[n-i+1];
      j:=j+1;
    end;
    {third array}
    j:=1;
    for i:=n1+n2+1 to n-n1-n2 do
    begin
      a3[j]:=a[i];
      j:=j+1;
    end;
    n1:=prom_n;
    n2:=prom_n;
    n3:=n-n1-n2;
  end
  else
  begin
    if ((nn-trunc(nn))>0.5) then
    begin
      n1:=trunc(prom_n/2)+1;
      n2:=trunc(prom_n/2)+1;
      {first array}
      j:=1;
      for i:=1 to n1 do
      begin
	if(i<n1) then
	begin
	  a1[j]:=a[i];
	  j:=j+1;
	  a1[j]:=a[n-i+1];
	  j:=j+1;
	  end
	  else
	    begin
	      a1[j]:=a[n-i+1];
	      j:=j+1;
	    end;
	end;
	{second array}
	j:=1;
	for i:=n1 to n1+n2-1 do
	begin
	  if(i<(n1+n2-1)) then
	  begin
	    a2[j]:=a[i];
	    j:=j+1;
	    a2[j]:=a[n-i];
	    j:=j+1;
	  end
	  else
	  begin
	    a2[j]:=a[n-i];
	    j:=j+1;
	  end;
	end;
	{third array}
	j:=1;
	for i:=n1+n2 to n-n1-n2+1 do
	begin
	  a3[j]:=a[n-i];
	  j:=j+1;
	end;
	n1:=prom_n;
	n2:=prom_n;
	n3:=n-n1-n2;
      end
      else
      begin
	n1:=trunc(prom_n/2)+1;
	n2:=trunc(prom_n/2);
	{first array}
	j:=1;
	for i:=1 to n1 do
	begin
	  if (i<n1) then
	    begin
	    a1[j]:=a[i];
	    j:=j+1;
	    a1[j]:=a[n-i+1];
	    j:=j+1;
	    end
	  else
	    begin
	      a1[j]:=a[n-i+1];
	      j:=j+1;
	    end;
	end;
	{second array}
	j:=1;
	for i:=n1 to n1+n2-1 do
	begin
	  a2[j]:=a[i];
	  j:=j+1;
	  a2[j]:=a[n-i];
	  j:=j+1;
	end;
	{third array}
	j:=1;
	for i:=n1+n2 to n-n1-n2 do
	begin
	  a3[j]:=a[i];
	  j:=j+1;
	end;
	n1:=prom_n;
	n2:=prom_n-1;
	n3:=n-n1-n2;
      end;
    end;
  end;
  write('first array:');
  for i:=1 to n1 do
  write(a1[i],' ');
  writeln(' ');
  write('second array:');
  for i:=1 to n2 do
  write(a2[i],' ');
  writeln(' ');
  write('third array:');
  for i:=1 to n3 do
  write(a3[i],' ');
  readln;
end.