Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - EneDueRabe

Waldek · Wysłany: 27-03-2025, 17:40 **EneDueRabe**

Pamiętacie odliczanki: ene due rabe..., albo raz, dwa trzy szukasz ty? Za pomocą VBA zrobiłem taką odliczankę, taką, że odliczane są osoby, aż zostaje jedna. Wpisuje się ilość osób n i ilość sylab odliczanki k, wynikiem jest numer osoby (komórka A1). Jest to procedura Sub korzystająca z komórek w kolumnie A, ale pewnie da się zrobić Function bez korzystania z pomocniczych komórek arkusza. Zgłębiłem nieco temat bo szukałem gotowego wzoru matematycznego (tzw. wzoru jawnego). Niestety takiego wzoru ogólnego nie ma, co mnie zaskoczyło bo schemat odliczania jest przewidywalny. Jest to tzw. "Problem Flawiusza" nie rozwiązany do dziś, przez ponad 400 lat.

P.S.
Zamieniłem załącznik na taki z poprawionym kodem.

EneDueRabe.xlsm

Pobierz Plik ściągnięto 12 raz(y) 20.66 KB

hurgadion · Wysłany: 27-03-2025, 19:03

Hej,
wydaje mi się, że masz gdzieś błąd, ale nie jestem pewien, jednak za pomocą zależności rekurencyjnej wynalezionej na wikipedii otrzymuję nieco inne wyniki. Funkcja Flawiusz ma następującą postać rekurencyjną:

Kod:

Function Flawiusz(n As Double, k As Double) As Double

If n = 1 Then
Flawiusz = 1
Else
Flawiusz = ((Flawiusz(n - 1, k) + k - 1) Mod n) + 1
End If
End Function

W załączniku jest działający kod porównujący Twoje wyniki i wyniki rekurencyjnej zależności. Przetestowałem na kartce papieru parę przykładów i wydaje mi się, że otrzymuję dobre wyniki, pozdrawiam :lol:

EneDueRabe.sol.xlsm

Pobierz Plik ściągnięto 10 raz(y) 27.73 KB

Maciej Gonet · Wysłany: 27-03-2025, 19:06

W Wikipedii jest podany algorytm rekurencyjny rozwiązania, który można łatwo zapisać w VBA:

Kod:

Function Flawiusz(n As Long, k As Long) As Long
If n = 1 Then
Flawiusz = 1
Else
Flawiusz = ((Flawiusz(n - 1, k) + k - 1) Mod n) + 1
End If
End Function

Nie testowałem go szczegółowo, ale wygląda, że działa poprawnie.
Natomiast Twoja procedura daje inny wynik, wg mnie błędny.
Testowałem tylko ten przykład, który podałeś tzn. n=8, k=3.
Po kolei eliminowane są pozycje: 3, 6, 1, 5, 2, 8. W tym momencie zostaje 4 i 7, więc odliczamy: 4, 7, 4, eliminujemy 4 i zostaje 7. Tak też wychodzi wg Wikipedii, natomiast Twój kod pod koniec najpierw eliminuje 7 i zostawia 4. Nie wgłębiałem się już, na czym ten błąd polega, Ty na pewno szybciej dojdziesz, bo znasz lepiej swój algorytm.

Edit: Widzę, że z kol. hurgadionem doszliśmy do podobnych wniosków, tylko kolega szybciej pisał. :-D

Waldek · Wysłany: 27-03-2025, 23:00

Dziękuję za sprostowanie i kod rekurencyjny. Nie spodziewałem się, że można zrobić to tak prostym kodem rekurencyjnym. Poprawiłem swoją procedurę i chyba dobrze oblicza.

Kod:

Sub EneDueRabe()
Dim n As Long
Dim k As Long
Dim i As Long
Dim p As Long

n = InputBox("Wprowadź ilość osób n", "Ilość osób n", 8)
k = InputBox("Wprowadź długość odliczania k", "Odliczanie k", 3)
p = 0

For i = 1 To n
Cells(i, 1) = i
Next i

For i = 1 To n + 1
If Cells(2, 1) = 0 Then
Exit For
Else
If Cells(i, 1) = 0 Then
i = 0
Else
p = p + 1
If p = k Then
p = 0
Cells(i, 1).Delete Shift:=xlUp
i = i - 1
End If
End If
End If
Next i
End Sub

Wymieniłem plik z pierwszego postu.

hurgadion · Wysłany: 28-03-2025, 09:30

Przetestowałem Waldek Twój algorytm na paru przykładach i wygląda na to, że liczy dobrze. Ta funkcja Flawiusz nie będzie działać w VBA przy większej ilości wywołań rekurencyjnych. Wykrzacza się np. już na danych n=5000, k=3. Twój algorytm, w tym przypadku, liczy trochę długo, ale chyba dobrze, pozdrawiam :lol:

Waldek · Wysłany: 28-03-2025, 11:09

Kod nie jest optymalny, odwołuje się do komórek arkusza, wykonuje na nich operacje, ale się nie zawiesza dla n=5000 i k=3. Dla k=3 (n jest w komórce H2) można zastosować formułę:

Kod:

=3*H2+1-ZAOKR.DÓŁ(1,62227050288477*(3/2)^ZAOKR.GÓRA(LOG((2*H2+1)/1,62227050288477;3/2);0);0)

Stała 1,62227050288477 w dokładniejszej wersji wynosi: 1,62227 05028 84767 31595 69509 82899 3241
Wzór zaczerpnięty z artykułu: FUNCTIONAL ITERATION AND THE JOSEPHUS PROBLEM by ANDREW M. ODLYZKO and HERBERT S. WILF (Received 27 February, 1990)

Maciej Gonet · Wysłany: 28-03-2025, 12:44

To jeszcze do kompletu iteracyjna wersja funkcji z użyciem kolekcji.

Kod:

Function FlawiuszIt(n As Long, k As Long) As Long
Dim i As Long
Dim flcoll As Collection
Set flcoll = New Collection
For i = 1 To n
flcoll.Add i
Next i

i = 1
Do
i = (i - 1 + k) Mod flcoll.Count
If i = 0 Then i = flcoll.Count
flcoll.Remove i
Loop Until flcoll.Count = 1
FlawiuszIt = flcoll(1)
Set flcoll = Nothing
End Function

Tu już nie będzie problemu z przepełnieniem stosu, natomiast dla dużych n obliczenia trwają dość długo, u mnie dla n=100 000 liczył kilkadziesiąt sekund.

Waldek · Wysłany: 29-03-2025, 08:21

Z użyciem kolekcji funkcja całkiem wydajna. Na dzień dzisiejszy zwykłą formułą bez iteracji da się obliczyć dla k=2 i k=3.