freepascal.ru

Опять застрял на похожем задании, не знаю как его решить.

Код: Выделить всё

procedure check (const s: string);
var i, k: integer;
    ch: char;
    t: string;
begin
t:='';
k:=length(s);
for i:=1 to k do if ord(s[i])>32 then begin t:=inttostr(i); writeln (t, ' - ', s[i]);
end;
end;

var s: string;
begin
write ('Write a word - '); readln (s);
check (s);
end.

Программа работает, она выводит местоположение буквы в строке, кроме управляючих символов. Но вот как сделать, чтобы она выводила повторяюищиеся буквы в одной строке? Т.е. к примеру слово PASCAL, вывод у меня:

Код: Выделить всё

Write a word - pascal
1 - p
2 - a
3 - s
4 - c
5 - a
6 - l

А хочу:

Код: Выделить всё

Write a word - pascal
1 - p
2, 5 - a
3 - s
4 - c
6 - l

Для начала давайте объясним всем, что речь идёт о задачах 24-В и 24-Г:

24-В) Для введенной пользователем строки напечатать позиции всех встречающихся в ней символов, кроме пробелов, в алфавитном порядке. Для символов, которые встречаются несколько раз, напечатать позиции в одной строке.

Код: Выделить всё

var  S: string;
     c: char;
     i: integer;
     flag: boolean; { признак для печати очередной строки }
begin
  Write('S = ');  Readln(S);
  { Char(33) - первый символ после пробела }
  for c:=Char(33) to Char(255) do begin
    flag:= false;
    for i:=1 to Length(S) do if c=S[i] then begin
      if not flag then Write(c, ' - ');
      Write(i,' ');
      flag:= true;
    end;
    if flag then Writeln;
  end;
  Readln;
end.


24-Г) Для введенной пользователем строки напечатать позиции всех встречающихся в ней символов, кроме пробелов, в порядке их следования в строке.

Код: Выделить всё

var  S: string;
     c: char;
     i, j: integer;
begin
  Write('S = ');  Readln(S);
  for i:=1 to Length(S)  do begin
    c:= S[i];
    if c<>Char(32) then begin  { Char(32) - пробел }
      Write(c, ' - ');
      for j:=i to Length(S) do if c=S[j] then begin
        Write(j,' ');
        S[j]:= Char(32);  { затираем символ пробелом }
      end;
      Writeln;
    end;
  end;
  Readln;
end.


А теперь переделайте их, создав процедуры, принимающую строку.

В ответы я тоже смотрел, меня интересовало как сделать на базе моего варианта.

deka47 писал(а):В ответы я тоже смотрел, меня интересовало как сделать на базе моего варианта.

Например,

Код: Выделить всё

procedure check(s: string);
var
  i, j: integer;
begin
  for i := 1 to length(s) do
    if s[i] > ' ' then begin
      write(i);
      for j := i+1 to length(s) do
        if s[j] = s[i] then begin
          write(', ', j); s[j] := ' ';
        end;
      writeln(' - ', s[i]);
    end;
end;

var
  s: string;
begin
  write('Enter a word: '); readln(s);
  check(s);
end.


Прогон:

Код: Выделить всё

Enter a word: pascal
1 - p
2, 5 - a
3 - s
4 - c
6 - l


Хорошее решение от bormant.
Обратите внимание на передачу строки в процедуру:
procedure check(s: string);
Это тот случай, когда не ставится ни VAR, ни CONST.

Ещё один вариант процедуры check, в котором для учёта уже обработанных символов используется не модификация копии оригинальной строки, а множество символов:

Код: Выделить всё

procedure check(const s: string);
var
  i, j: integer;
  p: set of char(33)..char(255);
begin
  p := [];
  for i := 1 to length(s) do
    if (s[i] > ' ') and not (s[i] in p) then begin
      write(i);
      for j := i+1 to length(s) do
        if s[j] = s[i] then begin
          write(', ', j); include(p, s[j]);
        end;
      writeln(' - ', s[i]);
    end;
end;


include(p, s[j]) равнозначно p:= p + [ s[j] ] ?
Тоже хорошее решение, но на будущее, поскольку в главе 24 множества ещё не изучались.

Oleg_D писал(а):include(p, s[j]) равнозначно p:= p + [ s[j] ] ?

По смыслу -- да, по эффективности реализации Include/Exlude должны быть эффективнее (по крайней мере не хуже) варианта с созданием промежуточного множества [ s[j] ] (как для i:=i+1 и inc(i)). К тому же поддерживаются "магией компилятора", позволяя указывать в качестве второго параметра диапазоны через ":".

Oleg_D писал(а):Тоже хорошее решение, но на будущее, поскольку в главе 24 множества ещё не изучались.

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

bormant писал(а):Возможно, это повод для дополнительной задачи в главу про множества их обычно не так-то просто придумывать. Да и реализация одного и того же различными средствами может возыметь положительный педагогический эффект.

Согласен. Альтернативная реализация множеств затронута здесь:
Задача 49-В (стр. 389)
Задача 61-Б (стр. 519)
Но есть ещё много мыслей на эту тему, только руки не доходят всё изложить.

bormant , разобрался с вашим кодом, спасибо. Но есть один вопрос, что это значит:

Код: Выделить всё

if s[i] > ' '

Если символ больше пробела? Я не пойму вот только этот кусочек.

Это тоже что и:

Код: Выделить всё

if ord(s[i]) > 32

Но я что то сомневаюсь.

Не сомневайтесь, возможно многое
например, словари "Англо-русский" или "Русско-английский" -- в качестве критерия сортировки обычно используется "положение буквы в алфавите". Вот только одна есть беда, иногда порядок сортировки с кодом символа не совпадает... Но это не наш случай, в латинице все до пробела и дальше до символа с кодом 127 стандартнее некуда -- ASCII, только очень-и-очень древние могут перемочь эти нынешние условности.

Возвращаясь к вопросу: да, char1 vs. char2 в нынешних паскалях сравнивается как byte(char1) vs byte(char2), то есть по их числовому коду.

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

Не дает покоя решение задачи Глава 24, Г

а именно строки :
S[j]:= Char(32); { затираем символ пробелом }

Мужики, разъясните пожалуйста для чего она нужна?

Спасибо!

Глава посвящена шифрованию, но в решении ничего с ним не связано. Есть другой способ решения этой задачи?

HELP!
Задание " Г ".

Так и не понял, как у bormanta получается обнулять строки с помощью " s[j] := ' '; ". Можно ли задать в " if " ( красным цветом в коде if (S <> ' ') { and (S[i] <> S[1..(i - 1)]) } условие, чтобы сравнивал предыдущие символы с рассматриваемым?

Код: Выделить всё

var S             : string;
    N             : integer;        { dlina stroki }
    i, k          : integer;        { schetchiki }

begin
  Write(' Vvedite stroku: '); Readln(S);
  N := Length(S);                           { dlina stroki }
  for i := 1 to N do
                    if (S[i] <> ' ') { and (S[i] <> S[1..(i - 1)]) }
                      then
                        begin
                          Write(S[i], '- ');
                          for k := i to N do
                                            if S[k] = S[i]
                                              then
                                                Write(k, ', ');
                          Writeln('');
                        end;
  Readln;
end.




Добавлено спустя 1 час 24 минуты 49 секунд:


[i]В задании " Г ",

Объясните, пожалуйста, на пальцах, какое условие является решающим для переменной FLAG?

Уж Герман близится, а полночи всё нет... (почти цитата)

Давайте будем оперировать синтаксически корректными выражениями языка Паскаль, а обсуждение разных фантазий оставим другим сказочным персонажам.