Задачка на множества, Паскаль

pashasnuff · 7 Май 2014

Это пока что сырая версия, которая запускается но не работает, пока ищу ошибку.

Код:

Const
 Sonants:Set of Char=['б','в','г','д','ж','з','л','м','н','р'];


Var
 S:String;    
 C:Char; 
 i,j,k,N:integer; 
 Found:Set of char; 
 Codes:Array[1..10] of Byte;
 p:boolean;

Begin
p:=true;
while p=true do
begin 
 Writeln('Введите строку:');
 Readln(S);
if length(s) = 0 then
 writeln('Пустая строка, введите еще раз!')
else 
begin
p:=false;
end;
end;
 Writeln;
 Found:=[];
 N:=1;
 i:=1;
 while (i<>length(s)-1) do  
  If (S[i] in Sonants) and not (S[i] in Found) then
   begin
    C:=S[i];
    k:=i;
     while (S[k]<>',') or (k<>Length(S)) do
      begin
      k:=k+1;
     end;
    if S[k]=',' then
     begin
      while (S[k]<>C) or (k<>Length(S)) do
       k:=k+1;
     end;
      if S[k]=C then
       begin
        Found:=Found+[C];
        N:=N+1;
        Codes[N]:=Ord(C);
   end;
 i:=i+1;
 end;


 for i:=1 to N-1 do
  for j:=1 to N-i do
   if Codes[j]>Codes[j+1] then
    begin
     k:=Codes[j];
     Codes[j]:=Codes[j+1]; 
     Codes[j+1]:=k;
    end; 
 writeln('Результат:');
 for i:=1 to N do write(Chr(Codes[i]),' ');
 if N=0 then writeln('таких согласных нет');
 Readln;
End.

Vladimir_S · 8 Май 2014

pashasnuff написал(а):
Это пока что сырая версия, которая запускается но не работает

И не будет работать, ибо если Вы переходите от постусловия к предусловию, то:
1. Сами условия меняются на обратные.
2. Логические связки тоже меняются на обратные, т.е. and на or и наоборот.
3. Если надо, корректируем счетчики цикла (у Вас вроде сделано).

pashasnuff · 8 Май 2014

Так, я правильно понял что условия меняются на противоположные только в while? а в if остаются прежними, знаки поменял на противоположные но увы.

Код:

Const
 Sonants:Set of Char=['б','в','г','д','ж','з','л','м','н','р'];


Var
 S:String;    
 C:Char; 
 i,j,k,N:integer; 
 Found:Set of char; 
 Codes:Array[1..10] of Byte;
 p:boolean;

Begin
p:=true;
while p=true do
begin 
 Writeln('Введите строку:');
 Readln(S);
if length(s) = 0 then
 writeln('Пустая строка, введите еще раз!')
else 
begin
p:=false;
end;
end;
 Writeln;
 Found:=[];
 N:=1;
 i:=1;
 while (i<>length(s)-1) do  
  If (S[i] in Sonants) and not (S[i] in Found) then
   begin
    C:=S[i];
    k:=i;
     while (S[k]<>',') and (k<>Length(S)) do
      begin
      k:=k+1;
     end;
    if S[k]=',' then
     begin
      while (S[k]<>C) and (k<>(Length(S))) do
       k:=k+1;
     end;
      if S[k]=C then
       begin
        Found:=Found+[C];
        N:=N+1;
        Codes[N]:=Ord(C);
   end;
 i:=i+1;
 end;


 for i:=1 to N-1 do
  for j:=1 to N-i do
   if Codes[j]>Codes[j+1] then
    begin
     k:=Codes[j];
     Codes[j]:=Codes[j+1]; 
     Codes[j+1]:=k;
    end; 
 writeln('Результат:');
 for i:=1 to N do write(Chr(Codes[i]),' ');
 if N=0 then writeln('таких согласных нет');
 Readln;
End.

Vladimir_S · 8 Май 2014

pashasnuff написал(а):
но увы.

Потому что Вы забыли, что тело цикла While..Do (в отличие от Repeat..Until) должно быть ОБЯЗАТЕЛЬНО взято в операторные скобки begin..end. И как раз во внешнем цикле-то их и нет!

pashasnuff · 8 Май 2014

Мне нужно перед всеми do..while поставить begin end кроме внешнего? или только во внешний? Вообщем делаю сейчас так и так проверю.

pashasnuff · 8 Май 2014

