Program generujący liczby pierwsze - na zaliczenie

0

Witam,

mam do zrobienia program następującej treści:

  1. Napisz program znajdujący wszystkie liczby pierwsze, które można stworzyć z cyfr podanej liczby całkowitej.
    Przykład: pytamy ile liczb pierwszych można stworzyć z cyfr liczby 1379? Możemy znaleźć aż 31 liczb pierwszych „zanurzonych” w liczbie 1379.
    Uwaga: budując liczbę pierwszą możemy każdą cyfrę wziąć tylko raz.

A to wynik mojej dotychczasowej pracy:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;


{ TForm1 }
type
  TForm1 = class(TForm)                        //deklaracja obiektów
    Button1 : TButton;
    Edit1 : TEdit;
    ListBox1 : TListBox;
    procedure Button1Click(Sender : TObject);
    procedure Edit1Change(Sender : TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;


var
  Form1 : TForm1;
  usernumber : integer;
  UserPrimes : array of integer;

implementation

{$R *.lfm}

{ TForm1 }

{Funkcja generująca tablicę liczb pierwszych z liczby podanej przez użytkownika}


{Procedura, której zadaniem jest pobranie liczby od uzytkownika}
procedure TForm1.Edit1Change(Sender : TObject);
begin
  usernumber := StrToInt(edit1.Text);
end;


{Procedura Licz!, tu sie wszystko bedzie dzialo}
procedure TForm1.Button1Click(Sender : TObject);
var
  i, j, k, x, index, remaining, digits : integer;
  Pnumbers, RemoveDupl, Results : array of integer;
  found : boolean;

  {0) Try...Except - obsluga wyjatkow, początek}{TO DO}
begin
  {1)Podanie liczby wpisanej przez użytkownika}
  ListBox1.Items.Add('Twoja liczba to ' + IntToStr(usernumber));
  {2)Rozklad liczby na cyfry z uzyciem tablicy}
  index := 0;
  repeat
    remaining := usernumber mod 10;
    SetLength(UserPrimes, index + 1);
    UserPrimes[index] := remaining;
    usernumber := usernumber div 10;
    index := index + 1;
  until usernumber = 0;

  Pnumbers := UserPrimes; //tablica pomocnicza
  ShowMessage(IntToStr(Length(UserPrimes)));

  {3) Pętla wypisująca zawartosć tablice}
  for i := 0 to (Length(Pnumbers) - 1) do
  begin
    ListBox1.Items.Add(IntToStr(Pnumbers[i]));
  end;

  {4) Usunięcie duplikatów z tablicy}{TO DO}
  i := 0;
  while i < Length(Pnumbers) do
  begin
    j := 0;
    found := False;

    while j < Length(RemoveDupl) do
    begin
      if Pnumbers[i] = RemoveDupl[j] then
        found := True;
      j := j + 1;
    end;

    if found = False then
    begin
      setLength(RemoveDupl, Length(RemoveDupl) + 1);
      RemoveDupl[Length(RemoveDupl) - 1] := Pnumbers[i];
    end;

    i := i + 1;
  end;
  {4a)Podanie liczby wpisanej przez użytkownika}
  ListBox1.Items.Add('Twoja liczba to ' + IntToStr(usernumber));

  {4b) Pętla wypisująca zawartosć tablice}
  for i := 0 to (Length(RemoveDupl) - 1) do
  begin
    ListBox1.Items.Add(IntToStr(RemoveDupl[i]));
  end;

  {5) Utworzenie wszystkich możliwych liczb pierwszych}{TO DO}
  digits := Length(RemoveDupl) - 1; //maksymalny indeks tablicy z cyframi
  setLength(Results, Length(Results) + 1);
  i := 0;
  j := 0;
  k := 0;
  x := 0;

  while i < digits do                   //przynajmniej jednocyfrowa
  begin
    Results[i] := RemoveDupl[i];
    i := i + 1;
  end;

  if (digits >= 2) then
  begin
    for j := 0 to digits do
      if i <> j then
        Results[i] := (RemoveDupl[i] * 10) + RemoveDupl[j];

    while (x < digits - 2) do  //jesli [przynajmniej] trzycyfowa
    begin
      for k := 0 to digits do
        if j <> k then
          Results[j] := (i * 100 + j * 10 + k);
      x := x + 1;
    end;
  end;

  {4a)Podanie liczby wpisanej przez użytkownika}{TEST - napis rozdzielający}
  ListBox1.Items.Add('Twoja liczba to ' + IntToStr(usernumber));
  {5) Pętla wypisująca zawartosć tablice}{TEST - spr. rezultatów}
  for i := 0 to (Length(Results) - 1) do
  begin
    ListBox1.Items.Add(IntToStr(Results[i]));
  end;
  {0) Try...Except - obsluga wyjatkow, koniec programu}{TO DO}
end;

end.

Posiadając tablicę niepowtarzających się cyfr podanej liczby przez użytkownika, mam zrobić permutację, która wygeneruje kolejne możliwe kombinacje.
Proszę o pomoc

1

Wystarczy chyba wygenerować wszystkie k-bitowe liczby, gdzie k jest długością liczby wejściowej a każdy z bitów odpowiada obecności lub nie cyfry wejściowej w kombinacji wynikowej.

Czyli dla liczby 1379 generujemy 4-bitowe liczby (16 liczb):

0001: 01 + 03 + 07 + 19 = 9
0010: 01 + 03 + 17 + 09 = 7
0011: 01 + 03 + 17 + 19 = 79
0100: 01 + 13 + 07 + 09 = 3
... itd

gdzie "+" oznacza konkatenację a "*" mnożenie

Jak obliczyć maksymalną liczbę n-bitową?

a = (1 << n) - 1;
0

Mniej więcej coś w ten deseń:

type
  ArrayOfBoolean=array of Boolean; // Dla sita
  Digits=array[0..9]of Byte; // Liczniki cyfr

procedure Proceed(Num:DWord);
var I,K:Cardinal;
var Tb:array[0..9]of Byte;
var Sito:ArrayOfBoolean;
begin
  Tb:=FillDigits(Num); // Z liczby tworzymy liczniki cyfr
  Num:=MakeMaxValue(Tb); // Tworzymy z cyfr maksymalną wartość
  Eratostenes(Sito,Num); // Tworzymy sito Eratostenesa do Num włącznie
  for I:=2 to Num do
  begin
    if (not Sito[I])and(Cmp(Tb,FillDigits(I))) then // Jeżeli to pierwsza to konwertujemy ją na liczniki cyfr i sprawdzamy czy się mieścimy
    begin
      Write(' ',I);
    end;
  end;
end;
0

Fakt, mam bałagan w kodzie, choćby nazwy zmiennych i ich ilość.

Ale czy mógłbyś mi pomóc w tym fragmencie:

    {5) Utworzenie wszystkich możliwych liczb pierwszych}{TO DO}
    //maksymalny indeks tablicy z cyframi
    i := 0;
    j := 0;
    k := 0;
    x := 0;
     
    while i <= Length(RemoveDupl) - 1 do //przynajmniej jednocyfrowa
    begin
    setLength(Results, Length(Results) + 1);
    Results[Length(Results) - 1] := RemoveDupl[i];
    i := i + 1;
    end;
     
    {if (digits>=2) then
    begin
    for j:=0 to digits do
      if i <> j then
      Results[i]:=(RemoveDupl[i]* 10) + RemoveDupl[j];
     
    while (x<digits-2) do //jesli [przynajmniej] trzycyfowa
    begin
    for k:=0 to digits do
      if j <> k then
      Results[j]:=(i * 100 + j * 10 + k);
    x:=x+1;
    end;
    end;} 

Jednoelementowe kombinacje są poprawne, teraz jak to będzie wyglądać dla dwu i wiecej cyfrowych liczb

0
  1. Wywal ten kod
  2. Zrób tablicę Tb:array['0'..'9']of Boolean;
  3. Zrób pętle bezpośrednio po Edit1.Text
  4. W pętle jężeli znak jest cyfrą to ustaw Tb[Edit1.Text[I]]:=true;

1 użytkowników online, w tym zalogowanych: 0, gości: 1