Паскаль, 4 базовые задачи.

[t1mer]

Привет всем!
Ниже приведены основные базовые задачи по паскалю.
Всего задач 10. Из них мной уже решено 6. Осталось добить эти 4.
Если есть мысли по поводу их решения, жду вашего ответа.
Огромное спасибо за предаставленую помощь и потраченное время

1.Дан текстовый файл. Удалить из него все лишнее пробелы, оставив между словами не более одного пробела. Результат поместить в новый файл.
2.Распечатать фамилии тех учеников класса, которые являют*ся хорошистами и отличниками по итогам года. Также указать, насколько их средний балл отличается от среднего балла класса.
3.Дан двумерный массив различных вещественных чисел, содержащий 5 строк и 4 столбца. Строку, содержащую максимальный элемент массива, поменять местами со строкой, содержащей минимальный элемент.
4.Напишите программу с подпрограммой для нахождения а) наибольшего; б) наименьшего из введенных с клавиатуры 5 чисел.

[-HunteR-]

А можно взглянуть на другие задачи и ваши решения оных?

[__STDC__]

4 задача - http://programmersforum.ru/showthread.php?t=55879

если уж вы сами сделали 6, то переделать ее вам труда не составит.. для нахождения наибольшего (в моем варианте) нужно заменить знак перед модулем с - на +

[t1mer]

Сообщение от __STDC__

4 задача - http://programmersforum.ru/showthread.php?t=55879

если уж вы сами сделали 6, то переделать ее вам труда не составит.. для нахождения наибольшего (в моем варианте) нужно заменить знак перед модулем с - на +

спасибо!

[t1mer]

Сообщение от -HunteR-

А можно взглянуть на другие задачи и ваши решения оных?

Конечно! Только зачем тебе это? Скину пару как пример.

Дан текстовый файл. Напечатать в алфавитном порядке все слова из данного файла, имеющие заданную длину п.

Program copy;
uses crt;
var T:text;
C:STRING; B:CHAR; N:INTEGER;
begin
clrscr;
assign(T,'TEXT.txt');
WRITELN('VVEDITE Text');
READLN(N);
FOR B:='A' TO 'Z' DO BEGIN
reset(T);
while not eof(T) do
begin
READLN(T,C); IF (C[1]= B) AND (LENGTH(C)=N) THEN WRITELN(C);
END;
END;
WRITELN;
WRITELN('BILO' );
reset(T);
while not eof(T) do
begin
READLN(T,C); WRITE(C,' ');
END;
CLOSE(T);
READLN;
END.

По данным сведениям об учениках класса определить сред*нюю массу мальчиков и средний рост девочек. Кто из учеников класса самый высокий?

program BLOK2;
USES CRT;
type m=record
roSt:integer;
imya:string[30];
massa:integer;
end;
STYD=array[1..100] of m;
var v:STYD; W:STYD; i,k,nn,N,S2,S3,s,S1,G,A,B,C:integer ; D,D1:REAL;
begin
CLRSCR;
write('VVEDITE KOLICHESTVO MALCHIKOB ');readln(nn);
S:=0; S1:=0;
for i:=1 to nn do
begin
write('POCT ',i,' MALCHIKA ');readln(v[i].ROST);
write('VVEDITE IMYA ',i,' ');readln(v[i].IMYA);
write('VVEDITE MACCY ',i,' ');readln(v[i].MASSA);
S:=S+V[I].ROST;
S1:=S1+V[I].MASSA;
IF (V[I].ROST)>B THEN BEGIN B:=V[I].ROST; A:=I; END;
end;
D:=S/NN;
D1:=S1/NN;
S:=0; S1:=0;
WRITELN ('CREDNII POCT Y MALCHIKOB ',D:3:1,' MASSA ',D1:3:1);
writeLN('VVEDITE KOLICHESTVO DEBOCHEK ');readln(n);
for i:=1 to n do
begin
write('POCT ',i,' DEBOCHKI ');readln(W[i].ROST);
write('VVEDITE IMYA ',i,' ');readln(W[i].IMYA);
write('VVEDITE MACCY ',i,' ');readln(W[i].MASSA);
S:=S+W[I].ROST;
S1:=S1+W[I].MASSA;
IF W[I].ROST>C THEN BEGIN C:=W[I].ROST; G:=I; END;
end;
D:=S/N;
D1:=S1/N;
WRITELN ('CREDNII POCT Y DEBOCHEK ',D:3:1,' MASSA ',D1:3:1);
IF C<B THEN BEGIN WITH V[A] DO BEGIN
WRITELN ('CAMII BICOKII ', IMYA,' ROCT ',ROST,' MASSA ',MASSA); END; END;
IF B<C THEN BEGIN WITH W[G] DO BEGIN
WRITELN ('CAMII BICOKII ',IMYA,' ROCT ',ROST,' MASSA ',MASSA); END; END;
READLN;
end.

