В паскале создать программу: «Взвесить», то есть найти суммы в двух массивах, двух файлах, двух списках и максимально уравновесить их, обменивая значения.

+ 0 -

Qwertyui21

14 июля 2013 г., 11:52:29 (10 лет назад)

Программа не идеально, но требуемый результат выдает. Несколько прогонов сделал, ошибок не было.
type  mas=array[1..10]of integer;
var
   i,j,k,sa,sb,r:integer;
   f:boolean;
   a,b:mas;

procedure zapoln(var a:mas);
var i:integer;
begin
for i:=1 to 10 do  a[i]:=random(10);
end;

function sum(a:mas):integer;
var i:integer;
begin
for i:=1 to 10 do  result:=result+a[i];
end;

procedure vyvod(a:mas);
var i:integer;
begin
for i:=1 to 10 do  write(a[i],' ');
writeln('; Сумма:',sum(a));
end;

procedure swap(var a,b:mas);
var i,k,j:integer;
begin
i:=random(1,10);
j:=random(1,10);
k:=a[i];
a[i]:=b[j];
b[j]:=k;
end;

begin
f:=false;
zapoln(a);
zapoln(b);
vyvod(a);
vyvod(b);
sa:=sum(a);
sb:=sum(b);
r:=sa-sb;
i:=1;
j:=1;
if r=1 then f:=true else
repeat
  while i<11 do
    begin
    while j<11 do
      begin
      if a[i]-b[j]=r/2 then
        begin
        k:=a[i];
        a[i]:=b[j];
        b[j]:=k;
        j:=10;
        i:=10;
        f:=true;
        end;
      j:=j+1
      end;
    j:=1;
    i:=i+1;
    end;
  if f=false then
    begin
    swap(b,a);
    sa:=sum(a);
    sb:=sum(b);
    r:=sa-sb;
    i:=1;
    j:=1;
    if r=1 then f:=true;
    end;
  i:=1;
  until f;
writeln('Решение:');
vyvod(a);
vyvod(b);
end.