[Delphi] Sprawdzenie czy dana liczba da się zapisać z podanego zestawu

Wiyam.

Dawno sam nie pisałem z żadnym problemem, a przez rozwiązywania tylko banałów sam się zamotałem i nie radzę sobie z wydaje mi
się dosyć prostym problemem. Chodzi o napisanie funkcji, ktora działała by pod Delphi także w konsoli ale bez użycia dodatkowych
modułów nie licząc funkcji IntToStr oraz StrToInt. Dostałem zapytanie na PMkę o zadanie właśnie w ktorym program oprócz tego że
z podanego zakresu ma wypisać liczby pierwsze to też sprawdzić czy z podanych liczb da się ułożyć inną liczbę. Nie szło mi wcale w
konsolowej to zacząłem coś modzić pod VCL żeby zobaczyć czy dobrze kombinuje. Mianowicie chodzi o to że jak w CałaLiczba mamy
na przykład 123 a w Zestaw 122 to zwróci False, ale dla Liczby 12 i Zestawu 122 będzie zwracalo True. Czyli podsumowując, chodzi
o to że jak mamy zestaw liczb 12311 to to możemy z nich ułożyć CałąLiczbę 12, 31, 311 ale 323 już nie. I wiem, że trochę pokrętnie
to wytłumaczyłem, ale być może ktoś sie zlituje i poda jakiś prosty kod. Ten mój źle działa. Nie wychodzi mi sprawdzanie powtórzen,
bo nie wiem czy w ogóle zliczam to jak należy, a nawet jeśli tak to później nie mam pomysłu na końcowe określenie rezultatu funkcji.

//...
var
  Form1 : TForm1;
  LItm : TListItem;

const
  Pft : array[boolean] of string = ('Fałsz', 'PRAWDA');

implementation

{$R *.dfm}

function UnikalnaLiczba(CalaLiczba, Zestaw : integer) : boolean;
var
  S : string;
  I, Liczba, Licznik : integer;
  TabPrawdy : array[0..9] of boolean;
  TablicaL, TablicaZ : array[0..9] of Byte;
begin
  Licznik := 0;
  UnikalnaLiczba := False;
  for I := Low(TablicaL) to High(TablicaL) do
  begin
    TablicaL[I] := 0;
    TablicaZ[I] := 0;
    TabPrawdy[I] := False;
  end;
  for I := 1 to Length(IntToStr(CalaLiczba)) do
  begin
    Liczba := StrToInt(IntToStr(CalaLiczba)[I]);
    TablicaL[Liczba] := TablicaL[Liczba] + 1;
  end;
  for I := 1 to Length(IntToStr(Zestaw)) do
  begin
    Liczba := StrToInt(IntToStr(Zestaw)[I]);
    TablicaZ[Liczba] := TablicaZ[Liczba] + 1
  end;
  for I := Low(TabPrawdy) to High(TabPrawdy) do
  begin
    TabPrawdy[I] := (TablicaL[I] > 0) and (TablicaZ[I] > 0) and (TablicaL[I] <= TablicaZ[I]);
    if TabPrawdy[I] = True then
    begin
      Licznik := Licznik + 1;
    end;
  end;
  UnikalnaLiczba := Licznik = Length(IntToStr(CalaLiczba));
  with Form1 do
  begin
    LV1.Items.Clear;
    for I := Low(TablicaL) to High(TablicaL) do
    begin
      LItm := LV1.Items.Add;
      Litm.Caption := IntToStr(I);
      LItm.SubItems.Add(IntToStr(TablicaL[I]));
      LItm.SubItems.Add(IntToStr(TablicaZ[I]));
      Litm.SubItems.Add(Pft[TabPrawdy[I] = True])
    end;
  end;
end;

procedure TForm1.Button1Click(Sender : TObject);
begin
  Caption := Pft[UnikalnaLiczba(StrToInt(Edit1.Text), StrToInt(Edit2.Text)) = True];
end;

Zapewne to nie to, ale może tak:

function sprawdz(zestaw, liczba : integer) : boolean;
var
  liczbaStr : String;
  zestawStr : String;

  x : integer;
begin
  liczbaStr := IntToStr(liczba);
  zestawStr := IntToStr(zestaw);

  Result := true;
  for x := 1 to Length(liczbaStr) do
    begin
    if Pos(liczbaStr[x], zestawStr)  > 0 then
      zestawStr := StringReplace(zestawStr, liczbaStr[x], '', [])
      else
        begin
        Result := false;
        break;
        end;
    end;
end;

StringReplace i Pos to ta sama biblioteka co IntToStr i StrToInt. Zawsze można usunąć StringReplace i Pos i jechać po elementach tablicy zachowując sposób działania tego czegoś powyżej, no chyba że koniecznie Ci zależy na "zliczaniu powtórzeń".