Вроде сделал как вы сказали do while
begin
end
вот такая конструкция получилась
но не выдает желаемого результата(

Код:

Const
 Sonants:Set of Char=['б','в','г','д','ж','з','л','м','н','р'];


Var
 S:String;    
 C:Char; 
 i,j,k,N:integer; 
 Found:Set of char; 
 Codes:Array[1..10] of Byte;
 p:boolean;

begin
p:=true;
 while p=true do
  begin 
  Writeln('Введите строку:');
  Readln(S);
  if length(s) = 0 then
  writeln('Пустая строка, введите еще раз!')
  else 
   begin
   p:=false;
   end;
  end;
  Writeln;
  Found:=[];
  N:=1;
  i:=1;
  
   while (i<>length(s)-1) do 
   begin
   If (S[i] in Sonants) and not (S[i] in Found) then
    begin
    C:=S[i];
    k:=i;
    while (S[k]<>',') and (k<>Length(S)) do
     begin
     k:=k+1;
     end;
      if S[k]=',' then
       begin
       while (S[k]<>C) and (k<>(Length(S))) do
       begin
       k:=k+1;
       end;
       end;
        if S[k]=C then
        begin
        Found:=Found+[C];
        N:=N+1;
        Codes[N]:=Ord(C);
        end;
         i:=i+1;
    end;
   end;
 


 for i:=1 to N-1 do
  for j:=1 to N-i do
   if Codes[j]>Codes[j+1] then
    begin
     k:=Codes[j];
     Codes[j]:=Codes[j+1]; 
     Codes[j+1]:=k;
    end; 
 writeln('Результат:');
 for i:=1 to N do write(Chr(Codes[i]),' ');
 if N=0 then writeln('таких согласных нет');
 Readln;

Vladimir_S · 8 Май 2014

pashasnuff написал(а):
Мне нужно перед всеми do..while поставить begin end

Да не "перед", а внутри! Не говоря уж о том, что do..while это вообще не Паскаль.
В Паскале так:

Код:

While <условие> do
 begin
  ...;
  ...;
  ...;
 end;

pashasnuff · 8 Май 2014

Посмотрите код, я сделал) хотя может что и пропустил сейчас проверю

Vladimir_S · 8 Май 2014

pashasnuff написал(а):
Посмотрите код, я сделал) хотя может что и пропустил сейчас проверю

Посмотрел, кое-что кое-где подправил, вот:

Код:

Const
 Sonants:Set of Char=['б','в','г','д','ж','з','л','м','н','р'];


Var
 S:String;
 C:Char;
 i,j,k,N:integer;
 Found:Set of char;
 Codes:Array[1..10] of Byte;
 p:boolean;

begin
 p:=true;
 while p=true do
 begin
  Writeln('Введите строку:');
  Readln(S);
  if length(s) = 0 then
   writeln('Пустая строка, введите еще раз!')
  else p:=false;
 end;
 Writeln;
 Found:=[];
 N:=1;
 i:=1;
 while (i<>length(s)-1) do
  begin
   If (S[i] in Sonants) and not (S[i] in Found) then
    begin
     C:=S[i];
     k:=i;
     while (S[k]<>',') and (k<>Length(S)) do k:=k+1;
     if S[k]=',' then
      while (S[k]<>C) and (k<>(Length(S))) do k:=k+1;
     if S[k]=C then
      begin
       Found:=Found+[C];
       N:=N+1;
       Codes[N]:=Ord(C);
      end;
    end;
   i:=i+1;
  end;



 for i:=1 to N-1 do
  for j:=1 to N-i do
   if Codes[j]>Codes[j+1] then
    begin
     k:=Codes[j];
     Codes[j]:=Codes[j+1];
     Codes[j+1]:=k;
    end;
 writeln('Результат:');
 for i:=1 to N do write(Chr(Codes[i]),' ');
 if N=0 then writeln('таких согласных нет');
 Readln;
end.

Только вот не понимаю, зачем Вы взяли за основу старый вариант с массивом? Новый же лучше. Впрочем, Ваше дело.

pashasnuff · 8 Май 2014

Дело в том что старый я лучше понял. Спасибо огромное.
Я посмотрел в коде но не нашел объяснения тому почему выводится символ "а" вначале строки с результатом

Прилагаю скрины, чтобы было понятнее что не так с этой буквой "а"

Vladimir_S · 8 Май 2014

pashasnuff написал(а):
Дело в том что старый я лучше понял.

Да в новом еще проще - безо всяких упорядочений пузырьком! Просто перебираем подряд ВСЕ БУКВЫ от "б" до "р" (включая и глухие, и гласные), и если таковая содержится в множестве Found, то выводим ее на экран.

pashasnuff · 8 Май 2014

Проблемки. Буква "а"

Vladimir_S · 8 Май 2014

pashasnuff написал(а):
Проблемки. Буква "а"

Не могу знать. Букве "а" там уж вовсе взяться неоткуда:

pashasnuff · 8 Май 2014

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

pashasnuff · 8 Май 2014

И вправду буквы а нету, но вот со второй ошибкой не справился пока что

Vladimir_S · 8 Май 2014

pashasnuff написал(а):
А вторая ошибка вылазит когда я ввожу только пробел в строку, в важем же варианте если я вводил только пробел он говорил что таких букв нет, а в моем выдает ошибку. Как исправить не знаете?

