Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Object Pascal: кроссплатформенные технологии > вывести количество букв в слове

Автор: Рус 28.1.2009, 14:10

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

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

Код

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 - считаем количество одинаковых буковок и выводим на экран

Автор: stachel 28.1.2009, 16:47

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

Код


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

Код

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

Цитата(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);