Консультации Портала - Консультация #178128

Задать вопрос Консультации Пользователи Форум

Задать вопрос экспертам

Консультация № 178128

30.04.2010, 16:46

0.00 руб.

0 12 1

Компьютеры Программирование

Добрый день!
Уважаемые эксперты помогите мне исправить программу.
Условие такое : Нужно ввести последовательность. Среди элементов найти колличество противополжных пар например "3 5 -3 -5" колличсетво равно 2. И еще одно условие,нужно ввести число и вывести те элементы,которые делятся на него и не делится на это число в квадрате. Я эту задачу решила,но у меня возникает ошибка,когда я заново запускаю файл(где находится уже созданная последовательность),и просматриваю его,потом обрабатываю,и вывожу результат,но у меня всегда пишет колличество пар =0. Помогите исправить ошибки.

Спасибо за внимание. с уважением!

Приложение:
program rast;
uses crt;
type fi1=file of integer;
var f,f1,f2,f3,f4:fi1;
i,m,n,l,k,e,w,y,q:integer;
x,b,c,u:array [1..4] of integer;
procedure vvod(var op:fi1);
begin
rewrite(op);
write('n=');
readln(n);
i:=0;
for i:=1 to n do
begin
read(x[i]);
write(op,x[i]);
end;
close(op);
end;
procedure chet(var op:fi1; var op3,new,new3:fi1);
begin
reset(op);
n:=filesize(op);
k:=0;l:=0;
write('Vvedi chislo M:');
readln(m);
for i:=1 to n do
begin
read(op,x[i]);
for l:=i to n do
if x[i]=-x[l] then
k:=k+1;
end;
close(op);
reset(op);
rewrite(new);
e:=0;
y:=0;
while not(eof(op)) do
begin
read(op,x[i]);
if (x[i] mod m)=0 then
begin
y:=y+1;
e:=e+1;
c[e]:=x[i];
write(new,c[e]);
end;
end;
close(op);
close(new);
reset(op);
rewrite(new3);
w:=0;
q:=0;
while not(eof(op)) do
begin
read(op,x[i]);
if x[i] mod sqr(m) <>0 then
begin
w:=w+1;
q:=q+1;
u[q=]:=x[i];
write(new3,u[q=]);
end;
end;
close(new3);
rewrite(op3);
write(op3,k);
close(op3);
close(op);
end;
procedure prosmotr(var op:fi1);
begin
reset(op);
write('new file: ');
while not(eof(op)) do
begin
read(op,x[i]);
write(' ',x[i]);
end;
writeln;
close(op);
end;
procedure rezul(var op3,new,new3:fi1);
begin
write('Kolichestvo x[i]=-x[i] par: ');
reset(op3);
read(op3,k);
write(k,' ');
writeln;
writeln;
reset(new);
y:=filesize(new);
write('Elementi / na M: ');
for e:=1 to y do
begin
read(new,c[e]);
write(c[e],' ');
end;
writeln;
writeln;
write('elementi ne / na sqr(M): ');
reset(new3);
w:=filesize(new3);
for q:=1 to w do
begin
read(new3,u[q=]);
write(u[q=],' ');
end;
end;
begin
clrscr;
randomize;
assign(f,'fil');
assign(f1,'fil1');
assign(f2,'fil2');
assign(f3,'fil3');
assign(f4,'fil4');
l:=-1;
writeln('1 - new file');
writeln('2 - obrabotka');
writeln('3 - prosmotr file');
writeln('4 - prosmotr rezyltata');
writeln('0 - exit');
while(l<>0) do
begin
read(l);
if (l>5) then writeln('error!!!');
case l of
1:vvod(f);
2:chet(f,f2,f3,f4);
3:prosmotr(f);
4:rezul(f2,f3,f4);
0:exit;
end;
end;
readkey;
end.

Обсуждение

давно

lamed

Академик
320937
2216

30.04.2010, 19:07

общий

Екатерина Малинина:
Возможно ли просто переписать заново? Такой винегрет! В частности, например, "вывести те элементы,которые делятся на него и не делится на это число в квадрате". if (x[i] mod m=0) and (x[i] mod sqr(m) <>0) одно условие, у Вас почему-то разнесены. Зачем 4 файла?

