VPF::[Delphi] Разбор строки. Химическая формула.

kemiisto

Дата 4.4.2008, 18:11 (ссылка)

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

Загрузка ...

Дикий Кот. =^.^=

Награды: 1

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

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

Вообщем так, нужно разобрать строку, содержащую брутто-формулу. Эти формулы отражают состав вещества. Нужно выяснить атомы каких элементов и в каком кол-во входят в молекулу вещ-ва, заданную строкой.
Правила разбора такие:

название элемента - строка, которая начинается с заглавной буквы, далее следуют 0 или несколько прописных букв;
кол-во атомов элемента в молекуле - целое число, стоящее после названия одного элемента и до названия другого. При этом 1 может быть опущена.

Например, H2O - 2 атома H, 1 атом O.

Вопрос: как такое реализовать на Delphi?

--------------------

XMPP-канал.

Unit testing isn't enough. You need static typing.

Пей, кури, пиши на си! smile

Rodman

Дата 4.4.2008, 18:17 (ссылка)

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

Загрузка ...

CIO

Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

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

формала одна? ну то есть вводишь тока "H2SO4" и больше ничего нету?

--------------------

CRM с функцией АвтоОбзвона

Лотереи мира

kemiisto

Дата 4.4.2008, 18:52 (ссылка)

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

Загрузка ...

Дикий Кот. =^.^=

Награды: 1

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

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

Цитата(Rodman @ 4.4.2008, 18:17

)

формала одна? ну то есть вводишь тока "H2SO4" и больше ничего нету?

Да.

--------------------

XMPP-канал.

Unit testing isn't enough. You need static typing.

Пей, кури, пиши на си! smile

THandle

Дата 4.4.2008, 22:11 (ссылка)

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

Загрузка ...

Хранитель Клуба
Group Icon

Награды: 1

Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

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

Значит так, сильно не пинаем.

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

Например

CaSO4 -

1 Ca,
1 S,
4 O.

Скобочки не учел, сил не хватило, но думаю нетрудно будет добавить.
Код ужасен, но работает)

Код


program Project1;

{$APPTYPE CONSOLE}


function Next(var ResData : string; borc : boolean; s : string; prev : integer) : integer;
var
  i : integer;
begin
  case borc of
    true: begin
      for i := prev to length(s) do
         begin
           if s[i] in ['1'..'9'] then
              ResData := ResData + s[i]
           else
             begin
               result := i;
               exit;
             end;
         end;
    end;
    false:begin
      for i := prev to length(s) do
         begin
           if s[i] = ' ' then
             begin
               result := length(s);
               exit;
             end;
           if not(s[i] in ['1'..'9']) then
             begin
               if ord(s[i]) in [97..128] then
                 begin
                    if ResData <> '' then
                       ResData := ResData + s[i]
                    else
                      Continue
                 end
                   else
                     if ord(s[i]) in [65..90] then
                       begin
                         if ResData <> '' then
                           begin
                             result := i;
                             exit;
                           end
                             else
                               ResData := ResData + s[i]
                       end;
             end
           else
             begin
               result := i;
               exit;
             end;
         end;
  end;
end;
end;

var
  i : integer;
  s, sub, sub2 : string;
begin
  writeln('Enter formul: ');
  readln(s);
  s := s + ' ';
  i := 1;
  while i < length(s) do
    begin
      i := Next(sub, false, s, i);
      if Sub <> '' then
        sub2 := sub
      else
        sub2 := '1';
      sub := '';
      i := Next(sub, true, s, i);
      writeln(sub2 + ' atoms ' + sub);
      sub := '';
    end;
  readln;
end.

До этого рабочего варианта еще строк 300 кода накалякал smile

Это сообщение отредактировал(а) THandle - 4.4.2008, 22:19

kemiisto

Дата 5.4.2008, 11:49 (ссылка)

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

Загрузка ...

Дикий Кот. =^.^=

Награды: 1

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

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

Вот, что пока получилось. Вариант предварительный но вроде работает:

Код


unit UnitParse;

interface

type
  TPart = record
    Element: String;
    Count: String;
    Flag: Boolean;
  end;

  TDynArray = array of TPart;

  TFormula = class
    public
      FParts: TDynArray;
      procedure Parse(InStr: String);
  end;

implementation

procedure TFormula.Parse(InStr: String);
var
  i, n: Integer;
  S, Element, Count: String;
begin
  S := InStr;
  while Length(S) > 0 do
  begin
    if S[1] in ['A'..'Z'] then
    begin
      n := Length(FParts);
      SetLength(FParts, n + 1);
      FParts[n].Element := S[1];
      FParts[n].Count := '1';
      FParts[n].Flag := False;
    end
    else
      if S[1] in ['a'..'z'] then
        FParts[n].Element := FParts[n].Element + S[1]
      else
        if S[1] in ['1'..'9'] then
        begin
          if not FParts[n].Flag then
          begin
            FParts[n].Count := S[1];
            FParts[n].Flag := True;
          end
          else
            FParts[n].Count := FParts[n].Count + S[1];
        end;
    Delete(S, 1, 1);
  end;
end;

end.

Пример использования:

Код


program test;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  UnitParse in 'UnitParse.pas';

var
  FormulaStr: String;
  Formula: TFormula;
  i: Integer;

begin
  Write('Formula: ');
  Readln(FormulaStr);
  Formula := TFormula.Create;
  Formula.Parse(FormulaStr);
  for i := 0 to Length(Formula.FParts) - 1 do
  begin
    Write(Formula.FParts[i].Element, ' ', Formula.FParts[i].Count);
    Writeln;
  end;
  Readln;
end.

THandle, спасибо за идею!

--------------------

XMPP-канал.

Unit testing isn't enough. You need static typing.

Пей, кури, пиши на си! smile

kemiisto

Дата 17.5.2008, 20:48 (ссылка)

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

Загрузка ...

Дикий Кот. =^.^=

Награды: 1

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

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

Играясь с Ruby, потихоньку осваиваю регулярные выражения... Мощная штука, однако! smile

Чтоб использовать с Delphi нужна TRegExpr Library, которую можно взять тут.

Вот, что получилось у меня при решении задачи из этой темы:

Код


program test;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  RegExpr in 'RegExpr.pas';

var
  FormulaStr: String;
  R: TRegExpr;
begin
  Write('Formula: ');
  Readln(FormulaStr);
  Writeln(FormulaStr + ' consists of atoms:');
  R := TRegExpr.Create;
  R.Expression := '([A-Z][a-z]?)(\d?)';
  if R.Exec(FormulaStr) then
  repeat
    if StrToIntDef(R.Match[2], 1) < 2 then
      Writeln(R.Substitute('1 atom of $1'))
    else
      Writeln(R.Substitute('$2 atoms of $1'));
  until not R.ExecNext;
  Readln;
end.

Это сообщение отредактировал(а) kemiisto - 18.5.2008, 11:57

--------------------

XMPP-канал.

Unit testing isn't enough. You need static typing.

Пей, кури, пиши на си! smile

THandle

Дата 18.5.2008, 14:04 (ссылка)

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

Загрузка ...

Хранитель Клуба
Group Icon

Награды: 1

Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

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

kemiisto, да...

Намного проще получается. Надо тоже регулярки изучить, а не писать непонятные длиннющие куски кода smile

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