 Сообщение было отмечено MuRDoK как решение
Решение
Задача №1.
Теорию сортировки бинарными вставками почитай в инете, инфы куча.
| Pascal | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
| uses crt;
type
mas=array[1..50] of integer;{линейный массив-строка матрицы}
matr=array[1..50] of mas;{массив строк-матрица}
procedure Sort_Str(var ms:mas;n:integer);{сортировка в строке}
var i,x,L,R,m,j:integer;
begin
for i:=2 to n do
begin
x:=ms[i];
L:=1; R:=i;
while L<R do
begin
m:=(L+R) div 2;
if ms[m]<=x then L:=m+1
else R := m;
end;
for j:=i downto R+1 do ms[j]:=ms[j-1];
ms[R]:=x;
end;
end;
procedure Sort_Matr(var mt:matr;n,k:integer);{сортировка строк, как элементов массива}
var i,x,L,R,m,j:integer;
st:mas;
begin
for i:=2 to n do
begin
x:=mt[i][k+1];{элемент в дополнительном столбце матрицы-произведение четных}
st:=mt[i];{строка матрицы}
L:=1; R:=i;
while L<R do
begin
m:=(L+R) div 2;
if mt[m][k+1]<=x then L:=m+1
else R:= m;
end;
for j:=i downto R+1 do
begin
mt[j][k+1]:=mt[j-1][k+1];{перемещаем элементы в доп. столбце}
mt[j]:=mt[j-1];{то же строки матрицы}
end;
mt[R][k+1]:=x;{вставляем элемент доп. столбца на место}
mt[R]:=st;{то же строки матрицы}
end;
end;
var n,m,i,j:integer;
p:longint;
a:matr;
begin
clrscr;
randomize;
write('Количество строк n=');readln(n);
write('Количество столбцов m=');readln(m);
writeln('Исходная матрица:');
for i:=1 to n do
begin
for j:=1 to m do
begin
a[i,j]:=random(9)+1;
write(a[i,j]:3);
end;
writeln;
end;
{сортировка в строках}
for i:=1 to n do
Sort_Str(a[i],m);
writeln('Результат сортировки в строках:');
for i:=1 to n do
begin
for j:=1 to m do
write(a[i,j]:3);
writeln;
end;
{вычисление произведений в строках и запись их в дополнительный массив}
for i:=1 to n do
begin
p:=1;
for j:=1 to m do
if a[i,j] mod 2=0 then p:=p*a[i,j];
a[i,m+1]:=p;
end;
{сортировка(перестановка строк)}
Sort_Matr(a,n,m);
writeln('Результат сортировки строк(последний столбец-произведение четных):');
for i:=1 to n do
begin
for j:=1 to m+1 do
if j=m+1 then{если элемент в последнем столбце}
if a[i,j]>1 then write(a[i,j]:6){и не 1, то выводим его с 6 знаками под число}
else write('Четных нет!':15){если 1, то сообщаем}
else write(a[i,j]:3);{остальные элементы по 3 позиции под число}
writeln;
end;
readln
end. |
|
№2.
Файл надо или писать латиницей, или конвертировать из Win в Dos, или писать в Паскале, тогда файл не *.txt, а *.pas
| Pascal | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
| uses crt;
const rz=['.',',',',',';',':','?','!',' '];{разделители слов-знаки препинания и пробел}
var f:text;
s:string;
i,k,imx:byte;
a:array[33..255] of integer;{массив кодов символов, первые 31 невидимые, 32-пробел}
mx:integer;
begin
clrscr;
assign(f,'file1.txt');
reset(f);
for i:=33 to 255 do a[i]:=0;{обнуляем массив}
while not eof(f) do
begin
readln(f,s);{читаем файл построчно}
k:=0;
for i:=1 to length(s)do{смотрим строку}
if (i=1)or (s[i-1]in rz) then{если символ первый, или после разделителя}
a[ord(s[i])]:=a[ord(s[i])]+1;{в ячейку с его кодом добавляем 1}
end;
close(f);
mx:=0;imx:=33;
for i:=33 to 255 do
if a[i]>mx then
begin
mx:=a[i];{находим самый частый символ первой буквы}
imx:=i;{его код}
end;
writeln('Чаще всего слова начинаются на букву ',chr(ord(imx)),' ',mx,' раз');
append(f);
writeln(f,'');
writeln(f,'Samaya chastaya pervaya bukva ',chr(ord(imx)),' ',mx,' raz');
close(f);
readln
end. |
|
2
|
(
Сообщение было отмечено MuRDoK как решение
