Задачка на множества, Паскаль - Страница 5

pashasnuff · 07.05.2014, 20:48

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

Код:

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 · 08.05.2014, 09:43

Цитата:

Сообщение от pashasnuff

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

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

pashasnuff · 08.05.2014, 11:18

Так, я правильно понял что условия меняются на противоположные только в 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 · 08.05.2014, 13:01

Цитата:

Сообщение от pashasnuff

но увы.

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

pashasnuff · 08.05.2014, 13:55

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

pashasnuff · 08.05.2014, 14:09

Вроде сделал как вы сказали 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 · 08.05.2014, 14:10

Цитата:

Сообщение от pashasnuff

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

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

Код:

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

pashasnuff · 08.05.2014, 14:11

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

Vladimir_S · 08.05.2014, 14:35

Цитата:

Сообщение от 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 · 08.05.2014, 15:47

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

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

08.05.2014, 15:47	#50 (permalink)
pashasnuff Member Регистрация: 16.04.2014 Сообщений: 51 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Дело в том что старый я лучше понял. Спасибо огромное. Я посмотрел в коде но не нашел объяснения тому почему выводится символ "а" вначале строки с результатом Прилагаю скрины, чтобы было понятнее что не так с этой буквой "а" Миниатюры Последний раз редактировалось pashasnuff; 08.05.2014 в 15:56

08.05.2014, 13:55	#45 (permalink)
pashasnuff Member Регистрация: 16.04.2014 Сообщений: 51 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Мне нужно перед всеми do..while поставить begin end кроме внешнего? или только во внешний? Вообщем делаю сейчас так и так проверю.

Ads
Яндекс Member Регистрация: 31.10.2006 Сообщений: 40200 Записей в дневнике: 0 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 55070

08.05.2014, 14:11	#48 (permalink)
pashasnuff Member Регистрация: 16.04.2014 Сообщений: 51 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Посмотрите код, я сделал) хотя может что и пропустил сейчас проверю