Ale to działa pod konsolą:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  Pft : array[boolean] of string = ('FAŁSZ', 'PRAWDA');

function sprawdz(zestaw, liczba : integer) : boolean;
var
  liczbaStr : String;
  zestawStr : String;

  x : integer;
begin
  liczbaStr := IntToStr(liczba);
  zestawStr := IntToStr(zestaw);

  Result := true;
  for x := 1 to Length(liczbaStr) do
    begin
    if Pos(liczbaStr[x], zestawStr)  > 0 then
      zestawStr := StringReplace(zestawStr, liczbaStr[x], '', [])
      else
        begin
        Result := false;
        break;
        end;
    end;
end;

begin
  writeln(Pft[sprawdz(1234, 124) = True]); //daje true
  writeln(Pft[sprawdz(1234, 144) = True]); //daje false
  writeln(Pft[sprawdz(1222, 122) = True]); //daje true
  Readln;
end.

jeśli dobrze rozumiem potrzebujesz po prostu sprawdzić czy pos(liczba, zestaw) > 0. Jeśli tak i nie możesz użyć pos to po prostu skopiuj sobie źródła pos :]

Misiekd: dokładnie chodzi mi o to co napisałeś w komentarzu, lecz nie wiem czy tutaj pomoże zwykła
funkcja Pos, która jest standardową funkcją działającą bez żadnego modułu. A i madmike miał rację
bo pisałem post nieco zaspany już, bo późna pora była. Także uściśle chodzi mi o to, czy daną liczbę
da się ułożyć z zestawu liczb. Czyli jeżeli mamy zestaw 3123 to możemy z niego ułożyć tylko liczby,
które zawierają jedną jedynkę, jedną dwójkę i maksymalnie dwie trójki, ale również same: 1, 2, 3.
I właśnie potrzebuje wykombinować taką funkcję. StringReplace wolał bym nie używać, lecz zawsze
mogę wygooglować jakiś podobny alborytm albo podejrzeć źródła owej funkcji - z wersji Enterprise.

EDIT: ależ to banał, dopiero jak zastanawiałem się nad podpowiedxią o Pos od MisiekD to mnie jakoś
w koncu olśniło. Poniżej kod o jaki mi chodziło. Prościej się chyba nie da. Sorry za zawracanie Wam
głowy i Tosterowi z forum unit1 ktorego też prosiłem aby spojrzal na ten temat - już rozwiązane :)

//...
const
  Pft : array[boolean] of string = ('Fałsz', 'PRAWDA');

function IsUniqueNumber(ANumber : integer; ASet : string) : boolean;
var
  DigitStr : string;
  I, X, Cnt : integer;
begin
  Cnt := 0;
  DigitStr := IntToStr(ANumber);
  for I := 1 to Length(DigitStr) do
  begin
    X := Pos(DigitStr[I], ASet);
    if X > 0 then
    begin
      Cnt := Cnt + 1;
      Delete(ASet, X, 1);
    end;
  end;
  IsUniqueNumber := Cnt = Length(DigitStr);
end;

procedure TForm1.Button2Click(Sender : TObject);
begin
  Caption := Pft[IsUniqueNumber(3508,'0358') = True];  // PRAWDA
  Caption := Pft[IsUniqueNumber(35080, '0358') = True]; // Fałsz
end;

Olesio, Twój problem zrozumiałem w ten sposób, że chcesz sprawdzić, czy jeden zbiór jest podzbiorem drugiego.
Dane są dwie liczby, które traktujemy jako zbiór cyfr i sprawdzamy, czy z cyfr jednej liczby da się ułożyć drugą liczbę. Ja rozwiązałbym to tak:

function Podzbior(Liczba1, Liczba2: Integer): Boolean;
var Cyfry: array[0..9] of Integer;
    Tmp: string;
    i: Integer;
begin
  for i:= 0 to 9 do Cyfry[i]:= 0;
  Tmp:= IntToStr(Liczba1);
  for i:= 1 to Length(Tmp) do Inc(Cyfry[StrToInt(Tmp[i])]);
  Tmp:= IntToStr(Liczba2);
  for i:= 1 to Length(Tmp) do Dec(Cyfry[StrToInt(Tmp[i])]);
  Result:= true;
  for i:= 0 to 9 do if Cyfry[i] < 0 then Result:= false;
end;

Według mnie ten kod jest prostszy i łatwiejszy do zrozumienia, ale Ty możesz mieć inne zdanie, bo ... parafrazując znane przysłowie: bodajbyś cudze kody analizował ;)

Simplex: dzięki za kod, nie sprawdziłem go jeszcze, ale pewnie też może być. Mi się wydaje,
że moje rozwiązane też jest ok, chociaż wiadomo rzecz gustu, bo i gusta w programowaniu
chyba też występują tak jak w życiu - tylko pewnie niekiedy "kłócą się" z optymalnością ;)