Для проведения эксперимента создаются изображения, содержащие
случайные наборы цветных пикселей. В палитре 65 536 цветов, размер
изображения – 640 x 480 пк, при сохранении каждый пиксель кодируется
одинаковым числом битов, все коды пикселей записываются подряд, методы
сжатия не используются. Для каждого изображения дополнительно
записывается 60 Кбайт служебной информации. Сколько изображений
удастся записать, если для их хранения выделено 10 Мбайт
type
Matrix=array[,] of integer;
procedure MatPrint(a:Matrix);
begin
var m:=Length(a,1)-1;
for var i:=0 to Length(a,0)-1 do begin
for var j:=0 to m do Write(a[i,j]:4);
Writeln
end
end;
function IsEqual(a:Matrix; col:integer):boolean;
begin
var s:=sign(a[0,col]);
for var i:=1 to Length(a,0)-1 do s+=sign(a[i,col]);
if (s=0) then Result:=(a[0,col]<>0)
else Result:=false
end;
procedure DeleteCol(var a:Matrix; col:integer);
begin
var n:=Length(a,0)-1;
var m:=Length(a,1)-1;
for var j:=col+1 to Length(a,1)-1 do
for var i:=0 to n do a[i,j-1]:=a[i,j];
SetLength(a,n+1,m)
end;
begin
var n:=ReadInteger('Строк:');
var m:=ReadInteger('Столбцов:');
var a:=MatrixRandom(n,m,-99,99);
Writeln('Исходная матрица');
MatPrint(a);
for var j:=Length(a,1)-1 downto 0 do
if IsEqual(a,j) then DeleteCol(a,j);
Writeln('Результирующая матрица');
MatPrint(a);
end.
Тестовое решение
Строк: 8
Столбцов: 10
Исходная матрица
-3 -82 -25 -22 65 1 79 -67 -64 -82
17 36 48 -32 51 11 43 9 -35 4
-10 -5 80 82 -24 66 -12 -58 50 -94
52 70 53 85 -32 -59 46 57 -84 -44
81 71 -55 37 46 -15 -61 25 22 -7
-49 98 -42 -18 -44 -97 -63 -7 -98 99
-86 37 -17 -69 -35 46 82 62 99 11
65 85 -7 -90 23 19 -50 -56 -64 91
Результирующая матрица
-82 -25 -22 1 -64
36 48 -32 11 -35
-5 80 82 66 50
70 53 85 -59 -84
71 -55 37 -15 22
98 -42 -18 -97 -98
37 -17 -69 46 99
85 -7 -90 19 -64
var
f:file of integer;
i,k:integer;
begin
Randomize;
Assign(f,'in.dat'); Rewrite(f);
for i:=1 to 20 do begin
k:=Random(99)+1;
Write(f,k)
end;
Close(f)
end.
Тестовое решение
38 35 14 46 92 49 51 48 84 90 26 14 38 79 82 77 7 24 94 13
2. Основная программа
uses Crt;
const
nn=100;
var
i,j,k,n:integer;
fin,fout:file of integer;
a:array[1..nn] of integer;
dub:boolean;
begin
ClrScr;
Assign(fin,'in.dat'); Reset(fin);
Read(fin,k);
if not eof(fin) then begin
n:=1; Write(k,' '); a[n]:=k
end
else n:=0;
while (not eof(fin)) and (n<=nn) do begin
Read(fin,k); Write(k,' ');
j:=1; dub:=false;
while (j<=n) and (not dub) do begin
dub:=(a[j]=k); Inc(j);
end;
if not dub then begin Inc(n); a[n]:=k; Inc(j) end
end;
Writeln;
Close(fin);
for i:=1 to n do Write(a[i],' ');
Writeln; Writeln('n=',n);
Assign(fout,'out.dat'); Rewrite(fout);
Write(fout,n); Close(fout);
ReadKey
end.
Тестовое решение:
38 35 14 46 92 49 51 48 84 90 26 14 38 79 82 77 7 24 94 13
38 35 14 46 92 49 51 48 84 90 26 79 82 77 7 24 94 13
n=18
В качестве бонуса - решение этой же задачи в современной системе программирования PascalABC.NET.
// PascalABC.NET 3.1, сборка 1219 от 16.04.2016
begin
var fin,fout:file of integer;
Reset(fin,'in.dat');
var k:integer;
var a:=new integer[fin.FileSize];
var n:=0;
while not eof(fin) do begin
Read(fin,k); a[n]:=k; Inc(n)
end;
Close(fin);
a.Println;
var b:=a.ToHashSet;
b.Println; Writeln('n=',b.Count)
end.
Тестовое решение
38 35 14 46 92 49 51 48 84 90 26 14 38 79 82 77 7 24 94 13
38 35 14 46 92 49 51 48 84 90 26 79 82 77 7 24 94 13
n=18
И вопрос: для чего давать школьникам, 9/10 из которых никогда не будут программистами, устаревшие и громоздкие, сложные для понимания, написания и отладки системы программирования? Чтобы показать, "как все это сложно"?