Массивы, матрицы, процедуры, функции, работа с файлами.

[imedved]

1) Обработать на ЭВМ одномерный массив в соответствии с вариантом, при этом нужно составить программу таким образом, чтобы она была применима для массивов любых размеров в пределах тех ограничений, которые указаны в задаче.
Найти максимальный элемент массива С[K] и его порядковый номер. K<20.
Решение: Проверьте пожалуйста и скажите в чем ошибки если есть.
Программа

program laba4;
  uses crt;
  var i,n,r,max,imax,:integer;
      С:array[1..K] of integer;
begin
  clrscr;
  randomize;
  write('число элементов k<20 ');
  readln(k);
  for i:=1 to k do 
    begin
      c[i]:=random(45)-22;
{Получаем случайные числа и выводим их на экран.}
      write(c[i],' ');
    end;
{За начальный максимум (минимум) берем первый элемент массива.}
  max:=c[1];
  for i:=1 to k do 
    begin
{Если найдется элемент, больший МАХ, то МАХ будет равен этому элементу. Одновременно запоминаем индекс промежуточного максимума.}
      if c[i]>= max then
        begin
          max:=c[i]; imax:=i; 
        end;
    end;
{Печатаем максимальный элемент и его индекс.}
  writeln(max, ' номер' ,imax);
  readkey;
end.

2) Обработать на ЭВМ матрицу в соответствии с вариантом задания. Программу нужно составить таким образом, чтобы она была применима для массивов любых размеров в пределах заданных ограничений: N < 10, M < 10. Вывести на печать исходные данные и результат вычисления в общепринятом виде.
Сменить знаки у элементов матрицы B[N,M] лежащие выше главной диагонали и имеющие четную сумму индексов.
Проверьте пожалуйста и скажите в чем ошибки.
Программа

program laba5;
uses crt;
const n=7;
const m=8;
var a:array [1..n,1..m] of integer;
i,j:byte;
begin
{clrscr;
write ('введите размерность матрицы n,m ');
readln(n,m);}
randomize;
for i:=1 to n do
begin
for j:=1 to m do
a[i,j]:=random(99)-50;
end;
writeln('Исходная матрица*');
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j]:5);
end;
for i:=1 to n do
begin
for j:=1 to m do
if (i<j) and ((i+j)mod 2=0) then a[i,j]:=a[i,j]*(-1);
end;
writeln('Измененная матрица*');
for i:=1 to n do
begin
for j:=1 to m do
write(a[i,j]: 5);
end;
readkey;
end.

3) Помогите пожалуйста решить задачу, используя процедуру с параметрами. В качестве исходных данных, принять матрицы A[N,M] и B[K,L] при N=<10, M=<5, K=<7, L=<6.
В каждую из двух матриц добавить по столбцу, в которой элементы равны суммам элементов соответствующих строк.
Тут нужна помощь т.к. не очень понимаю как делать эту задачу.
Программа

program lab7;
uses crt;
var a:array[1..n,1..m] of integer;
b:array[1..k,1..l] of integer;
procedure vvod(не знаю что тут писать);
var i,j:byte;
n,m,k,l:integer;
begin
repeat
write('Введите размерность матрицы N?10, M?5, K?7, L?6:  ');
readln(n,m,k,l);
until (N?10)and (M?5) and (K?7) and (L?6);
Writeln('Исходнst матрицы:');
for i:=1 to n do
 begin
  for j:=1 to m do
   begin
    a[i,j]:=random(10)-1;
    write(a[i,j]:5);
   end;
  writeln;
for i:=1 to k do
 begin
  for j:=1 to l do
   begin
    b[i,j]:=random(10)-1;
    write(b[i,j]:5);
   end;
  writeln;
 end;
procedure vyvod(не знаю что тут писать);
var i,j:byte;
begin
for i:=1 to n do
 begin
  for j:=1 to m do
  write(a[i,j]:5);
  writeln;
 end;
for i:=1 to k do
 begin
  for j:=1 to l do
  write(b[i,j]:5);
  writeln;
 end;
