Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.12.2008, 17:35   #1
LyaLyaLya
Пользователь
 
Аватар для LyaLyaLya
 
Регистрация: 02.12.2008
Сообщений: 27
Восклицание файл с массивом строк, помогите найти ошибку

хм, вот задачка, найдите, плиз ошибку, я ее мучаю уже несколько недель

Требование:
В программе описать массив строк. Исходный текст считать из файла, созданного в любом текстовом редакторе. Результат обработки вывести на экран, а так же в итоговый текстовый файл.

Задание:
Определить количество слов, поменять местами четные и нечетные слова.

Код:
program pr6;
uses crt;

const p=3;
var o1,o2:text;
f:array[1..p] of string;
s,s1:string;
i,j,k,n,m1,m2,l1,l2:integer;
procedure invert(k,l:byte);
var i:byte;
    ch:char;
     b:boolean;
begin
   for i:=k to ((l+k) div 2) do
   begin
      ch:=s[i];
      s[i]:=s[l+k-i];
      s[l+k-i]:=ch;
   end;
end;

begin
clrscr;

assign(ff,'d:\o1.txt');

reset(ff);
j:=0;
  while not eoln(ff) do 
  begin j:=j+1;
    readln(ff,f[j]);writeln(f[j]);
  end;
close(ff);

reset(ff);
j:=0;
   while not eoln(ff) do 
   begin  j:=j+1;
     readln(ff,f[j]);
     i:=0;n:=0;
     m1:=1;m2:=1;l1:=1;l2:=1;
     while i<length(f[j]) do 
     begin
     i:=i+1;
     s:=copy(f[j],i,1);
     if (s[i]=' ')or(i=length(s)) then
repeat
                                                    if s[i+1]=' ' then
                                                       begin
                                                           delete(s,i,1);
                                                            k:=k-1;
                                                             b:=false;
                                                       end
                                                           else b:=true;
                                                  until b;
                                             end;


  begin
    n:=n+1;
    if n=1 then
    begin
      m2:=i-1;
      l1:=i+1
    end
    else
    begin
      n:=0;
      if i=length(s) then l2:=i else l2:=i-1;
      invert(m1,m2);invert(l1,l2);invert(m1,l2);
      m1:=i+1
    end
  end
end;

writeln(f[j]);
close(ff);

assign(oo,'d:\o2.txt');
rewrite(oo);
for j:=1 to 3 do
writeln(oo,f[j]);close(oo);
end.
LyaLyaLya вне форума Ответить с цитированием
Старый 25.12.2008, 18:57   #2
alex_fcsm
Участник клуба
 
Аватар для alex_fcsm
 
Регистрация: 10.11.2008
Сообщений: 1,502
По умолчанию

Это теперь компилится, но что Вы хотели я не очень понял

Код:
program pr6;
uses crt;

const p=3;
var o1,o2:text;
f:array[0..p] of string;
s,s1:string;
i,j,k,n,m1,m2,l1,l2:integer;
ff,oo:text;
b:boolean;

procedure invert(k,l:byte);
var i:byte;
    ch:char;
begin
   for i:=k to ((l+k) div 2) do
   begin
      ch:=s[i];
      s[i]:=s[l+k-i];
      s[l+k-i]:=ch;
   end;
end;

begin
clrscr;
assign(ff,'c:\o1.txt');
reset(ff);
j:=0;
  while not eoln(ff) do
  begin j:=j+1;
    readln(ff,f[j]);writeln(f[j]);
  end;
close(ff);
reset(ff);
j:=0;
   while not eoln(ff) do
   begin  j:=j+1;
     readln(ff,f[j]);
     i:=0;n:=0;
     m1:=1;m2:=1;l1:=1;l2:=1;
     while i<length(f[j]) do
     begin
     i:=i+1;
     s:=copy(f[j],i,1);
     if (s[i]=' ')or(i=length(s)) then
repeat
                                                    if s[i+1]=' ' then
                                                       begin
                                                           delete(s,i,1);
                                                            k:=k-1;
                                                             b:=false;
                                                       end
                                                           else b:=true;
                                                  until b;
                                             end;


  begin
    n:=n+1;
    if n=1 then
    begin
      m2:=i-1;
      l1:=i+1
    end
    else
    begin
      n:=0;
      if i=length(s) then l2:=i else l2:=i-1;
      invert(m1,m2);invert(l1,l2);invert(m1,l2);
      m1:=i+1
    end
  end
