Подпрограммы на паскале

[vlad1991]

Задача 1.
Задача на процедуру:дана квадратная матрица действительных чисел размером m(m<=10).Преобразовать матрицу так, чтобы на главной диагонали стояли максимальные элементы соответсвенного столбца.

Задача 2.
Задача на функцию:
В заданной матрице x размером n*m (n,m <=10) найти количество элементов в каждом столбце,больших среднего арифмитического элементов данного столбца.

вот мое решение, но мне преподователь сказала не правильно!Если не сложно подскажите в чем ошибка???

1 задача:
program lab51;
type
matr=array[1..10,1..10] of integer;
var
k,i,j,n,m:integer;
x,y:matr;
procedure INMATR(var x:matr;n,m:integer);
var
i,j:integer;
begin
for i:=1 to n do
for j:=1 to m do
begin
writeln('vvedite x[i,j]');
readln(x[i,j]);
end;
end;
procedure OUTMATR(x:matr;n,m:integer);
var
i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to m do
write(x[i,j]:3);
writeln;
end;
end;
procedure MAX(x:matr;var y:matr;n,m:integer);
var
i,j,max:integer;
begin
k:=1;
max:=x[1,j];
for j:=1 to m do
begin
for i:=2 to n do
if x[i,j]>max then
max:=x[i,j];
y[k,k]:=max;
k:=k+1;
end;
end;
begin
writeln('vvedite n,m');
readln(n,m);
INMATR(x,n,m);
writeln('ishodnii massiv');
OUTMATR(x,n,m);
MAX(x,y,n,m);
writeln('poluchenii massiv');
outmatr(y,n,m);
readln
end.


2 задача:
program lab52;
uses crt;
type
matr=array[1..10,1..10] of integer;
var
n,m,j:integer;
x:matr;
procedure INMATR(var x:matr;n,m:integer);
var
i,j:integer;
begin
for i:=1 to n do
for j:=1 to m do
begin
writeln('vvedite x[i,j]');
readln(x[i,j]);
end;
end;
procedure OUTMATR(x:matr;n,m:integer);
var
i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to m do
write(x[i,j]:3);
writeln;
end;
end;
function KOLICH(x:matr;j,n:integer):integer;
var
k,i,l:integer;
S,SRED:real;
begin
S:=0;
i:=1;
repeat
S:=S+x[i,j];
i:=i+1;
until i>n;
SRED:=S/n;
k:=0;
for i:=1 to n do
if x[i,j]>SRED then
k:=k+1;
KOLICH:=k;
end;
begin
writeln('vvedite n,m');
readln(n,m);
INMATR(x,n,m);
writeln('ishodnii massiv');
OUTMATR(x,n,m);
writeln('poluchenii rezultat');
for j:=1 to m do
writeln('k=',KOLICH(x,j,n));
readln
end.

[vlad1991]

Неужели ничего никто не знает!!!!!!!!

[puporev]

Вот держи первую, не усну посмотрю вторую. Кроме серьезных ошибок всякая мелочь. Матрица действительная, тип integer. Раз есть главная диагональ, матрица квадратная, зачем m,n и т.д.

program lab51;
uses crt;
type
matr=array[1..10,1..10] of real;
procedure INMATR(var x:matr;n:integer);
var i,j:integer;
begin
writeln('Vvedite elementy matricy:');
for i:=1 to n do
for j:=1 to n do
read(x[i,j]);
readln;
clrscr;
end;
procedure OUTMATR(x:matr;n:integer);
var i,j:integer;
begin
for i:=1 to n do
    begin
       for j:=1 to n do
       write(x[i,j]:6:2);
       writeln;
     end;
end;
procedure MAX(var x:matr;n:integer);
var i,j,imax:integer;
    max,f:real;
begin
for j:=1 to n do
   begin
     max:=x[1,j];imax:=1;
     for i:=1 to n do
       begin
         if x[i,j]>max then
            begin
               max:=x[i,j];
               imax:=i;
            end;
         f:=x[j,j];
         x[j,j]:=x[imax,j];
         x[imax,j]:=f;
       end;
   end;
end;
var a:matr;
    i,j,n:integer;
begin
clrscr;
writeln('vvedite n');
readln(n);
INMATR(a,n);
writeln('ishodnii massiv');
OUTMATR(a,n);
MAX(a,n);
writeln('poluchenii massiv');
outmatr(a,n);
readln
end.