readln;
end;
procedure sumstrok(не знаю что тут писать);
var i,j:byte;
begin
sm:=0;
for i:=1 to n do
sm:=sm+a[t,i];
sm:=0;
for i:=1 to n do
sm:=sm+b[c,i];
end;
procedure vstavka(не знаю что тут писать);
var i,j:byte;
begin
for i:=1 to n do
for j:=1 to t+1 do
a[i,j]:=a[i,j-1];
for i:=1 to n do
a[i,t]:=1;
for i:=1 to k do
for j:=1 to c+1 do
b[i,j]:=a[i,j-1];
for i:=1 to l do
a[i,c]:=сумму строки не знаю как посчитать;
end;
var t,c:integer;
begin
clrscr;
randomize;
vvod(опять не знаю что писать);
writeln('после какого столбца вставить дополнительный столбец для 1 матриц t для второй c' t,c);
readln(t,c);
sumstrok(опять не знаю что писать);
vstavka(опять не знаю что писать);
vyvod(опять не знаю что писать);
end.

4) Решить задачу, используя функцию пользователя.
Алгоритм который следует оформить ввиде функции:
Вычислить z сумму функций.
z=f(a,b)+f(a-1,b)+f(a-b,b)+f(a,b-1),
где f(u,t)={u+t, если u>=0, t>=0; u-t, если u<0, t<0; u+t в остальных случаях.
Помогите пожалуйста с решением не знаю даже с какой стороны подступиться.
5)Составить программу создания файла, содержащего сведения об объектах для варианта задания. Программа должна обеспечить ввод исходных данных с клавиатуры, запись исходной информации в файл, чтение и печать созданного файла. Выполнить программу обработки файла.
Имя объекта: Студент;
Поля записи: ФИО студента, группа, оценки по 4 экзаменам;
Задачи обработки: Подсчитать и вывести на экран средний балл, полученные каждым студентом группы X. Нужно сделать без использования массивов.
Ситуация как с 4 заданием.
Помогите пожалуйста.

[GetMax]

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

Const
  N=10;
  l=6;
Type
  Matr=array[1..n,1..l] of integer;
Var
  A,B:Matr;
  Strok1,Stolb1:Byte;
  Strok2,Stolb2:Byte;
procedure vvod(Var Mas:Matr; N,M:Byte);
var
  i,j:byte;
begin
  for i:=1 to n do
  begin
    for j:=1 to m do
    Mas[i,j]:=random(10)-1;
  End;
End;
procedure vivod(Var Mas:Matr; N,M:Byte);
var i,j:byte;
begin
  for i:=1 to n do
  begin
    for j:=1 to m do
    write(Mas[i,j]:5);
    writeln;
  end;
end;
Procedure Dobavit(Var Mas:Matr; N,M:Byte);
Var
  i,j:Byte;
  Sum:Integer;
Begin
  For i:=1 to N do
  Begin
    Sum:=0;
    For j:=1 to M do
    Begin
      Sum:=Sum+Mas[i,j]
    End;
    Mas[i,M+1]:=Sum
  End;
End;
begin
  Repeat
    Write('Vvedite razmer matrix A ');
    Readln(Strok1,Stolb1);
  Until (Strok1 <= 10) and (stolb1 <=5);
  Writeln;
  Repeat
    Write('Vvedite razmer matrix B ');
    Readln(Strok2,Stolb2);
  Until (Strok2 <= 7) and (Stolb2 <=6);
  Writeln;
  Writeln('Matrix A ');
  Vvod(A,Strok1,Stolb1);
  Vivod(A,Strok1,Stolb1);
  Writeln('Matrix B ');
  Vvod(B,Strok2,Stolb2);
  Vivod(B,Strok2,Stolb2);
  Writeln;
  Dobavit(A,Strok1,Stolb1);
  Writeln('Nov Matrix A ');
  Vivod(A,Strok1,Stolb1+1);
  Writeln;
  Dobavit(B,Strok2,Stolb2);
  Writeln('Nov Matrix B ');
  Vivod(B,Strok2,Stolb2+1);
  Readln
End.

[imedved]

GetMax, большое спасибо!
Для 4 задачи немного не так записал условие. Вот как оно должно быть:

4) Решить задачу, используя функцию пользователя.
Алгоритм который следует оформить ввиде функции:
Вычислить z сумму функций.
z=f(a,b)+f(a-1,b)+f(a-b,b)+f(a,b-1),
где f(u,t)={u+t, если u>=0, t>=0; u-t, если u<0, t<0; u+t в остальных случаях.
А вычислить нужно f(u,t)
Помогите пожалуйста с решением не знаю даже с какой стороны подступиться и не понимаю чего от меня тут хотят.

5)Составить программу создания файла, содержащего сведения об объектах для варианта задания. Программа должна обеспечить ввод исходных данных с клавиатуры, запись исходной информации в файл, чтение и вывод на экран созданного файла. Выполнить программу обработки файла.
Имя объекта: Студент;
Поля записи: ФИО студента, группа, оценки по 4 экзаменам;
Задачи обработки: Подсчитать и вывести на экран средний балл, полученные каждым студентом группы X.
Нужно сделать без использования массивов.
Ситуация как с 4 заданием.
Помогите пожалуйста.

[GetMax]

4) Решить задачу, используя функцию пользователя.

Var
  Z:Integer;
  a,b:Integer;
Function F(u,t:Integer):Integer;
Begin
  If (u > 0) and (t > 0) then F:=u+t
  Else
  If (u < 0) and (t < 0) then F:=u-t
  Else F:=u+t
End;
begin
   Readln(a,b);
   Z:=F(a,b)+F(a-1,b)+F(a-b,b)+F(a,b-1);
   Writeln('Z = ',Z);
   Readln
End.

[imedved]

GetMax, большое спасибо еще раз!

Вот попробовал сделать последнее задание:

program lab_10;
uses crt;
type
 book=record
        fio: string[30];
       group: string[20];
       score: integer;
      end;
 data_b=array[1..100] of book;
var
 db: data_b;
 db_zero: data_b;
 kol_vo,oper: integer;
 ext: boolean;
 f: text;

procedure IN_1 (var m: data_b; var a: integer);
var i:integer;
begin
 m:=db_zero;
 clrscr;
 write ('Введение количество записей: ');
 readln(a);
 clrscr;
 for i:=1 to a do
  with m[i] do
  begin
   write ('ФИО: '); readln(fio);
   write ('Группа: '); readln(group);
   write ('Оценки: '); readln(score);
   clrscr;
  end;
end;

procedure OUT (var m: data_b; a: integer);
var i:integer;
begin
 clrscr;
 writeln ('Вывод данных: ');
 for i:=1 to a do
  with m[i] do
  writeln(fio,' ',group,' ',score);
 repeat until keypressed;
end;

procedure OBR;

Вычислить среднее арифметическое по 4 экзаменам. Не знаю как реализовать. Без массивов.



 writeln ('обработка выполнена');
 readln;
 clrscr;
end;

procedure info (var a: integer);
begin
 clrscr;
 writeln ('1-ввести записи');
 writeln ('2-вывести записи');
 writeln ('3-обработать записи');
 writeln ('4-записать в файл');
 writeln ('5-чтение из файла');
 writeln ('6-выход');
 writeln;
 readln(a);
 clrscr;
end;

procedure file_IN (var f: text; a: integer; m: data_b);
var i: integer;
begin
 rewrite(f);
 for i:=1 to a do
 with m[i] do
 begin
   write (f,fio,' ');
   write (f,group,' ');
   writeln (f,score,' ');
  end;
 close(f);
 write ('База Данных сохранена в файл');
 readln;
end;

procedure file_OUT (var f: text; var a: integer; var m: data_b);
var i,j,z,x: integer;
    str: string;
    ye: string[4];
begin
 m:=db_zero;
 reset(f);
 i:=0; z:=0;
 while (not eof(f)) do
 begin
  i:=i+1;
  with m[i] do
  begin
   readln(f,str);
   for j:=1 to length(str) do begin
    if (str[j]<>' ') and (z=0) then fio:=fio+str[j];
    if (str[j]<>' ') and (z=1) then name:=group+str[j];
    if (str[j]<>' ') and (z=2) then score:=score+str[j];
    if str[j]=' ' then z:=z+1;
    val(score,x);
   end;
   z:=0;
   ye:='';
  end;
 end;
 close (f);
 a:=i;
 write('Файл прочитан');
 readln;
end;

begin
 assign (f,'db.txt');
 ext:=false;
 info(oper);
 repeat
  case oper of
       1: IN_1(db,kol_vo);
       2: OUT(db,kol_vo);
       3: OBR(db,kol_vo);
       4: file_IN (f,kol_vo,db);
       5: file_OUT (f,kol_vo,db);
       6: ext:=true;
  end;
  if oper<>6 then info(oper);
  clrscr;
 until ext=true;
end.

Подскажите пожалуйста что здесь не правильно и как среднее арифметическое рассчитать.