Неизвестный

30.04.2010, 19:16

общий

lamed:
просто уже запуталась я..))
наверно от другой задачки осталась,просто изменила условие))

наверно можно..но я точно запутаюсь тогда)
для меня главный вопрос....почему при повторной обработке этого же файла,выдает колличество 0..)

давно

lamed

Академик
320937
2216

30.04.2010, 20:14

общий

Екатерина Малинина:
1. Приведите контрольный пример (пример ввода).
2. Что понимать под "повторной обработкой этого файла"?
Все же остаюсь при мнении, что программу следует переписать, причем, это можно сделать, не привлекая тех понятий, которые Вам не знакомы: просто расставить те же слова в другом порядке ;)

Неизвестный

30.04.2010, 20:28

общий

lamed:
Ход выполнения.
1) запускаю программу.
2) появляется меню с 4-я пунктами,последовательно выполняю их..например создаю файл с последовательностью "3 5 -3 -5",затем просмотриваю его.потом обрабатываю,ввожу число например 3,просматриваю результат. Результат выдает верно. Выхожу(наживаю 0)
3) Снова запускаю,и уже не содаю,а просматриваю(нажимаю 3),затем обрабатываю,вожу то же число. просматриваю результат,и вижу что колличество не как тогда,2,а уже 0.

давно

lamed

Академик
320937
2216

30.04.2010, 20:53

общий

Екатерина Малинина:
Запускаю программу. Выбираю пункт 1. (* Новый файл *) В ответ n=4. Потом 3, 5, -3, -5. Просматриваю файл. Возможно, что-то и показывает, но увидеть не успеваю. Жму 0. Сообщение "три файла не закрыты". Кстати, зачем Вам randomize?

Неизвестный

30.04.2010, 21:20

общий

lamed:
изначально мне нужно через randomize найти противополные пары(колличество).

давно

lamed

Академик
320937
2216

30.04.2010, 22:55

общий

Екатерина Малинина:

3) Снова запускаю,и уже не содаю,а просматриваю(нажимаю 3),затем обрабатываю,вожу то же число. просматриваю результат,и вижу что колличество не как тогда,2,а уже 0.

Дополнения выделены парой (*---- begin ----*) (*---- end ------*)

Код:


(* Нужно ввести последовательность. Среди элементов найти количество противополжных пар,
 например "3 5 -3 -5" количество равно 2. 
 Еще одно условие,нужно ввести число и вывести те элементы,которые делятся на него и не
 делится на это число в квадрате. 
 Я эту задачу решила,но у меня возникает ошибка,когда я заново 
 запускаю файл(где находится уже созданная последовательность),и просматриваю его,
 потом обрабатываю,и вывожу результат,но у меня всегда пишет колличество пар =0. 
 Помогите исправить ошибки.
*) 

program rast;
uses crt;
type fi1=file of integer;
var  f,f1,f2,f3,f4:fi1;
     i,m,n,l,k,e,w,y,q:integer;
     x,b,c,u:array [1..4] of integer;
procedure vvod(var op:fi1);
begin
 rewrite(op);
 write('n=');
 readln(n);
 i:=0;
 for i:=1 to n do
 begin
  read(x[i]);
  write(op,x[i]);
 end;
 close(op);
end;

procedure chet(var op:fi1; var op3,new,new3:fi1);
begin
 reset(op);
 n:=filesize(op);
 k:=0;l:=0;
 write('Vvedi chislo M:');
 readln(m);
 for i:=1 to n do
  begin
   read(op,x[i]);
   for l:=i to n do
   if x[i]=-x[l] then
    k:=k+1;
  end;
 close(op);
 reset(op);
 rewrite(new);
 e:=0;
 y:=0;
 while not(eof(op)) do
 begin
  read(op,x[i]);
  if (x[i] mod m)=0 then
   begin
   y:=y+1;
   e:=e+1;
   c[e]:=x[i];
    write(new,c[e]);
   end;
  end;
 close(op);
 close(new);
 reset(op);
 rewrite(new3);
 w:=0;
 q:=0;
 while not(eof(op)) do
 begin
  read(op,x[i]);
  if x[i] mod sqr(m) <>0 then
   begin
    w:=w+1;
    q:=q+1;
    u[q=]:=x[i];
    write(new3,u[q=]);
   end;
  end;
 close(new3);
 rewrite(op3);
 write(op3,k);
 close(op3);
 close(op);
