Je lirai avec plaisir votre façon de résoudre la récréation mathématique ci-dessous en VBA
Le problème de Flavius Joséphus
En 67 l'historien hébreu Flavius Josèphe et quarante de ses compatriotes étaient cernés par les Romains dans une grotte de la ville de Jotapata. Ils décidèrent de ne pas se rendre et de se suicider.
Pour préserver sa vie ainsi que celle d'un de ses amis, Flavius Josèphe demanda que les suicides soient successifs.
La méthode utilisée n'est pas précisée, Bachet suggère que c'est en comptant de trois en trois qu'ils s'éliminèrent, sauf évidemment les deux derniers.
Il existe également des sites avec des applets java.
Pour le côte challenge : des collègues anglophones ont "pondu" quelques solutions (que je répertorie une à une)
• une fonction vba personnalisée (fonctionnelle)
• une autre d'une seule ligne (que je n'arrive pas à faire fonctionner)
• et une macro (utilisant une feuille)
J'espère que vous ferez aussi bien et aussi intéressant qu'eux.
PS: je vous livrerai leurs œuvres d'ici quelque temps.
Re : [Maths] Challenge - trouver algorithme à propos du cercle de Josephus Flavius
Bonjour Staple1600
Code:
[COLOR="DarkSlateGray"][B]Function Flavius(n As Integer, m As Integer, Optional k As Integer = 2) As String
Dim Coll As New Collection
Application.Volatile
If n > 1 And m > 0 Then
Do
Coll.Add Coll.Count + 1
Loop While Coll.Count < n
Do While Coll.Count > 2
k = 1 + (k + m - 2) Mod Coll.Count
Coll.Remove k
Loop
Flavius = Coll(1) & ", " & Coll(2)
End If
End Function[/B][/COLOR]
Re : [Maths] Challenge - trouver algorithme à propos du cercle de Josephus Flavius
Bonjour Roger, Staple
@Roger
J'ai essayé ta fonction avec 20 et 3, elle donne 1 et 14.
Or, en faisant fonctionner à la main elle doit donner 13 et 20.
Il y a un décalage de 1 donc.
Mais c'est le problème qui est flou, car tu compte 3 et tu tue le 4e, et moi le 3e
voir ce lien 6 Le suicide des zélotes et la solution qui donne pour 100 et 3 le 58 et le 91, ta fonction donne 59 et 92.
Sinon, bravo pour ton programme. Je n'y comprend rien, c'est donc excellent.
@Staple
Voir ma PJ. J'y ai inclus la fonction de Roger pour comparer les résultats.
Re : [Maths] Challenge - trouver algorithme à propos du cercle de Josephus Flavius
Re...
On peut évidemment changer de problème. La réponse sera différente. Dans la référence donnée par Staple1600 (Flavius Josèphe), vous verrez que la réponse pour 20 et 3 est 1, 14. Essayez d'autres valeurs, et vous verrez que les résultats sont conformes à ceux que je propose. Il est donc clair que, dans le problème posé par Staple1600, les victimes sont désignées de trois en trois à partir de la deuxième position. C'est à ce problème que je réponds. Mais je me doutais que votre objection arriverait tôt ou tard : la fonction comporte donc un troisième paramètre qui est la position d'origine du comptage. Ce paramètre est optionnel, fixé à 2 par défaut pour répondre au problème posé.
Dans votre problème, vous décidez d'éliminer les victimes de trois en trois en les désignant à partir de la première position. C'est un autre problème que vous résoudrez en fixant à 1 le paramètre optionnel.
Utilisez
Re : [Maths] Challenge - trouver algorithme à propos du cercle de Josephus Flavius
Bonjour à tous
Merci de votre implication.
Dans les exemples que j'ai glané sur le net, certains ne cherchent la place que pour un seul survivant, d'autres pour deux.
Je vous livre la fonction que j'arrive pas à faire fonctionner
(elle doit être récursive si j'ai bien compris)
Code:
Public Function Murderize(ByVal SoldiersInCircle As Integer, ByVal KillEveryXth As Integer) As Integer
'auteur du code : Kyle : source : The Daily WTF
Murderize = IIf(SoldiersInCircle = 1, 0, (Murderize(SoldiersInCircle - 1, KillEveryXth) + KillEveryXth) Mod SoldiersInCircle)
End Function
Code:
Sub test()
MsgBox Murderize(41, 3)
End Sub
PS: le code original était rédigé ainsi (ce n'est donc pas du VBA non ?)
Code:
Public Function Murderize(ByVal SoldiersInCircle As Integer, ByVal KillEveryXth As Integer) As Integer
Return IIf(SoldiersInCircle = 1, 0, (Murderize(SoldiersInCircle - 1, KillEveryXth) + KillEveryXth) Mod SoldiersInCircle)
End Function
Re : [Maths] Challenge - trouver algorithme à propos du cercle de Josephus Flavius
Re
Pour compléter ma précédente réponse:
Voilà ce qui semble être la meilleure voie pour solutionner le problème:
The easiest way to solve this problem in the general case is to use dynamic programming. This approach gives us the recurrence:
which is evident when considering how the survivor number changes when switching from n − 1 to n. This approach has running timeO(n), but for small k and large n there is another approach. The second approach also uses dynamic programming but has running time O(klogn). It is based on considering killing k-th, 2k-th, ...,
-th people as one step, then changing the numbering.
Dans les exemples que j'ai glané sur le net, certains ne cherchent la place que pour un seul survivant, d'autres pour deux.
Je vous livre la fonction que j'arrive pas à faire fonctionner
(elle doit être récursive si j'ai bien compris)
Code:
Public Function Murderize(ByVal SoldiersInCircle As Integer, ByVal KillEveryXth As Integer) As Integer
'auteur du code : Kyle : source : The Daily WTF
Murderize = IIf(SoldiersInCircle = 1, 0, (Murderize(SoldiersInCircle - 1, KillEveryXth) + KillEveryXth) Mod SoldiersInCircle)
End Function
Code:
Sub test()
MsgBox Murderize(41, 3)
End Sub
PS: le code original était rédigé ainsi (ce n'est donc pas du VBA non ?)
Code:
Public Function Murderize(ByVal SoldiersInCircle As Integer, ByVal KillEveryXth As Integer) As Integer
Return IIf(SoldiersInCircle = 1, 0, (Murderize(SoldiersInCircle - 1, KillEveryXth) + KillEveryXth) Mod SoldiersInCircle)
End Function
J'arrive a faire fonctionner ta fonction en mettant le < pour qu'il s'arrete par contre je n'ai pas encore pris le temps de poser la récurence donc je pense pas tomber juste.
Code:
Sub test()
MsgBox Murderize(8, 3)
End Sub
Public Function Murderize(ByVal SoldiersInCircle As Integer, ByVal KillEveryXth As Integer) As Integer
'auteur du code : Kyle : source : The Daily WTF
If SoldiersInCircle <= 1 Then
Murderize = 0
Else
Murderize = (Murderize(SoldiersInCircle - 1, KillEveryXth) + KillEveryXth) Mod SoldiersInCircle
End If
End Function
J'avais entendu ce petit jeu y a quelque temps, c est tjs marrant de voir les différentes approches!
Re : [Maths] Challenge - trouver algorithme à propos du cercle de Josephus Flavius
Bonsoir à tous
Je viens de jeter un oeil sur la fonction attribuée à Mr Kyle. J'espère qu'il ne l'a pas écrite comme la cite Staple1600 :
Code:
[COLOR="DarkSlateGray"]Public Function Murderize(ByVal SoldiersInCircle As Integer, ByVal KillEveryXth As Integer) As Integer
'auteur du code : Kyle : source : The Daily WTF
Murderize = IIf(SoldiersInCircle = 1, 0, (Murderize(SoldiersInCircle - 1, KillEveryXth) + KillEveryXth) Mod SoldiersInCircle)
End Function[/COLOR]
Pas la peine d'en jeter deux pour voir que cette fonction n'a AUCUNE CHANCE DE DONNER UN RÉSULTAT. C'est une fonction récursive sans point d'arrêt. Son seul effet peut être un dépassement de capacité soit de la mémoire, soit, peut-être, de la pile d'appel de VisualBasic.
En effet, quel que soit le résultat du test SoldiersInCircle = 1 dans la structure IIf, les deux expressions suivantes sont évaluées. Pas de problème pour le zéro, mais pour l'expression suivante gros problème : elle contient un appel à la fonction Murderize. Cet appel est immédiatement effectué. Par conséquent, nouvelle évaluation de la structure Iif qui provoque un nouvel appel de la fonction. Cercle vicieux : la fonction est indéfiniment appelée sans que le résultat test sur la valeur de SoldiersInCircle soit jamais pris en considération. Cette pauvre fonction est donc condamnée à se mordre la queue jusqu'à la fin des temps, à moins que la machine s'avoue vaincue avant ce terme.
Par conséquent, le principe de calcul étant parfaitement correct, il faut écrire :
Code:
[COLOR="DarkSlateGray"][B]Public Function Mortderire(ByVal SoldiersInCircle As Integer, ByVal KillEveryXth As Integer) As Integer
If SoldiersInCircle = 1 Then
Mortderire = 0
Else
Mortderire= (Mortderire(SoldiersInCircle - 1, KillEveryXth) + KillEveryXth) Mod SoldiersInCircle
End If
End Function[/B][/COLOR]
(Ça peut aussi s'écrire en une ligne si on n'a pas le souci de la lisibilité.)
_
Ainsi, le test est d'abord effectué, puis, en fonction de son résultat une seule des deux clauses Then ou Else est exécutée. On a alors une chance de voir la fonction aboutir. Une chance seulement car le paramètre SoldiersInCircle est déclaré comme entier, mais on ne s'assure jamais qu'il est supérieur ou égal 1. Si par malheur SoldiersInCircle est négatif ou nul (la faute de frappe, ça existe...), le test If SoldiersInCircle = 1 renverra toujours FAUX, ce qui entraînera un appel éternel à une nouvelle instance de la fonction.
Conclusion : cette fonction est théoriquement valable. Son exploitation pratique est délicate.
Dernière remarque : La fonction donne le dernier survivant comme ma fonction avec 0 (zéro) comme troisième paramètre, ce qui fait qu'elle ne répond pas à l'énoncé du problème initial (je veux dire qu'elle n'est pas conforme aux résultats de la page liée au premier message).
Une particularité : si, comme on l'avait généralement admis au cours de cette discussion, les malheureux compagnons de Flavius sont numérotés de 1 à n, la fonction rectifiée de Mr Kyle renvoie 0 (zéro) au lieu de n. Mais ça, ce n'est pas grave. Il suffit de se mettre d'accord sur les conventions.
Re : [Maths] Challenge - trouver algorithme à propos du cercle de Josephus Flavius
Suite...
Lors de la rédaction du message précédent, j'en étais resté au message #5avant qu'il soit modifié. Maintenant que ce message est complété, je comprends mieux : le code initialement proposé n'est pas exactement celui de Mr Kyle : ce qu'il propose n'est pas en langage VisualBasic. Mais, au fait, en quoi-t-est-ce ?
Par ailleurs, je n'ai pas encore regardé les contributions suivantes. J'ai seulement vu que la transcription de suistrop (le test <=1 au lieu de =1) règle le problème d'une éventuelle donnée négative ou nulle. Je vais regarder les autres contributions...
Re : [Maths] Challenge - trouver algorithme à propos du cercle de Josephus Flavius
Re
Merci Roger de toutes ces explications
En cherchant toujours et encore, voici pour vous les amis
(en formule )
Dès que j'aurais refait le classeur selon les explications du pdf, je le poste car mon Excel vient de planter
EDITION: je ne comprends pas , j'inscris les formules indiquées mais je ne trouve pas la même chose que dans le document
Re : [Maths] Challenge - trouver algorithme à propos du cercle de Josephus Flavius
Bonjour amis matheux,
@ROGER2327
Ce n'était pas une critique, loin de moi, mais une remarque sur la règle.
Mon programme date de 2007, pas fait gaffe.
Comme je t'ai écrit, ton programme est du haut vol, et je suis largué.
PS : Il faudrait tutoyer, comme proposé dans la charte. A moins que tu aies voulu un pluriel.
@Gruick
Ca t'apprendra à lire les sujets en totalité, imbécile...
@ya_v_ka
Un grand coucou (suisse évidemment), le souvenir de la rencontre Rennaise est encore chaud (colat...).
@Staple1600
Tu vois, fallait insister pour voir les "cerveaux" affluer.
Je peaufine les dominos, et je te poste.
Tu m'as fait sortir ma collection de Science & Vie, attends-toi au pire...
Re : [Maths] Challenge - trouver algorithme à propos du cercle de Josephus Flavius
Bonjour a tous
J'arrive un peu tard
Voici ce que je propose en attendant de reprendre le fil depuis l'origine
Code:
Function Flavius2(soldats As Integer, intervalle As Integer, Optional debut As Integer = 2) As String
For n = 1 To soldats
cercle = cercle & Format(n, "000") & ","
Next n
posel = (debut + intervalle - 2) * 4 + 1
el = Mid(cercle, posel, 4)
While Len(cercle) > 8
cercle = Replace(cercle, el, "")
If posel + (intervalle - 1) * 4 > Len(cercle) Then
posel = posel + (intervalle - 1) * 4 - Len(cercle)
Else
posel = posel + (intervalle - 1) * 4
End If
el = Mid(cercle, posel, 4)
Wend
Flavius2 = CInt(Split(cercle, ",")(0)) & "," & CInt(Split(cercle, ",")(1))
End Function
Bien entendu cela vole un peu moins haut que les recursives et le nombre de soldats est limité a 999 mais je crois que les resultats sont bons (vérifiés avec la superbe fonction de ROGER)