VPF::вывести количество букв в слове

Рус

Дата 28.1.2009, 14:10 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 25.1.2009

Репутация: нет
Всего: нет

в заданном слове надо подсчитать сколько раз повторилась каждая буква. вот решение задачи.но оно выводит на жкран весь алфавит.а надо только те буквы которые встречаються в заданном слове. помогите плз!!!

var i:byte;
    a:array[65..90] of byte;
    s:string;
begin
readln(s);
for i:=1 to length(s) do
  begin
    s[i]:=upcase(s[i]);
    a[ord(s[i])]:=a[ord(s[i])]+1;
  end;
for i:=65 to 90 do
  writeln(chr(i),'-',a[i]);
end.

Loginanton

Дата 28.1.2009, 16:29 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 114
Регистрация: 8.11.2007

Репутация: нет
Всего: нет

Код

program eee;
var
          str : string;
          num , i , j , n : byte;
          tmp : char;
begin
          readln(str);
          num := length(str);

          for i := 1 to num do
          if (ord(str[i]) > 64) and (ord(str[i]) < 91) then
          str[i] := chr(ord(str[i]) + 32);

          for i := num - 1 downto 1 do
          for j := 1 to i do
          if str[j] > str[j + 1] then begin
                    tmp := str[j];
                    str[j] := str[j + 1];
                    str[j + 1] := tmp;
                    end; { if }

          n := 1;
          for i := 1 to num do
          if str[i] = str[i + 1] then
          n := n + 1
          else begin
                    writeln(str[i], ' - ', n, ' шт.');
                    n := 1;
                    end; { else }
          readln;
          end.

8 - узнаём длину строки
10 - 12 - переводим всё в нижний регистр (прога работает только с иглишом)
14 - 20 - сортируем буковки (нужно для подсчёта)
22 - 29 - считаем количество одинаковых буковок и выводим на экран

Это сообщение отредактировал(а) Loginanton - 28.1.2009, 16:33

stachel

Дата 28.1.2009, 16:47 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 21.11.2008

Репутация: нет
Всего: нет

Попробуй так...

Код


var
   s: string;
   i, j, c: Integer;
   q: set of char;
begin
  q := [];
  ReadLn(s);
  for i:= 1 to Length(s) do
  begin
    c:=0;
    for j:= 1 to Length(s) do
    begin
      if UpCase(s[i]) = UpCase(s[j]) then
         if UpCase(s[i]) in q then break
         else Inc(c);
    end;
    q := q + [UpCase(s[i])];
    if c <> 0 then WriteLn(s[i] + '-' + IntToStr(c));
  end;
end;

volvo877

Дата 28.1.2009, 20:11 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Код

var
  s: string;
  count: array[char] of integer;
  i: integer;
  ch: char;
begin
  ReadLn(s);
  FillChar(count, sizeof(count), 0);
  for i := 1 to Length(s) do inc(count[s[i]]);

  for ch := low(char) to high(char) do
    if count[ch] > 0 then writeln(ch, ' - ', count[ch]);
end.

stachel, Дельфи - в другом разделе... IntToStr надо сначала написать, чтоб его использовать...

stachel

Дата 29.1.2009, 08:53 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 21.11.2008

Репутация: нет
Всего: нет

Цитата(volvo877 @ 28.1.2009, 20:11

)

stachel, Дельфи - в другом разделе... IntToStr надо сначала написать, чтоб его использовать...

Спасибо, учту.

Можно конечно

Код


if c <> 0 then WriteLn(s[i] + '-' + IntToStr(c));

заменить на

Код


if c <> 0 then Write(s[i] + '- ', c);

Это сообщение отредактировал(а) stachel - 29.1.2009, 09:10

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »