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

  • Автор темы spezzA
  • Дата начала
Статус
Закрыто для дальнейших ответов.
S

spezzA

Гость
#1
Помогите пожалуйста с решением задачи.Вроде как работает но считает не правильно.
К примеру в текстовой последовательности чисел 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

Well-Known Member
03.11.2010
1 339
0
#2
О изобретении тэгов в курсе? Есть такой один важный принцип... тэги ставить.

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

spezzA

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

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

nayke

Well-Known Member
04.08.2010
310
0
#5
числа изменились но всё равно считает не правильно

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

spezzA

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


Код:
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

Well-Known Member
04.08.2010
310
0
#7
Код:
		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;
в любом месте где необходимо посмотреть промежуточный результат
 
S

spezzA

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

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

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

Код:
 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

Well-Known Member
04.08.2010
310
0
#9
Код:
 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);
иначе процедура смысла не имеет - выводишь массив, который только что объявил.
 
S

spezzA

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


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 надо написать условие...
 
Статус
Закрыто для дальнейших ответов.