VPF::Вычленить все цифры в числе - Форум программистов

Zero

Дата 4.10.2006, 22:13 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2169
Регистрация: 23.10.2004
Где: Россия, г. Рязань

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

Тут всё просто:

Код


procedure TForm1.Button1Click(Sender: TObject);
var
  s,b,res,p:string;
  i:integer;
begin
  s:= edit1.Text;
  i:=length(s);

  repeat
    b := s[i];
    if b <> '0' then res := b + res
    else
      begin
        res := '0' + res;
        p:='';
        repeat
          i:=i-1;
          b := s[i];
          if b = '0' then p:=p+'0';
        until b <> '0';
        b := b+p;
        if (length(b) = 1) and (b='1') and (i=1) then b := b + '0';
        res := IntToStr(StrToInt(b)-1) + res;
      end;
    i:=i-1;
  until i<=0;
  ShowMessage(res);
end;

Albinos_x

Дата 4.10.2006, 22:29 (ссылка)

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

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

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

попробуй это:

Код


// flag := True  -  32045->33045
// flag := False -  33045->32045
function XToX(X:String; flag: boolean):String;
var i: Integer;
    Len:Integer;
    B, B1:Boolean;
    C, N:Integer;
begin
Len:=Length(X);
Result:='';
B:=False;
B1:=False;
C:=0;
N:=1;
if Flag then
   begin
   For i:=Len downto 1 do
      begin
      if X[i]='0' then
         C:=C+10*N
         else
         C:=C+(StrToInt(X[i])*N);
      N:=N*10;
      end;
   Result:=IntToStr(C);
   end
   else
   begin
   For i:=Len downto 1 do
      begin
      if B1 then
         begin
         if i<>1 then
            B1:=False;
         if X[i]<>'0' then
            X[i]:=IntToStr(StrToInt(X[i])-1)[1]
            else
            begin
            X[i]:='9';
            B1:=true;
            end;
         end;
      if B then
         begin
         if X[i]<>'0' then
            X[i]:=IntToStr(StrToInt(X[i])-1)[1]
            else
            begin
            X[i]:='9';
            B1:=true;
            end;
         B:=false;
         end;
      if X[i]='0' then
         begin
         B:=True;
         end;
      if (i=1) then
         if Len>2 then
            if B and ((X[2]='0') or B1) then  Exit;
      Result:=X[i]+Result;
      end;
   end;
end;

использование:

Код


procedure TForm1.Button1Click(Sender: TObject);
Var X:Integer;
begin
Edit2.Text:=XToX(Edit1.Text,True);
end;

procedure TForm1.Button2Click(Sender: TObject);
Var X:Integer;
begin
Edit2.Text:=XToX(Edit1.Text,False);
end;

Добавлено @ 22:32
Zero,

Цитата(Zero @ 4.10.2006, 22:13

)

Тут всё просто:

на 110 не верный результат выдаёт...

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

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

Zero

Дата 4.10.2006, 22:46 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2169
Регистрация: 23.10.2004
Где: Россия, г. Рязань

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

Цитата(Albinos_x @ 4.10.2006, 23:29

)

на 110 не верный результат выдаёт...

Проверять вообще надо руками.

Хотя, если старший разряд 10 то резултат немного не тот, но вот так всё отлично:

Код


procedure TForm1.Button1Click(Sender: TObject);
var
  s,b,res,p:string;
  i:integer;
begin
  s:= edit1.Text;
  i:=length(s);

  repeat
    b := s[i];
    if b <> '0' then res := b + res
    else
      begin
        res := '0' + res;
        if i=2 then
          if s[1]='1' then break;
        p:='';
        repeat
          i:=i-1;
          b := s[i];
          if b = '0' then p:=p+'0';
        until b <> '0';
        b := b+p;
        if (length(b) = 1) and (b='1') and (i=1) then b := b + '0';
        res := IntToStr(StrToInt(b)-1) + res;
      end;
    i:=i-1;
  until i<=0;
  ShowMessage(res);
end;

Добавлено @ 22:52
Стоп, извиняюсь... 100 это не верный резултат. smile

Albinos_x

Дата 4.10.2006, 23:03 (ссылка)

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

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

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

Цитата(Zero @ 4.10.2006, 22:46

)

Стоп, извиняюсь... 100 это не верный резултат.

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

Добавлено @ 23:10
Попробую вернуться к первоначальному варианту.... его немного подработать...

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

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

Albinos_x

Дата 4.10.2006, 23:25 (ссылка)

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

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

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

изменил немного подход к делу... соединил 2 предложенных алгоритма мной до этого, плюс немного один переработал, с учётом, что при кодировании могут поступить значения с нулями, а при раскодировании такого не должно быть... тем самым немного сократил код:

Код


// flag := True  -  32045->33045
// flag := False -  33045->32045
function XToX(X:String; flag: boolean):String;
var i: Integer;
    Len:Integer;
    C, N:Integer;
begin
Result:='';
if Flag then
   begin
   Len:=Length(X);
   C:=0;
   N:=1;
   For i:=Len downto 1 do
      begin
      if X[i]='0' then
         C:=C+10*N
         else
         C:=C+(StrToInt(X[i])*N);
      N:=N*10;
      end;
   Result:=IntToStr(C);
   end
   else
   begin
   C:=StrToInt(X);
   Repeat
      N:=C mod 10;
      C:=C div 10;
      if N=0 then C:=C-1;
      Result:=IntToStr(N)+Result;
     until C=0;
   end;
end;

в общем сокращение произошло только из-за того, что анализировал и изменял не символы, а цифры...

Это сообщение отредактировал(а) Albinos_x - 4.10.2006, 23:28

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

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

POP

Дата 5.10.2006, 01:55 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата(Albinos_x @ 4.10.2006, 23:25)

Код


// flag := True  -  32045->33045
// flag := False -  33045->32045
function XToX(X:String; flag: boolean):String;
var i: Integer;
    Len:Integer;
    C, N:Integer;
begin
Result:='';
if Flag then
   begin
   Len:=Length(X);
   C:=0;
   N:=1;
   For i:=Len downto 1 do
      begin
      if X[i]='0' then
         C:=C+10*N
         else
         C:=C+(StrToInt(X[i])*N);
      N:=N*10;
      end;
   Result:=IntToStr(C);
   end
   else
   begin
   C:=StrToInt(X);
   Repeat
      N:=C mod 10;
      C:=C div 10;
      if N=0 then C:=C-1;
      Result:=IntToStr(N)+Result;
     until C=0;
   end;
end;

в общем сокращение произошло только из-за того, что анализировал и изменял не символы, а цифры...

А на самом деле обратное преобразование вот в таком маленьком коде:

---
repeat
c:=a mod 10;
s:=inttostr©+s;
if c=0 then a:=a-10;
a:=a div 10;
until a=0;
---

Добрые люди подсказали... целый день седня копал smile

Albinos_x

Дата 5.10.2006, 03:17 (ссылка)

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

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

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

Цитата(POP @ 5.10.2006, 01:55

)

А на самом деле обратное преобразование вот в таком маленьком коде:

сравнивал с моим на обратное:

Цитата(Albinos_x @ 4.10.2006, 23:25

)

   C:=StrToInt(X);
   Repeat
      N:=C mod 10;
      C:=C div 10;
      if N=0 then C:=C-1;
      Result:=IntToStr(N)+Result;
     until C=0;
   end;

за то, моя ф-я считает и туда и обратно...

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

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

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