end;

procedure prosmotr(var op:fi1);
(*---- begin ----*)
var
  i: integer;
(*---- end ------*)

begin
 reset(op);
 write('new file: ');
 
(*---- begin ----*)
  i:= 0;
(*---- end ------*)
 while not(eof(op)) do
 begin
(*---- begin ----*)
    i := i+1;
(*---- end ------*)
    read(op,x[i]);
    write(' ',x[i]);
  end;
  writeln;
(*---- begin ----*)
  readln;
(*---- end ------*)
 close(op);
end;
procedure rezul(var op3,new,new3:fi1);
begin
 write('Kolichestvo x[i]=-x[i] par: ');
 reset(op3);
 read(op3,k);
 write(k,' ');
 writeln;
 writeln;
 reset(new);
 y:=filesize(new);
 write('Elementi / na M: ');
 for e:=1 to y do
 begin
  read(new,c[e]);
  write(c[e],' ');
 end;
 writeln;
 writeln;
 write('elementi ne / na sqr(M): ');
(*---- begin ----*)
  readln;
(*---- end ------*)
 reset(new3);
 w:=filesize(new3);
 for q:=1 to w do
 begin
  read(new3,u[q=]);
  write(u[q=],' ');
 end;
(*---- begin ----*)
  close(new3);
  close(op3);
  close(new);
(*---- end ------*)
end;
begin
 clrscr;
 randomize;
 assign(f,'fil');
 assign(f1,'fil1');
 assign(f2,'fil2');
 assign(f3,'fil3');
 assign(f4,'fil4');
 l:=-1;
 while(l<>0) do
  begin
   clrscr;
   writeln('1 - new file');
   writeln('2 - obrabotka');
   writeln('3 - prosmotr file');
   writeln('4 - prosmotr rezyltata');
   writeln('0 - exit');
   readln(l); (* ----------- *)
   if (l>5) then writeln('error!!!');
    case l of
     1:vvod(f);
     2:chet(f,f2,f3,f4);
     3:prosmotr(f);
     4:rezul(f2,f3,f4);
     0:exit;
    end;
  end;
 readkey;
end.

Неизвестный

30.04.2010, 23:19

общий

lamed:
спасибо большое!))
а что это означает,эти бегин энд?))

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

давно

lamed

Академик
320937
2216

01.05.2010, 13:42

общий

Екатерина Малинина:
Доброе утро! С праздником!

Код:

(* Нужно ввести последовательность. Среди элементов найти количество противополжных пар,
 например "3 5 -3 -5" количество равно 2. 
 Еще одно условие,нужно ввести число и вывести те элементы,которые делятся на него и не
 делится на это число в квадрате. 
 Я эту задачу решила,но у меня возникает ошибка,когда я заново 
 запускаю файл(где находится уже созданная последовательность),и просматриваю его,
 потом обрабатываю,и вывожу результат,но у меня всегда пишет колличество пар =0. 
 Помогите исправить ошибки.
*) 

program rast;
uses crt;
type fi1=file of integer;
var  f,f1,f2,f3,f4:fi1;
     i,m,n,l,k,e,w,y,q:integer;
     x,b,c,u:array [1..4] of integer;

procedure vvod(var op:fi1);
begin
 rewrite(op);
 write('n=');
 readln(n);
 i:=0;
 for i:=1 to n do
 begin
  read(x[i]);
  write(op,x[i]);
 end;
 close(op);
end;

