• B правой части каждого сообщения есть стрелки и . Не стесняйтесь оценивать ответы. Чтобы автору вопроса закрыть свой тикет, надо выбрать лучший ответ. Просто нажмите значок в правой части сообщения.

  • Познакомьтесь с пентестом веб-приложений на практике в нашем новом бесплатном курсе

    «Анализ защищенности веб-приложений»

    🔥 Записаться бесплатно!

  • CTF с учебными материалами Codeby Games

    Обучение кибербезопасности в игровой форме. Более 200 заданий по Active Directory, OSINT, PWN, Веб, Стеганографии, Реверс-инжинирингу, Форензике и Криптографии. Школа CTF с бесплатными курсами по всем категориям.

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

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

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
 
L

lazybiz

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

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

spezzA

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

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

nayke

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

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

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

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 ();
Нада написать условие не догоняю как, оно берётся из условия задачи.
 
N

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;

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

spezzA

Вроде как началось получаться :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;
 
N

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);
иначе процедура смысла не имеет - выводишь массив, который только что объявил.
 
S

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

Обучение наступательной кибербезопасности в игровой форме. Начать игру!