Не правильно считает.(turbo Pascal)

[spezzA]

Помогите пожалуйста с решением задачи.Вроде как работает но считает не правильно.
К примеру в текстовой последовательности чисел 3 встречается 3 раза а в массиве и типизированном файле пишет 17.

Условие.

Дан текстовый файл, содержащий последовательность чисел. Переписать числа в массив и обработать

соответственно заданию. Затем переписать числа из текстового файла в типизированный файл и

обработать файл.

Задание.

Каждое число заменить на количество чисел, стоящих правее и равных ему. Если таких чисел нет, то заменить нулем. Затем удалить рядом стоящие нули, оставив один ноль.

uses
crt;

procedure Init;
var
f: text;
q: integer;
begin

writeln('0) Textovy fail:');
assign(f, 'in.txt');
reset(f);
while not eof(f) do
begin
read(f, q);
write(q:3);
end;

close(f);
writeln;
writeln;
end;

procedure Massiv;
var
f: text;
a: array[1..1000] of integer;
n: integer;
i, j, k: integer;
begin
assign(f, 'in.txt');
reset(f);

n:= 0;
while not eof(f) do
begin
n:= n+1;
read(f, a[n]);
end;

close(f);

for i:= 1 to n-1 do
begin
k:= 0;
for j:= i+1 to n do
if a[j]>a[i] then
k:= k+1;
a[i]:= k;
end;


i:= 2;
while i<=n do
begin
if (a[i]=0) and (a[i-1]=0)then
begin
for j:= i+1 to n do
a[j-1]:= a[j];
n:= n-1;
end else

i:= i+1;
end;


writeln('1) Massiv:');
for i:= 1 to n do
write(a[i]:3);
writeln;
writeln;

end;

procedure TypFile;
var
f: text;
g: file of integer;
q, w: integer;
n: integer;
i, j, k: integer;
begin
n:= 0;
assign(f, 'in.txt');
reset(f);
assign(g, 'in.typ');
rewrite(g);
while not eof(f) do
begin
read(f, q);
write(g, q);
n:= n+1;
end;

close(f);
close(g);

reset(g);

for i:= 1 to n-1 do
begin
seek(g, i-1);
read(g, q);
k:= 0;
for j:= i+1 to n do
begin
seek(g, j-1);
read(g, w);
if w>q then
k:= k+1;
end;
seek(g, i-1);
write(g, k);
end;

seek(g, 1);
i:= 2;
while i<=n do
begin
seek(g, i-1);
read(g, q);
seek(g, i-2);
read(g, w);
if (q=0) and (w=0) then
begin
for j:= i+1 to n do
begin
seek(g, j-1);
read(g, q);
seek(g, j-2);
write(g, q);
end;
n:= n-1;
end else
i:= i+1;
end;


seek(g, n);
truncate(g);

close(g);


reset(g);

writeln('2) Typ File:');
while not eof(g) do
begin
read(g, q);
write(q:3);
end;

close(g);
writeln;
writeln;
end;



begin
clrscr;
Init;
Massiv;
TypFile;
readkey;
end.

Последовательность чисел в текстовом файле.

3 2 4 5 3 2 4 5 68 67 66 4 34 43 23 3 4 6 45 23 5 65

 

[lazybiz]

О изобретении тэгов в курсе? Есть такой один важный принцип... тэги ставить.

* для коллег: извиняюсь что залез не в своё ...

 

[nayke]

for i:= 1 to n-1 do
begin
k:= 0;
for j:= i+1 to n do
if a[j] > a then
k:= k+1;
a:= k;
end;

смутное подозрение что вместо больше должно быть равно

 

[spezzA]

числа изменились но всё равно считает не правильно

Добавлено: числа изменились но всё равно считает не правильно

 

[nayke]

числа изменились но всё равно считает не правильно

Добавлено: числа изменились но всё равно считает не правильно

Добавте промежуточный вывод результатов и посмотрите где происходит ошибка. результат можете здесь показать.

 

[spezzA]

мне сказали сделать процедуру вывода массива и посмотреть где ошибка.

procedure vivod;
var i,j:integer;
n:integer;
begin
writeln ('Massiv');
for i:= 1 to n-1 do
for j:= i+1 to n do
write ();

Нада написать условие не догоняю как, оно берётся из условия задачи.

 

[nayke]

		writeln('1) Massiv:');
for i:= 1 to n do
write(a[i]:3);
writeln;
writeln;

Здесь по логике программы вы должны записывать в файл а не выводить на косоль.
Какое условие чтобы вывести массив

for i:= 1 to n do	write(a[i]);
readln;

в любом месте где необходимо посмотреть промежуточный результат

 

[spezzA]

Вроде как началось получаться
Надо в процедуре вывода массива вывести промежуточный массив, когда ещё не удалены нули.

Без этого выдаёт беспорядочное количество нулей.

Процедура вывода массива.

 procedure vivod;
var i,j:integer;
n:integer;
f:text;
a:array[1..1000] of integer;
begin
writeln ('1) Massiv:');
for i:= 1 to n do
write (a[i]:3);
readln;
writeln;
writeln;
end;

 

[nayke]

 procedure vivod;
var i,j:integer;
n:integer;
f:text;
a:array[1..1000] of integer;
begin
writeln ('1) Massiv:');
for i:= 1 to n do
write (a[i]:3);
readln;
writeln;
writeln;
end;

Я не очень понял в чем вопрос, но та процедура, которую ты описал при вызове вернет значения пустого массива.
если тебе надо вывести массив с которым работал до этого объеяви a:array[1..1000] of integer; глобально для программы,
или делай примерно так

type
massiv=array[1..1000] of integer;

procedure vivod(a:massiv);

иначе процедура смысла не имеет - выводишь массив, который только что объявил.

 

[spezzA]

Теперь перестало выводите тип.файл.


for i:= 1 to n-1 do
begin
seek(g, i-1);
read(g, q);
k:= 0;
for j:= i+1 to n do
begin
seek(g, j-1);
read(g, w);
if w=q then
k:= k+1;
end;
seek(g, i-1);
write(g, k);
end;

seek(g, 1);
i:= 2;
while i<=n do
begin
seek(g, i-1);
read(g, q);
seek(g, i-2);
read(g, w);
if (q=0) and (w=0) then
begin
for j:= i+1 to n do
begin
seek(g, j-1);
read(g, q);
seek(g, j-2);
write(g, q);
end;
n:= n-1;
end else
for i:= 1 to n do



end;


seek(g, n);
truncate(g);

close(g);


reset(g);
В тот помежуток, где начинается цикл for i:= 1 to n do надо написать условие...