procedure chet(var op:fi1; var op3,new,new3:fi1);
begin
 reset(op);
 n:=filesize(op);
 k:=0;l:=0;
 write('Vvedi chislo M:');
 readln(m);
 for i:=1 to n do
  begin
   read(op,x[i]);
   for l:=i to n do
   if x[i]=-x[l] then
    k:=k+1;
  end;
 close(op);
 reset(op);
 rewrite(new);
 e:=0;
 y:=0;
 while not(eof(op)) do
 begin
  read(op,x[i]);
  if (x[i] mod m)=0 then
   begin
   y:=y+1;
   e:=e+1;
   c[e]:=x[i];
    write(new,c[e]);
   end;
  end;
 close(op);
 close(new);
 reset(op);
 rewrite(new3);
 w:=0;
 q:=0;
 while not(eof(op)) do
 begin
  read(op,x[i]);
  if x[i] mod sqr(m) <>0 then
   begin
    w:=w+1;
    q:=q+1;
    u[q=]:=x[i];
    write(new3,u[q=]);
   end;
  end;
 close(new3);
 rewrite(op3);
 write(op3,k);
 close(op3);
 close(op);
end;

procedure prosmotr(var op:fi1);
var
  i: integer;

begin
 reset(op);
 write('new file: ');
 
  i:= 0;
 while not(eof(op)) do
 begin
    i := i+1;
    read(op,x[i]);
    write(' ',x[i]);
  end;
  writeln;
  readln;
 close(op);
end;
procedure rezul(var op3,new,new3:fi1);
begin
 write('Kolichestvo x[i]=-x[i] par: ');
 reset(op3);
 read(op3,k);
 write(k,' ');
 writeln;
 writeln;
 reset(new);
 y:=filesize(new);
 write('Elementi / na M: ');
 for e:=1 to y do
 begin
  read(new,c[e]);
  write(c[e],' ');
 end;
 writeln;
 writeln;
 writeln('elementi ne / na sqr(M): ');

 reset(new3);
 w:=filesize(new3);
 for q:=1 to w do
 begin
  read(new3,u[q=]);
  write(u[q=],' ');
 end;
 writeln;
 readln;
 close(new3);
 close(op3);
 close(new);
end;

begin
 clrscr;
 randomize;
 assign(f,'fil');
 assign(f1,'fil1');
 assign(f2,'fil2');
 assign(f3,'fil3');
 assign(f4,'fil4');
 l:=-1;
 while(l<>0) do
  begin
   clrscr;
   writeln('1 - new file');
   writeln('2 - obrabotka');
   writeln('3 - prosmotr file');
   writeln('4 - prosmotr rezyltata');
   writeln('0 - exit');
   readln(l);
   if (l>5) then writeln('error!!!');
    case l of
     1:vvod(f);
     2:chet(f,f2,f3,f4);
     3:prosmotr(f);
     4:rezul(f2,f3,f4);
     0:exit;
    end;
  end;
 readkey;
end.

Неизвестный

01.05.2010, 18:53

общий

lamed:
Спасибо большое за вашу помощь,и за ваш труд! С праздником!

что вы такое сделали, чтобы оставалось толлько меню?

Неизвестный

01.05.2010, 19:49

общий

lamed:

Если праздник, то с праздником!
Оформите свою программу в качестве ответа, плиииз!

давно

lamed

Академик
320937
2216

03.05.2010, 10:24

общий

это ответ

Здравствуйте, Екатерина Малинина. Ответ в приложении. ABC Pascal. Старался не использовать понятия, которые Вы не использовали, за исключением not eof(rez) и seek(rez,0);
1. Добавил обработку условия: "делятся на m, но не делятся на m^2", соответственно, добавил один файл для результата.
2. Убрал, где смог, глобальные переменные.
3. Убрал массивы, где явно можно обойтись без них.
4. Разделил процедуру "счет".
Пожалуйста, вопросы, замечания.

Приложение:
(* Вопрос 178128.
Нужно ввести последовательность. Среди элементов найти количество противополжных пар,
например "3 5 -3 -5" количество равно 2.
Еще одно условие,нужно ввести число и вывести те элементы,которые делятся на него и не
делится на это число в квадрате.
Я эту задачу решила,но у меня возникает ошибка,когда я заново
запускаю файл(где находится уже созданная последовательность),и просматриваю его,
потом обрабатываю,и вывожу результат,но у меня всегда пишет колличество пар =0.
Помогите исправить ошибки.
*)

program rast;
uses
crt;
const
MaxSize = 4; { Максимальное число элементов в массивах }
type
TIntfile = file of integer;
TVector = array[1..MaxSize] of integer;
var
choice: integer;
data, protiv, rez1, rez2, rez3: TIntFile;

