Помогите сделать блок-схему
Умова:
ПЛАВАЮЩИЭ ЧИСЛА
Дано N (<= N <= 1000) целых чисел. Каждое из них можно один раз изменить не более чем на целую величину L (1 <= L <= 3200) как в сторону увеличения, так и в сторону уменьшения или оставить без изменений. Если после такой операции некоторые из чисел окажутся равными, они зачисляются за одно. С данными числами провели указанную операцию таким образом, что осталась минимально возможное количество чисел.
Нужно написать программу для определения этого количества.
Код:
program swimming_numbers;
{$mode objfpc}{$H+}
uses classes, sysutils;
var f :file of integer;
k:file of integer;
const size=1000;
type mas=array[1..size] of longint;
var a:mas;
n,l,count:integer;
procedure made_file;
begin
assign(f,'input.txt');
rewrite(f);
write('введите количество елиментив: ');
read
; write(f,n);
write(' величину не большую которой можно будет изменить элемент: ');
read(l); write(f,l);
close (f);
end;
procedure Read_Data;
var i,l,n,k:integer;
begin
assign(f,'input.txt');
reset(f);
k:=filesize(f);
for i:=1 to k do
begin
read(f,a);
if i=1 then n:=a;
if i=2 then l:=a;
end;
writeln('Введите простое число*');
for i:=1 to n do begin
read(a);
write(f,a);
end; end;
procedure quicksort(var a:mas; lo,hi:longint);
procedure sort(l,r:longint);
var i,j,x,y:longint;
begin
i:=l;
j:=r;
x:=a[(l+r)div 2];
repeat
while a<x do inc(i);
while x<a[j] do dec(j);
if i<=j then begin
y:=a;
a:=a[j];
a[j]:=y;
inc(i);
dec(j);
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;
begin {quicksort};
sort(lo,hi);
end;
procedure solve;
var i:integer; j:longint;
begin
count:=0;
i:=1;
while i<=n do
begin
j:=i+1;
while j<=n and (a+2*l) do inc(j);
inc(count);
i:=j;
end;
end;
procedure write_data;
begin
assign(k,'output.txt');
rewrite(k);
write(k,count);
close(k);
end;
begin
made_file;
read_data;
quicksort(a,1,n);
solve;
write_data;
end.
Умова:
ПЛАВАЮЩИЭ ЧИСЛА
Дано N (<= N <= 1000) целых чисел. Каждое из них можно один раз изменить не более чем на целую величину L (1 <= L <= 3200) как в сторону увеличения, так и в сторону уменьшения или оставить без изменений. Если после такой операции некоторые из чисел окажутся равными, они зачисляются за одно. С данными числами провели указанную операцию таким образом, что осталась минимально возможное количество чисел.
Нужно написать программу для определения этого количества.
Код:
program swimming_numbers;
{$mode objfpc}{$H+}
uses classes, sysutils;
var f :file of integer;
k:file of integer;
const size=1000;
type mas=array[1..size] of longint;
var a:mas;
n,l,count:integer;
procedure made_file;
begin
assign(f,'input.txt');
rewrite(f);
write('введите количество елиментив: ');
read
; write(f,n);write(' величину не большую которой можно будет изменить элемент: ');
read(l); write(f,l);
close (f);
end;
procedure Read_Data;
var i,l,n,k:integer;
begin
assign(f,'input.txt');
reset(f);
k:=filesize(f);
for i:=1 to k do
begin
read(f,a);
if i=1 then n:=a;
if i=2 then l:=a;
end;
writeln('Введите простое число*');
for i:=1 to n do begin
read(a);
write(f,a);
end; end;
procedure quicksort(var a:mas; lo,hi:longint);
procedure sort(l,r:longint);
var i,j,x,y:longint;
begin
i:=l;
j:=r;
x:=a[(l+r)div 2];
repeat
while a<x do inc(i);
while x<a[j] do dec(j);
if i<=j then begin
y:=a;
a:=a[j];
a[j]:=y;
inc(i);
dec(j);
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;
begin {quicksort};
sort(lo,hi);
end;
procedure solve;
var i:integer; j:longint;
begin
count:=0;
i:=1;
while i<=n do
begin
j:=i+1;
while j<=n and (a+2*l) do inc(j);
inc(count);
i:=j;
end;
end;
procedure write_data;
begin
assign(k,'output.txt');
rewrite(k);
write(k,count);
close(k);
end;
begin
made_file;
read_data;
quicksort(a,1,n);
solve;
write_data;
end.