[vlad1991]

Спасибо!Но вот у меня вопрос!Я протестировал, там получается так, что первый столбецизменяется, а вот 2 столбец остается прежним!!!!Может надо цикл в главной программе!?

[puporev]

Я не знаю что у яВас со вторым столбом, у меня все максимальные элементы становятся на главную диагональ, а тестировал я не раз и не два и при разном размере матрицы и при вещественных числах. Может у Вас максимальный элемент и так оказался на главной диагонали, естественно он никуда не переехал. Ну а если Вы даже знаете про цикл в главной программе, то и доброгого Вам пути и нехрен у людей время отнимать.

[vlad1991]

Простите меня пожалуйста может я что-то не так сказал, я же просто спросил!!!!
Я же не привожу к Вам притензии!!!Я Вам очень благодарен за помощь!!!!!

Какие ошибки в 2 задаче!?

[puporev]

program lab52;
uses crt;
type
matr=array[1..10,1..10] of integer;
procedure INMATR(var x:matr;n,m:integer);
var i,j:integer;
begin
writeln('Vvedite elementy matricy:');
for i:=1 to n do
for j:=1 to m do
read(x[i,j]);
readln;
clrscr;
end;
procedure OUTMATR(x:matr;n,m:integer);
var i,j:integer;
begin
for i:=1 to n do
   begin
     for j:=1 to m do
     write(x[i,j]:3);
     writeln;
   end;
end;


function KOLICH(x:matr;j,n:integer):integer;
var k,i,l:integer;
S:real;
begin
S:=0;k:=0;
for i:=1 to n do
s:=s+x[i,j]/n;
for l:=1 to n do
if x[l,j]>s then
k:=k+1;
KOLICH:=k;
end;
var n,m,j:integer;
    x:matr;
begin
clrscr;
writeln('vvedite n,m');
readln(n,m);
INMATR(x,n,m);
writeln('ishodnii massiv');
OUTMATR(x,n,m);
writeln('poluchenii rezultat');
for j:=1 to m do
writeln('Kol. elementov ,bolshih srednego v stolbce ',j,'=',KOLICH(x,j,n));
readln
end.

[vlad1991]

Большое Вам спасибо!!!Вы мне очень помогли в нелегком деле!

[vlad1991]

Вот еще одну прогу сделал, она работает все нормуль, но посмотрите пожалуйста правильно ли я выполнил прогу, т.е.правильно я понял условие!
Буду Вам очень благодарен!

Имеется массив записей, содержащий перечень имеющихся в продаже товаров.Определить общую стоимость приобретенных товаров , если известно , сколько единиц каких видов товаров продано.

program lab61;
type tov = record
m:string[10];
j:integer;
b:integer;
end;
mas=array[1..10] of tov;
var
a:mas;
p,S,n,i:integer;
procedure INMAS(var x:mas;n:integer);
var
i:integer;
begin
for i:=1 to n do
with x[i] do
begin
writeln('Vvedite tovar');
readln(m);
writeln('vvedite cenu');
readln(j);
writeln('vvedite kolich priobretenih tov');
readln(b);
end;
end;
procedure OUTMAS(x:mas;n:integer);
var
i:integer;
begin
writeln('ЙННННННННННЛНННННННННЛНННН НННННН»');
writeln('є в®ў*а є жҐ** єЄ®«ЁзҐбвў®є');
writeln('МННННННННННОНННННННННОНННН НННННН№');
for i:=1 to n do
writeln('є',x[i].m:10,'є',x[i].j:9,'є',x[i].b:10);
writeln('ИННННННННННКНННННННННКНННН ННННННј');
end;
function SUMMA(S:integer;x:mas;i:integer):in teger;
begin
SUMMA:=x[i].b*x[i].j;
end;
begin
writeln('ўўҐ¤ЁвҐ Є®«ЁзҐбвў® в®ў*а®ў');
readln(n);
INMAS(a,n);
OUTMAS(a,n);
S:=0;
for i:=1 to n do
begin
p:=SUMMA(S,a,i);
S:=S+p;
end;
writeln('obchay stoimost =',S);
readln
end.

[vlad1991]

НЕ ОБРАЩАЙТЕ внимание на то что написано в writeln, где непонятные символы, просто там я описывал таблицу!!!!