[Wina_Segmentacji]

Ciekawe jak to jest wobec liczb pierwszych, których suma cyfr tworzących jest liczbą pierwszą.

Napisałem funkcję, która to wizualizuje.

Oto wynik dla pierwszego 1000 liczb pierwszych, pośród, których suma cyfr tworzących 501 owych liczbą pierwszą.

Pierwszy wiersz to liczba pierwsza a poniżej każda sumująca się dla danej liczby, posortowane rosnąco.

Teoretycznie, jeżeli brak popełnionych błędów gdziekolwiek.

#matematyka

[TheUlisses]

@Wina_Segmentacji: weź większy zakres liczb. Np. ciekawie wyglada, że żadna liczba nie chce się sumować do 3.

[tyrytyty]

@TheUlisses: czy to na pewno zaskakujące? ( ͡° ͜ʖ ͡°)

[Wina_Segmentacji]

Tutaj kod jak coś:

PrimeList[n] := Map[Prime, Range[1, n]]

SumDigits[n] := Total[IntegerDigits[n]]

PrimeStructure[n] := {PrimeQ[SumDigits[Prime[n]]], SumDigits[Prime[n]], Prime[n]}

PrimeFirstDepth[n] := Map[DeleteDuplicates[Flatten[#]] &, GroupBy[Map[Drop[#, 1] &, Select[Map[PrimeStructure, Range[1, n]], First]], First]]

PrimeDepth[n_] := Map[{#, PrimeFirstDepth[n][#]} &, Keys[PrimeFirstDepth[n]]] PrimeDepth[100] Length[Flatten[Values[PrimeFirstDepth[1000]]]]

TableForm[PrimeDepth[1000], TableDirections -> Row, TableAlignments -> {Left, Top}]

[Wina_Segmentacji]

@TheUlisses @tyrytyty Dla pierwszego 1 000 000, 372 199 sumują cyfry tworzące liczbą pierwszą

[TheUlisses]

@Wina_Segmentacji: Sobie na szybko w Mathematice chciałem policzyć podobne rzeczy.

[Wina_Segmentacji]

@TheUlisses Fajen napisane

[Wina_Segmentacji]

@TheUlisses Dla pierwszgo miliona również 3 jedyna jak coś

[Wina_Segmentacji]

Poprawiłem błąd pierwszej liczby kolumną. Suma dla 1000 sumuje 494

[Wina_Segmentacji]

Uaktualniony kod

PrimeList[n] := Map[Prime, Range[1, n]]

SumDigits[n] := Total[IntegerDigits[n]]

PrimeStructure[n] := {PrimeQ[SumDigits[Prime[n]]], SumDigits[Prime[n]], Prime[n]}

PrimeFirstDepth[n] := Map[Flatten,Map[Map[Drop[#,1]&,#] &, GroupBy[Map[Drop[#, 1] &, Select[Map[PrimeStructure, Range[1, n]], First]], First]]]

PrimeDepthLength[n] := Map[{#, Length[PrimeFirstDepth[n][#]]} &, Keys[PrimeFirstDepth[n]]]

TableForm[PrimeDepthLength[100],TableDirections->Row, TableAlignments->{Left,Top}]

PrimeDepth[n] := Map[{#, PrimeFirstDepth[n][#]} &, Keys[PrimeFirstDepth[n]]] PrimeDepth[100] Length[Flatten[Values[PrimeFirstDepth[1000]]]]

TableForm[PrimeDepth[100], TableDirections -> Row, TableAlignments -> {Left, Top}]

[Wina_Segmentacji]

@TheUlisses Fajen napisałeś. Przekształciłem trochę jeszcze linijkę kodu, którą napisałeś. Oblicza całość zamiast poprzednigo wielolinijlowego kodu dodatkowo wydajniej. Dla 2 000 000

[Wina_Segmentacji]

@TheUlisses Tak mniej więcej przekształciłem wersję, którą napisałeś
GroupBy[Select[Total@IntegerDigits[Prime[#]]->Prime[#]&/@Range[100],PrimeQ[First[#]]&],First->Last]

[TheUlisses]

@Wina_Segmentacji: Super to końcowo to Tobie wyszło. Dzięki za poprawkę z PrimeQ, bo rzeczywiście sumowało do dowolnej liczby a nie tylko pierwszych. No i piękne pogrupowanie, gdzie też się zacząłem zastanawiać jak to zrobić. Pewnie się przyda w przyszłości. Swoją drogą to tag Mathematica leży martwy, a to taki kombajn, że bajka :-)

#mathematica