[ОДИНОЧЕСТВО В СЕТИ]

program zadacha;//переделай и у тебя 2-ая будет
 uses crt;
  type s=record
   f: string [15];   {фамилия}
   im: string[15];   {имя}
   mat,fiz,inf:integer; {оценки}
  end;
   var
   i,n,j:integer;   {переменные счётчики, кол-во учеников}
   a:array[1..20] of s; {массив}
     begin
    clrscr;
     write('Введите кол-во учеников ');
     readln(n);
    for i:= 1 to n do
    with a[i] do
     begin
      write('Введите фамилию ',i,' учеников ');
      readln(f);
      write('Введите его имя ');
      readln(im);
      write('введите его оценку по математике ');
      readln(mat);
      write('введите его оценку по физике ');
      readln(fiz);
      write('введите его оценку по информатике ');
      readln(inf);
     end;
     for i:=1 to 75 do
        write('-');
        writeln;
        writeln('| № |Фамилия| Имя |оц. по мат.|оц.по физ.|оц.по инф.|');
        writeln('|   |       |     |           |          |          |');
        for i:= 1 to n do
        with a[i] do
         begin
          write(i:3,f:9,im:8,mat:9,fiz:9,inf:9);
          readln;
         end;
      for i:= 1 to n do   {условие}
      with a[i] do
       begin
        if (a[i].mat=5) and (a[i].fiz=5) and (a[i].inf=5) then begin
         writeln('отличник ',a[i].f,' ',a[i].im);
         readln;
        end;
        end;
        for i:= 1 to n do
        with a[i] do
        begin
         if (a[i].mat=4) or (a[i].fiz=4) or (a[i].inf=4)  then begin
         writeln('хорошист ',a[i].f,' ',a[i].im);
         readln;
        end;
       end;
     end.

[__STDC__]

Раз уж так.. вот программа, только столбцы меняет, а не строки) переделайте)))

uses
	crt;

const
	m = 5;
	n = 4;
	
type
	matrix = array[1..m,1..n] of integer;
	
procedure fill_matrix(var X:matrix);
var
	i,j:integer;
begin
	randomize;
	for i:=1 to m do
		for j:=1 to n do
			X[i,j] := random(10);
end;
	
function find_max(X:matrix):integer;
var
	i,j,max:integer;
begin
	max := X[1,1];
	for i:=1 to m do
		for j:=1 to n do
			if (X[i,j] > max) then begin
				max := X[i,j];
				find_max := j;
			end;
end;

function find_min(X:matrix):integer;
var
	i,j,min:integer;
begin
	min := X[1,1];
	for i:=1 to m do
		for j:=1 to n do
			if (X[i,j] < min) then begin
				min := X[i,j];
				find_min := j;
			end;
end;

procedure swap(max,min:integer; var X:matrix);
var
	i,n:integer;
begin
	for i:=1 to m do begin
		n := X[i,max];
		X[i,max] := X[i,min];
		X[i,min] := n;
	end;
end;


procedure out_matrix(X:matrix);
var
	i,j:integer;
begin
	for i:=1 to m do begin
		for j:=1 to n do
			write(X[i,j]:4);
		writeln;
	end;
end;

var
	A:matrix;
BEGIN
	clrscr;
	fill_matrix(A);
	out_matrix(A);
	swap(find_max(A),find_min(A),A);
	writeln;
	out_matrix(A);	
	readkey;
END.

[t1mer]

__STDC__, ОДИНОЧЕСТВО В СЕТИ спасибо огромное за помощь!