Электростальский форум

Hi-Tech => Компьютеры, периферия, мультимедиа и ПО => Тема начата: Finder от 02.12.07, 13:33:51

Название: Помогите дописать прогу!
Отправлено: Finder от 02.12.07, 13:33:51

Вобщем за вознаграждение прощу помочь мне доделать прогу в Паскале. Написал бы сам, но нету времени, чтоб с этим разобраться!
матрица выводится, числа К, L, Z считает. Надо лишь только оформить подпрограмму по определению K и L,
и работу с файлом. вот текст проги:

{Dana matrica A razmernisti N*N. Vichislit' K ravnoe maximal'noy summe
elementov 'i' stroki, L ravnoe maximal'noy summe elementov 'j' stolbca.
Naiti men'wee iz etikh chisel Z. Vivesti iskhodnuy matricy,  chisla: K,
L, Z. Opredelenie maximuma oformit' podprogrammoy.}
program Dima;
uses crt;
var x: array [1..10, 1..10] of real;
    y: array [1..10] of real;
    n: integer; i: byte; j: byte; sumstr, sumstol, s1,  s2, z: real;

begin
 clrscr;
 writeln('Vvedite rang matrici n<=10');
 readln(n);
 randomize;
 writeln;
 for i:=1 to n do
  begin
   for j:=1 to n do
    x[i, j]:=random*200-100;
  end;
 for i:=1 to n do
  begin
   writeln;
   for j:=1 to n do
    write(x[i, j]:8:2);
  end;
 writeln;
 readln;
 sumstr:=0;
 for i:=1 to n do
  begin
   sumstr:=0;
   for j:=1 to n do
    begin
     sumstr:= sumstr+x[i, j];
    end;
   y:=sumstr;
  end;
 s1:=0;
 for j:=1 to n do
  write(y[j]:8:2);
 for j:=1 to n do
  begin
   if s1<y[j] then s1:=y[j];
  end;
 writeln;
 write('K= ', s1:8:2);

 readln;
 s2:=0;
 writeln;
 sumstol:=0;
 for j:=1 to n do
  begin
   sumstol:=0;
   for i:=1 to n do
    begin
     sumstol:= sumstol+x[i, j];
    end;
   y[j]:=sumstol;
  end;
 for j:=1 to n do
  write(y[j]:8:2);
 for j:=1 to n do
  begin
   if s2<y[j] then s2:=y[j];
  end;
 writeln;
 write('L= ', s2:8:2);
 readln;
 writeln;
 z:=s1;
 if z>s2 then writeln('Z= ', s2:7:2) else writeln('Z= ', z:7:2);
 readln;
end.

Название: Re: Помогите дописать прогу!
Отправлено: Nimak от 02.12.07, 19:10:57

Вот держы свою задачку. Кажется так, если я условие понял правильно. Я нашел суммы всех строк и столбцов, и нашел из них максимумы.

Название: Re: Помогите дописать прогу!
Отправлено: LEND от 02.12.07, 22:11:35

Вообще задача не сложная.
Оставил начальные ВАШИ данные.
Можно применить один раз процедуру MAX. Можно поставить друг за другом. Можно вводить параметры и т.д.


(*Вобщем за вознаграждение прощу помочь мне доделать прогу в Паскале. Написал бы сам, но нету времени, чтоб с этим разобраться!
матрица выводится, числа К, L, Z считает. Надо лишь только оформить подпрограмму по определению K и L,
и работу с файлом. вот текст проги:*)

{Dana matrica A razmernisti N*N. Vichislit' K ravnoe maximal'noy summe
elementov 'i' stroki, L ravnoe maximal'noy summe elementov 'j' stolbca.
Naiti men'wee iz etikh chisel Z. Vivesti iskhodnuy matricy,  chisla: K,
L, Z. Opredelenie maximuma oformit' podprogrammoy.}
program Dima;
uses crt;
var x: array [1..10, 1..10] of real;
    n: integer; i: byte; j: byte;
    K,L,Z:real;
{================ Процедура нахождения Max числа ======}
PROCEDURE Max;
var
sumst,sumsl:real;
begin
 for i:=1 to n do begin
   sumst:=0;
   sumsl:=0;
     for j:=1 to n do begin
                       sumst:=sumst+x[i,j];
                       sumsl:=sumsl+x[j,i];
                          end;
                        if i=1 then begin
                                     K:=sumst;
                                     L:=sumsl;
                                     end
                                     else begin
                           if K<=sumst then K:=sumst;
                           if L<=sumsl then L:=sumsl;
                                          end;
                       end;
end;
{======================================================}

BEGIN
 Repeat
 clrscr;
 writeln('Vvedite rang matrici n<=10');
 readln(n);
 if n>10 then begin
       writeln('Надо до n<=10. Снова сделать ввод - любая клавиша.');
       READLN;
              end;
 until n<=10;
 { --------------------- Твои начальные данные --------------- }
 randomize;
 for i:=1 to n do
  begin
   for j:=1 to n do
    x[i, j]:=random*200-100;
  end;
 for i:=1 to n do
  begin
   writeln;
   for j:=1 to n do
    write(x[i, j]:8:2);
  end;
{ ----------------------------------------------------------}
 writeln;
 writeln;
  K:=0;L:=0;
  Max; { Процедура }
 if K>=L then Z:=K else Z:=L;
 writeln('K=',K:5:2,' L=',L:5:2,' и Z=',Z:5:2);
writeln('Для выхода нажмите любую клавишу.');
Readkey;
END.

Проверил ВАШ листинг программы в работе.
Есть ошибки

program Dima;
uses crt;
var x: array [1..10, 1..10] of real;
    y: array [1..10] of real;
    n: integer; i: byte; j: byte; sumstr, sumstol, s1,  s2, z: real;

begin
 clrscr;
 writeln('Vvedite rang matrici n<=10');
 readln(n);
 randomize;
 writeln;
 for i:=1 to n do
  begin
   for j:=1 to n do
    x[i, j]:=random*200-100;
  end;
 for i:=1 to n do
  begin
   writeln;
   for j:=1 to n do
    write(x[i, j]:8:2);
  end;
 writeln;
 readln;
 sumstr:=0;
 for i:=1 to n do
  begin
   sumstr:=0;
   for j:=1 to n do
    begin
     sumstr:= sumstr+x[i, j];
    end;
   y:=sumstr;     {Вот здесь ошибка - подумай сам}
  end;
 s1:=0;
 for j:=1 to n do
  write(y[j]:8:2);
 for j:=1 to n do
  begin
   if s1<y[j] then s1:=y[j];
  end;
 writeln;
 write('K= ', s1:8:2);

 readln;
 s2:=0;
 writeln;
 sumstol:=0;
 for j:=1 to n do
  begin
   sumstol:=0;
   for i:=1 to n do
    begin
     sumstol:= sumstol+x[i, j];
    end;
   y[j]:=sumstol;
  end;
 for j:=1 to n do
  write(y[j]:8:2);
 for j:=1 to n do
  begin
   if s2<y[j] then s2:=y[j];
  end;
 writeln;
 write('L= ', s2:8:2);
 readln;
 writeln;
 z:=s1;
 if z>s2 then writeln('Z= ', s2:7:2) else writeln('Z= ', z:7:2);
 readln;
end.

С уважением
LEND