Так, ну вот что, сударь. Вам предлагается окончательный вариант, в котором отслеживаются все мыслимые ошибки ввода, как то слишком короткая строка, наличие каких-либо символов, кроме строчных русских букв, запятых и пробелов, отсутствие запятых, ситуации, когда перед пробелом нет запятой и когда после запятой нет пробела.

Код:

Const
  Sonants:Set of Char=['б','в','г','д','ж','з','л','м','н','р'];
  Letters:Set of Char=['а'..'я']+[',']+[' '];

Var
 S:String;
 C:Char;
 i,k,N,L:integer;
 Found:Set of char;
 p,b1,b2,b3,b4,b5:boolean;

begin
 p:=false;
 while p=false do
  begin
   Writeln('Введите строку:');
   Readln(S);
   L:=Length(S);
   b1:=false;
   if L<2 then b1:=true;
   if not b1 then
    begin
     b2:=false;
     for i:=1 to L do
      if not (S[i] in Letters) then b2:=true;
    end;
   if not b1 and not b2 then
    begin
     b3:=true;
     for i:=1 to L-1 do
      if (S[i]=',') and (S[i+1]=' ') then b3:=false;
    end;
   if not b1 and not b2 and not b3 then
    begin
     b4:=false;
     for i:=1 to L-1 do
      if (S[i]=',') and not (S[i+1]=' ') then b4:=true;
    end;
   if not b1 and not b2 and not b3 and not b4 then
    begin
     b5:=false;
     for i:=2 to L do
      if (S[i]=' ') and not (S[i-1]=',') then b5:=true;
    end;
   if b1 or b2 or b3 or b4 or b5 then
     Writeln('Некорректный ввод!')
   else p:=true;
  end;
 Writeln;
 Found:=[];
 N:=1;
 i:=1;
 while (i<L-1) do
  begin
   If (S[i] in Sonants) and not (S[i] in Found) then
    begin
     C:=S[i];
     k:=i;
     while (S[k]<>',') and (k<L) do k:=k+1;
     if S[k]=',' then
      while (S[k]<>C) and (k<L) do k:=k+1;
     if S[k]=C then
      begin
       Found:=Found+[C];
       N:=N+1;
      end;
    end;
   i:=i+1;
  end;

 If N=0 then
  Writeln('Таких букв нет!')
 else
  begin
   Writeln('Результат:');
   for C:='б' to 'р' do
    if C in Found then write(C+' ');
  end;
 Readln
End.

Теперь так. Если хотите в очередной раз переделывать - в добрый путь! Но и отлаживайте сами. А то бесконечные "я вот переделал, а оно почему-то не работает" уже, знаете, утомили. Но вопросы по программе, естественно, принимаются.

pashasnuff · 8 Май 2014

Так, вначале мы проверяем на корректный ввод строки а именно:
p - признак того что наша строка введена правильно
b1 - признак того что длина строки больше 2 символов( но зачем это непонятно)
b2 - признак того что рассматриваемый символ строки это не буква русского алфавита
b3 - признак того что мы нашли конец слова(после слова есть пробелы)
b4 - признак того что мы нашли конец слова(после слова нет пробелов)
b5 - признак того что мы нашли слово, а не запятые и пробелы( , , или ,,)

Так?

pashasnuff · 8 Май 2014

А почему при любом вводе он пишет не правильный ввод?)

Vladimir_S · 8 Май 2014

pashasnuff написал(а):
Так, вначале мы проверяем на корректный ввод строки а именно:
p - признак того что наша строка введена правильно
b1 - признак того что длина строки больше 2 символов( но зачем это непонятно)
b2 - признак того что рассматриваемый символ строки это не буква русского алфавита
b3 - признак того что мы нашли конец слова(после слова есть пробелы)
b4 - признак того что мы нашли конец слова(после слова нет пробелов)
b5 - признак того что мы нашли слово, а не запятые и пробелы( , , или ,,)

Так?

Не совсем.
b1 - признак того, что длина строки больше 1 символа. Хорошенькое "непонятно"! Вы же сами всё время норовите вместо строки ввести пробел и добиться того, чтобы программа такое отрабатывала! Ну а я расширил несколько: согласитесь, что строка в 1 символ не может быть объектом программы.
b2 - правильно. Только кроме букв еще допустимыми символами являются запятые и пробелы.
b3 - признак того, что есть хотя бы одна комбинация запятая+пробел.
b4 - признак того, что нет запятых, после которых отсутствует пробел (исключение комбинаций типа "железный,лизун").
b5 - признак того, что нет пробелов, перед которыми отсутствует запятая (исключение комбинаций типа "железный лизун").

pashasnuff · 8 Май 2014

Сейчас попробую найти почему всегда Некорректный ввод выдает

Задачка на множества, Паскаль

Новые

Ученик

Новые

Ученик

Новые

Новые

Ученик

Новые

Ученик

Новые

Вложения

Ученик

Новые

Вложения

Ученик

Вложения

Новые

Новые

Ученик

Новые

Новые

Ученик

Новые

Похожие темы