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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 20.12.2012, 21:39   #1
lialia
Форумчанин
 
Регистрация: 08.12.2012
Сообщений: 116
По умолчанию Pascal не могу найти ошибку

Program sim;
{Дана последовательность, содержащая от 2 до 20 слов, в каждом из которых от
1 до 8 строчных букв, между соседними словами - не менее одного пробела, за
последним словом - точка. Реализовать печать тех слов, которые отличны от
последнего слова и удовлетворяют свойству симметричности. }
uses crt;
Var
s,t,s1,n: string;
a: array[1..100] of string;
i,k,f,j,m: integer;
function simetr(s:string): boolean;
Begin
clrscr;
repeat
writeln('Введите строку со словами, разделенными пробелами и заканчивающуюся точкой: ');
readln(s);
until (s[length(s)]='.') and (pos (' ',s) <> 0);
s:=' '+s; {пробел в начало, чтобы перед всеми словами был пробел}
for i:=1 to length(s) do {перебор символов}
if (s[i]=' ') and (s[i+1] <> ' ') then inc(k) else
if s[i] <> ' ' then a[k]:=a[k]+s[i];
{если последний пробел, то на счетчике слов появляется следующая цифра,}
{если не пообел - к слову добавляется буква из строки}
for i:=1 to k-1 do {перебор слов}
begin
t:=a[i]; {копия}
f:=0; {срос флажка}
for j:=2 to length(t) do {перебор букв}
if t[j]<t[j-1] then f:=1; {буквы не возрастают - флажок вверх}
if f=0 then writeln(a[i]); {слово не равно последнему - флажок вниз}
end;
readln;
End;
Begin
n:='';
for m:=length(s) downto 1 do
n:=n+s[m];
simetr:=n=s; вот тут вроде ошибка ,а что я не так сделала не знаю
End;
Begin
n:=s;
writeln('Симметричные: ');
while pos(' ',n) <> 0 do
begin
s1:=copy(n,1,pos(' ',n)-1);
if simetr(s1) then write(s1,' ');
delete(n,1,pos(' ',n));
end;
End.
lialia вне форума Ответить с цитированием
Старый 21.12.2012, 01:05   #2
TinMan
Форумчанин
 
Аватар для TinMan
 
Регистрация: 05.09.2011
Сообщений: 869
По умолчанию

Ляля, ну неужели ТАК трудно поставить тэги кода?.. певый день в Инете?.. зачем заставлять других это делать за тебя?

Вот твой код (без изменений)
Код:
uses crt;
Var
  s,t,s1,n: string;
  a: array[1..100] of string;
  i,k,f,j,m: integer;
  function simetr(s:string): boolean;
Begin
  clrscr;
  repeat
  writeln('Введите строку со словами, разделенными пробелами и заканчивающуюся точкой: ');
  readln(s);
  until (s[length(s)]='.') and (pos (' ',s) <> 0);
  s:=' '+s; {пробел в начало, чтобы перед всеми словами был пробел}
  for i:=1 to length(s) do {перебор символов}
   if (s[i]=' ') and (s[i+1] <> ' ') then inc(k) else
    if s[i] <> ' ' then a[k]:=a[k]+s[i];
    {если последний пробел, то на счетчике слов появляется следующая цифра,}
    {если не пообел - к слову добавляется буква из строки}
    for i:=1 to k-1 do {перебор слов}
      begin
        t:=a[i]; {копия}
        f:=0; {срос флажка}
        for j:=2 to length(t) do {перебор букв}
         if t[j]<t[j-1] then f:=1; {буквы не возрастают - флажок вверх}
          if f=0 then writeln(a[i]); {слово не равно последнему - флажок вниз}
      end;
  readln;
End;
Begin
  n:='';
  for m:=length(s) downto 1 do
  n:=n+s[m];
  simetr:=n=s;                      вот тут вроде ошибка ,а что я не так                                                    сделала не знаю
End;
Begin
  n:=s;
  writeln('Симметричные: ');
  while pos(' ',n) <> 0 do
    begin
     s1:=copy(n,1,pos(' ',n)-1);
      if simetr(s1) then write(s1,' ');
      delete(n,1,pos(' ',n));
    end;
End.
Предпочитаю на "ты".
TinMan вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не могу найти ошибку. Сума ряда (Pascal) spinogryz_ua Помощь студентам 2 31.01.2012 15:29
не могу найти ошибку (pascal) spinogryz_ua Помощь студентам 0 24.01.2012 20:40
Не могу найти ошибку в БД Bilargo Помощь студентам 0 26.11.2009 14:00
Не могу найти ошибку . KVANTOM Общие вопросы Delphi 2 08.01.2009 17:15
Не могу найти ошибку! Эдуард Общие вопросы C/C++ 7 27.02.2008 16:34