Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Lazarus, Free Pascal, CodeTyphon
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 01.10.2019, 23:35   #1
Hikkaru
Новичок
Джуниор
 
Регистрация: 01.10.2019
Сообщений: 2
Печаль Упс, туплю в Lazarus

Ребятки, просветите нуба.
Есть задачка: (сделать в Lazarus)
Измерить объем следующего информационного сообщения в битах, байтах, килобайтах и мегабайтах при условии, что каждый символ кодируется 1 байтом: «Первая информационная революция – освоение человечеством языка». Вычислить по формуле Шеннона среднюю информационную емкость символа сообщения. Оценить информационную емкость всего сообщения.

Решил написать код, чтобы программа считала кол-во определенных символов в строке:
Код:
procedure TForm1.Button1Click(Sender: TObject);
var
  leng,p,e,r,v,a,ia,i,n,f,o,m,c,s,l,ie,k,pr,sp,u,ch,t,z,i1,summ: longint;
  txt: string;
begin
  txt:=Edit1.Text;
  leng:=UTF8Length(txt);
  p:=0;
  e:=0;
  r:=0;
  v:=0;
  a:=0;
  ia:=0;
  i:=0;
  n:=0;
  f:=0;
  o:=0;
  m:=0;
  c:=0;
  s:=0;
  l:=0;
  ie:=0;
  k:=0;
  pr:=0;
  u:=0;
  ch:=0;
  t:=0;
  z:=0;
  BEGIN
    for i1 := 1 to leng do
    begin
    if txt[i1] = 'П' then p:=p+1
    else
      begin
        if txt[i1] = 'e' then e:=e+1
        else
          begin
            if txt[i1] = 'р' then r:=r+1
            else
              begin
                if txt[i1] = 'в' then v:=v+1
                else
                  begin
                    if txt[i1] = 'а' then a:=a+1
                    else
                      begin
                        if txt[i1] = 'я' then ia:=ia+1
                        else
                          begin
                            if txt[i1] = 'и' then i:=i+1
                            else
                              begin
                              if txt[i1] = 'н' then n:=n+1
                              else
                                begin
                                  if txt[i1] = 'ф' then f:=f+1
                                  else
                                    begin
                                      if txt[i1] = 'о' then o:=o+1
                                      else
                                        begin
                                        if txt[i1] = 'м' then m:=m+1
                                        else
                                          begin
                                          if txt[i1] = 'ц' then c:=c+1
                                          else
                                            begin
                                            if txt[i1] = 'с' then s:=s+1
                                            else
                                              begin
                                              if txt[i1] = 'л' then l:=l+1
                                              else
                                                begin
                                                if txt[i1] = 'ы' then ie:=ie+1
                                                else
                                                  begin
                                                  if txt[i1] = 'к' then k:=k+1
                                                  else
                                                    begin
                                                    if txt[i1] = '-' then pr:=pr+1
                                                    else
                                                      begin
                                                      if txt[i1] = 'ю' then u:=u+1
                                                      else
                                                        begin
                                                        if txt[i1] = 'ч' then ch:=ch+1
                                                        else
                                                          begin
                                                          if txt[i1] = 'т' then t:=t+1
                                                          else
                                                            begin
                                                             if txt[i1] = 'з' then z:=z+1
                                                            end;
                                                            end;
                                                          end;
                                                        end;
                                                      end;
                                                    end;
                                                  end;
                                                end;
                                              end;
                                            end;
                                          end;
                                        end;
                                    end;
                              end;
                          end;
                      end;
                  end;
              end;
          end;
      end;
    end;
    END;
    Label2.Caption:=IntToStr(p);
    end;
Программа запускается, но выдает на любую переменную значение 0.

Как быть?
Hikkaru вне форума Ответить с цитированием
Старый 02.10.2019, 10:02   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Это просто ужас!

Цитата:
Сообщение от Hikkaru Посмотреть сообщение
Программа запускается, но выдает на любую переменную значение 0.
стоит открыть для себя массивы (или списки - TList, TStringList...).

это во-первых.
а во-вторых, возможна проблема с unicode, я не уверен, что уникод символы можно просто так перебирать и сравнивать.
https://wiki.lazarus.freepascal.org/...ort_in_Lazarus
вот Edit1.Text какой тип имеет? String? UTF8String? UnicodeString? другой?

вот что говорит оф.док ( https://wiki.lazarus.freepascal.org/String )
Цитата:
String is an alias for ShortString, AnsiString or Unicodestring (UTF16) depending on a compiler setting.

Последний раз редактировалось Serge_Bliznykov; 02.10.2019 в 10:07.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 02.10.2019, 10:16   #3
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

txt[i1] --символ или строка содержащая один байт
'П' (и любой другой символ кириллический символ) в UTF8 кодировке ДВА символа.
стало быть НИКАКОЕ из равенств не имеет места.
Цитата:
но выдает на любую переменную значение 0.
вар1. использовать для работы utf8 функции
Код:
r:= utf8copy(txt,i1, 1);
k:=utf8Pos('П', txt, 1);
Код:
  const 
    alf ='абвгде...'; //и так ВСЕ нужные(возможные) символы
  var
    stat: array [0..33] of integer;

    for i1:=0 to length(stat) stat[i1]:=0;

    for i1:=1 to utf8length(txt) do begin
      r:=utf8copy(txt, i1, 1);
      k:=utf8pos(r, alf, 1);
      if k<0 then continue;

      stat[k]:=stat[k]+1;
//     s:=format('%s=%d', [utf8copy(alf, k,1), stat[k]);
//   Label2.Caption:=s;
  end;

  for i1=1 to utf8length(alf) do begin
    s:=format('%s=%d', [utf8copy(alf,i1,1), stat[i1]);
    memo1.lines.add(s);
  end;
вар2. перейти к ANSI-строкам
Код:
txt:=utf8toansi(txt);

case txt[i1] of 
'П': p:=p+1; // быть может и прокатит (компилятор поймет что здесь ANSI 
....
end;
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Старый 02.10.2019, 10:52   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

evg_m, я бы лично тоже перешёл к Ansi строкам и все проблемы сразу ушли
чтобы перейти к ANSI достаточно задать настройки (опции) компилятора.

что же касается

Цитата:
Сообщение от evg_m Посмотреть сообщение
'П': p:=p+1; // быть может и прокатит (компилятор поймет что здесь ANSI
то так вообще не надо делать.
нужно
в цикле брать элементы строки и помещать их в массив/список.
и там считать их количество. Никаких констант в коде не должно быть. Это принципиально важно!

Код:
var txt : AnsiString;
  ts : TStringList; // должен быть в FPC
  i, k : integer;
begin
   txt:=utf8toansi(Edit1.Text);
   ts := TStringList.Create;
   for i:=1 to Length(txt) do begin
       k := ts.IndexOf(Copy(txt,i,1));
       if k = -1 then
             ts.AddObject(Copy(txt,i,1), TObject(1))
       else 
            ts.Objects[k] := TObject(integer(ts.Objects[k]) + 1);
   end;

  // тут вывод значений букв и количество, сколько раз каждая буква встретилась в слове
  for i:=0 to ts.Count -1 do
       // выводим ts.Strings[i] - это буква
       // выводим integer(ts.Objects[i]) - это количество раз, сколько буква встретилась в строке.


  // очистим память
  ts.Free;
end;
Вот и всё!

Последний раз редактировалось Serge_Bliznykov; 02.10.2019 в 11:06.
Serge_Bliznykov вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Туплю... Predator199 JavaScript, Ajax 8 31.10.2014 11:05
Перекомпиляция программы(простой) Win Lazarus в Linux Lazarus Toxifer Фриланс 0 27.11.2012 22:46
Туплю с классами MyXa C# (си шарп) 1 20.06.2012 13:20
Баг Excel или я туплю? Raf_19 Microsoft Office Excel 5 06.08.2008 16:39