procedure vvod(var data: TIntFile);
{ Данные с клавиатуры считываются в переменную и сохраняются в файл }
var
i, n: integer;
x: integer;
begin
write('Число элементов n=');
readln(n);

{ Проверка на правильность ввода n }
if (n<1) then
n:= 0
else if (n>MaxSize) then
n:= MaxSize;

rewrite(data);
for i:=1 to n do
begin
read(x);
write(data, x);
end;
close(data);
end; { vvod }

procedure schet1(var data, rez: TIntFile);
{ считаем количество пар противоположных чисел }
var
i,j,n: integer;
pairs: integer;
v: TVector;
begin
reset(data);
seek(data,0); { на начало файла }
n:= 0;
while not eof(data) do
begin
n:= n+1;
read(data, v[n]);
end;
close(data);

pairs:=0;
for i:= 1 to n-1 do
for j:= i+1 to n do
if v[i]=-v[j] then
pairs := pairs+1;
rewrite(rez);
write(rez, pairs);
close(rez);
end; { schet1 }

procedure schet2(var data, rez1, rez2, rez3: TIntFile);
{ сохраняем в файлы rez2, rez3, rez4 соответственно числа, которые:
а) делятся на M;
б) не делятся на M^2;
в) делятся на M, но не делятся на M^2 }
var
m: integer;
x: integer;

begin
write('Введите число M:');
readln(m);

reset(data);
seek(data,0);
rewrite(rez1);
rewrite(rez2);
rewrite(rez3);

while not eof(data) do
begin
read(data, x);
if (x mod m =0 ) then
write(rez1, x);
if (x mod sqr(m) <> 0) then
write(rez2, x);
if (x mod m=0) and (x mod sqr(m) <> 0) then
write(rez3, x);
end;
close(data);
close(rez1);
close(rez2);
close(rez3);
end; { schet2 }

procedure prosmotr(var data: TIntFile);
{ просмотр файла данных }
var
i: integer;
x: integer;
begin
write('Файл данных: ');
reset(data);
seek(data, 0);
while not(eof(data)) do
begin
read(data, x);
write(' ', x);
end;
writeln;
readln;
close(data);
end; { prosmotr }

procedure rezul(var protiv, rez1, rez2, rez3 :TIntFile);
{ просмотр файлов результата }
var
pairs: integer;
x: integer;
begin
write('Количество противоположных пар: ');
reset(protiv);
seek(protiv, 0);
read(protiv, pairs);
write(pairs,' ');
close(protiv);
writeln;
writeln;

write('Элементы делятся на M: ');
reset(rez1);
seek(rez1, 0);
while not eof (rez1) do
begin
read(rez1, x);
write(x, ' ');
end;
close(rez1);
writeln;
writeln;

write('Элементы не делятся на sqr(M): ');
reset(rez2);
seek(rez2, 0);
while not eof(rez2) do
begin
read(rez2, x);
write(x, ' ');
end;
close(rez2);
writeln;
writeln;

write('Элементы делятся на M, но не делятся на sqr(M): ');
reset(rez3);
seek(rez3, 0);
while not eof(rez3) do
begin
read(rez3, x);
write(x, ' ');
end;
close(rez3);
writeln;
writeln;
readln;

end; { rezul }

begin { rast }
clrscr;
assign(data, 'data');
assign(protiv, 'protiv');
assign(rez1, 'rez1');
assign(rez2, 'rez2');
assign(rez3, 'rez3');

choice:=-1;
while(choice<>0) do
begin
clrscr;
writeln('1 - Новый файл');
writeln('2 - Обработка');
writeln('3 - Просмотр файла');
writeln('4 - Просмотр результата');
writeln('0 - Выход');
readln(choice);

case choice of
1: vvod(data);
2: begin
schet1(data, protiv);
schet2(data, rez1, rez2, rez3);
end;
3: prosmotr(data);
4: rezul(protiv, rez1, rez2, rez3);
0: exit
else writeln('Ошибка выбора!');
end;
end;
writeln('Удачи!');
readln;
end.

Форма ответа

Отправка постов/ответов доступна только зарегистрированным и подтвержденным пользователям.

Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.