end;
writeln(f[j]);
close(ff);
assign(oo,'c:\o2.txt');
rewrite(oo);
for j:=1 to 3 do
writeln(oo,f[j]);close(oo);
end.
Нормальное состояние техники - нерабочее, все остальное частный случай.
alex_fcsm вне форума Ответить с цитированием
Старый 25.12.2008, 19:07   #3
alex_fcsm
Участник клуба
 
Аватар для alex_fcsm
 
Регистрация: 10.11.2008
Сообщений: 1,502
По умолчанию

Вот что я нацарапал

Код:
program pr6;
uses crt;
var f:text;
    i,n:integer;
    a:array[1..500] of string;
    s,sub:string;
begin
assign(f,'c:\o.txt');
reset(f);
n:=0;
while not(eof(f)) do
 begin
  readln(f,s);
  i:=0;
  repeat
   inc(i);
   if (s[i]=' ')and(s[i+1]<>' ') then begin
                   inc(n);
                   a[n]:=sub;
                   sub:='';
                   end
   else if (s[i]<>' ')and(s[i]<>'.') then sub:=sub+s[i];
  until length(s)=i;
  if sub<>'' then begin
     inc(n);
     a[n]:=sub;
    end;
 end;
 close(f);
 writeln('Всего ',n,' строк');
 assign(f,'c:\o1.txt');
 rewrite(f);
 for i:=1 to n do
  if i mod 2=0 then begin
                    write(a[i],' ',a[i-1],' ');
                    write(f,a[i],' ',a[i-1],' ');
                    end;
 if n mod 2=1 then begin
                   write(a[n]);
                   write(f,a[n]);
                   end;
 close(f);
end.
Нормальное состояние техники - нерабочее, все остальное частный случай.
alex_fcsm вне форума Ответить с цитированием
Старый 26.12.2008, 02:46   #4
LyaLyaLya
Пользователь
 
Аватар для LyaLyaLya
 
Регистрация: 02.12.2008
Сообщений: 27
По умолчанию

alex_fcsm, спасибочки огромное!!! а где тут кнопочка "спасибо"?!!!

а можешь объяснить, что такое mod 2?
LyaLyaLya вне форума Ответить с цитированием
Старый 26.12.2008, 08:32   #5
alex_fcsm
Участник клуба
 
Аватар для alex_fcsm
 
Регистрация: 10.11.2008
Сообщений: 1,502
По умолчанию

Цитата:
Сообщение от LyaLyaLya Посмотреть сообщение
alex_fcsm, спасибочки огромное!!! а где тут кнопочка "спасибо"?!!!

а можешь объяснить, что такое mod 2?
Кнопочка спасибо - средняя из трех.
mod 2 - остаток от деления на 2. Сначала выводи слово на четном месте, а потом стоящее слева от него - нечетное.
Нормальное состояние техники - нерабочее, все остальное частный случай.
alex_fcsm вне форума Ответить с цитированием
Старый 26.12.2008, 22:04   #6
LyaLyaLya
Пользователь
 
Аватар для LyaLyaLya
 
Регистрация: 02.12.2008
Сообщений: 27
По умолчанию

еще траблы!!! препод требует масси встрок, т.е. обработку не одной строки, а нескольких. Там будет 2-мерный массив по строчкам и символам, т.е. s не только по і:
Код:
...  if (s[i]=' ')and(s[i+1]<>' ') then begin
                   inc(n);
                   a[n]:=sub;
                   sub:='';
                   end
   else if (s[i]<>' ')and(s[i]<>'.') then sub:=sub+s[i];
  until length(s)=i;...
каким образом это можно сделать?
LyaLyaLya вне форума Ответить с цитированием
Старый 26.12.2008, 22:30   #7
Трофимов Александр
Форумчанин
 
Аватар для Трофимов Александр
 
Регистрация: 03.11.2006
Сообщений: 321
По умолчанию

Ну мона ещё проверку на нечётность делать функцией odd(x)
Трофимов Александр вне форума Ответить с цитированием
Старый 26.12.2008, 23:44   #8
LyaLyaLya
Пользователь
 
Аватар для LyaLyaLya
 
Регистрация: 02.12.2008
Сообщений: 27
По умолчанию

а как же сделать массив по строкам и по символам?!!
LyaLyaLya вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите найти ошибку Devoto Общие вопросы Delphi 4 18.11.2008 00:26
помогите найти ошибку Максим_Леонидович БД в Delphi 4 20.08.2008 23:23
Помогите найти ошибку ( с++ ) JOFRIF Помощь студентам 10 23.05.2008 14:34
Помогите найти ошибку Дима82 Помощь студентам 4 19.05.2008 15:05
Помогите найти ошибку NeiL Общие вопросы Delphi 7 04.03.2008 07:14