' - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - +
Function NummiX(X1, X2) ' // Index --> Permutation, Anzahl Zeichen: 2..9
xId1& = Trim$(X1) ' // X1: in Permutation umzurechnender Index
xMsk$ = Trim$(X2) ' // X2: Liste der Zeichen der Permutation, aufsteigend sortiert
xNnn& = Len(xMsk$) ' // Anzahl unterschiedlicher Zeichen
' // Prüfen, ob die Länge von X2 in den Grenzen von 2 .. 9 liegt
If xNnn& < 2 Or xNnn& > 9 Then NummiX = "#n=2..9#": Exit Function
' // Prüfen, ob Index X1 in den Grenzen 1 .. n! liegt (n = Anzahl Zeichen laut Länge von X2)
xFak& = Fakultaet(xNnn&)
If xId1& < 1 Or xId1& > xFak& Then NummiX = "#Idx=1.." & xFak& & "#": Exit Function
' // Prüfen, ob in X2 nur Zeichen "ohne Wiederholung" enthalten sind
xPt1& = xNnn&
Do While xPt1& > 1
If InStr(xMsk$, Mid$(xMsk$, xPt1&, 1)) < xPt1& Then NummiX = "#DblChr#": Exit Function
xPt1& = xPt1& - 1
Loop
' // gesuchte Permutation aus dem Index X1 berechnen und in die Zeichen aus X2 wandeln
xLst$ = xMsk$ ' // Liste der zu permutierenden Zeichen
xId0& = xId1& - 1 ' // Zählung des Index ab 1 in Zählung ab 0 ändern
xErg$ = "" ' // ErgebnisVarable löschen
Do While xNnn& > 1
' // Stelle/Zeichen berechnen
xSte$ = Mid$(xLst$, Int(xId0& / Fakultaet(xNnn& - 1)) Mod xNnn& + 1, 1) ' // Stelle/Zeichen berechnen
xErg$ = xErg$ & xSte$ ' // Zeichen dem Ergebnis hinzufügen
xLst$ = Replace(xLst$, xSte$, "") ' // verwendetes Zeichen aus Liste der möglichen Zeichen löschen
xNnn& = xNnn& - 1
Loop
xErg$ = xErg$ & xLst$
NummiX = xErg$
End Function
' - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - +
Function IdxNummiX(X1, X2) ' // Permutation --> Index, Anzahl Zeichen: 2..9
xEin$ = Trim$(X1) ' // X1: in Index umzurechnende Permutation
xMsk$ = Trim$(X2) ' // X2: Liste der permutierten Zeichen, aufsteigend sortiert
xNnn& = Len(xMsk$) ' // Anzahl unterschiedliche Zeichen
' // Prüfen, ob die Länge von X2 in den Grenzen von 2 .. 9 liegt
If xNnn& < 2 Or xNnn& > 9 Then IdxNummiX = "#n=2..9#": Exit Function
' // Prüfen, ob in X2 nur Zeichen "ohne Wiederholung" enthalten sind
xPt1& = xNnn&
Do While xPt1& > 1
If InStr(xMsk$, Mid$(xMsk$, xPt1&, 1)) < xPt1& Then IdxNummiX = "#DblChr#": Exit Function
xPt1& = xPt1& - 1
Loop
' // Prüfen, ob Permutation X1 und Liste X2 der permutierten Zeichen zueinander passen
xLst$ = CReplac(xEin$, xMsk$, "")
xOk& = xNnn& = Len(xEin$) And Len(xLst$) = 0
If Not xOk& Then IdxNummiX = 0: Exit Function ' // Falls nicht korrekt: Abbruch mit RückgabeWert = 0
' // EingangsPermutation X1 in "numerisch" wandeln
xNum$ = ""
For ix& = 1 To xNnn&
xNum$ = xNum$ & InStr(xMsk$, Mid$(xEin$, ix&, 1))
Next ix&
' // Index aus einer in eine Zahl gewandelten Permutation X1 berechnen
xRst$ = xNum$ ' // in Zahl umgewandelte Permutation
xErg& = 1 ' // Vorbesetzung wegen Zählung des Index ab 1 (statt 0)
xSor$ = Left$("123456789", xNnn&) ' // sortierte Liste der Ziffern vorgeben
Do While xNnn& > 1
xAkt$ = Left$(xRst$, 1) ' // aktuelle Stelle isolieren
xErg& = xErg& + Fakultaet(xNnn& - 1) * (InStr(xSor$, xAkt$) - 1) ' // Beitrag auf Index addieren
xSor$ = Replace(xSor$, xAkt$, "") ' // akt. Stelle aus Liste der sortierten RestZiffern löschen
xRst$ = Replace(xRst$, xAkt$, "") ' // akt. Stelle aus Liste der realen RestZiffern löschen
xNnn& = xNnn& - 1
Loop
IdxNummiX = xErg&
End Function
' - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - +
' verwendete Funktionen:
' - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - +
Function Fakultaet(X1)
If X1 < 1 Then Fakultaet = 0: Exit Function
xErg& = 1
For ix& = X1 To 2 Step -1
xErg& = xErg& * ix&
Next ix&
Fakultaet = xErg&
End Function
' - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - +
Function CReplac(X1, X2, X3) ' // ersetzt alle in X2 enthaltenen Zeichen in X1 durch X3
xt$ = X1
xp& = 1
Do While xp& <= Len(xt$)
If InStr(X2, Mid$(xt$, xp&, 1)) Then
xt$ = Left$(xt$, xp& - 1) & X3 & Mid$(xt$, xp& + 1)
xp& = xp& + Len(X3)
Else
xp& = xp& + 1
End If
Loop
CReplac = xt$
End Function
' - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - + - - - - +
Das bestätigt mir, daß man einen Algorithmus formulieren kann. Bestätigt aber auch, daß der Algorithmus nicht so unmittelbar einleuchtend und effizient wie eine Lookup-Tabelle ist. Ich hatte aber ausdrücklich nach einer solchen Lösung gefragt. Vielen Dank für Deine Mühe.
Moin, Harald, gern geschehen.Das bestätigt mir, daß man einen Algorithmus formulieren kann. Bestätigt aber auch, daß der Algorithmus nicht so unmittelbar einleuchtend und effizient wie eine Lookup-Tabelle ist. Ich hatte aber ausdrücklich nach einer solchen Lösung gefragt. Vielen Dank für Deine Mühe.
... und, wie ich mich kenne, in VBA würde ich das Ganze auch wieder mit einem String lösen und dafür eine Replace-Funktion basteln, die so funktioniert, wie das Replace in VBA.
Zu 1.:
Ein abschreckendes Beispiel, programmiert in der Sprache A, zu nehmen und es mit einem sauberen Beispiel, programmiert in der Sprache B, zu vergleichen, das dürfte eigentlich immer dazu führen, dass die ProgrammierSprache A als VizeSieger aus dem Wettbewerb hervorgeht.
Was an VBA oder dem Code von Heinileini findest Du "schlimmer"? Was ist für Dich "schlimm"? Müsstest Du da vielleicht VB generell verteufeln? Ich finde VB und VBA nicht schlecht und als durchaus seriös anwendbare Programmiersprache.
Folge der umszusetzenden Nummern:
Nummern Permutation x = Fehlerstellen
------------------------------------------------------
00 - 00 - 00 1234 - 1234
01 - 01 - 01 1243 - 12xx
------- - --
02 - 02 - 00 1324 - 1xxx
03 - 03 - 01 1342 - 1xxx
-------
04 - 04 - 00 1423 - 1xxx
05 - 05 - 01 1432 - 1xxx
-- - --
06 - 00 2134 - 2134
07 - 01 2143 - 21xx
08 - 02 2314 - 2314
09 - 03 2341 - 2341
10 - 04 2413 - 2xxx
11 - 05 2431 - 2xxx
-- - --
12 - 00 3124 - 3124
13 - 01 3142 - 31xx
14 - 02 3214 - 3214
15 - 03 3241 - 3241
16 - 04 3412 - 3412
17 - 05 3421 - 3421
-- - --
18 - 00 4123 - 4123
19 - 01 4132 - 41xx
20 - 02 4213 - 4213
21 - 03 4231 - 4231
22 - 04 4312 - 4312
23 - 05 4321 - 4321
Die Fehlerstellen entstehen m.E. durch die Problematik der Sortierung der verbleibenden
Ziffern. Aber ob ich genau richtig liege, müsste noch einmal betrachtet werden. Nichtsdesto-
trotz, wollte ich hier gerne meinen Ansatz mitteilen.
@Heinileini: Falls es der gleiche Ansatz ist, bei Deinem fertigen Algorithmus, entschuldige
ich mich hier schon einmal dafür.
Theorie:
Anzahl Stellen: 4 ==> Z
Nummer (0..23) ==> X
Stelle = 4321 ==> abcd
Bei Z! kommen 24 Möglichkeiten vor. Dabei kommt die erste von Z Stellen (Z-1)! oft vor.
Damit lässt sich die 4. Stelle (a) relativ einfach berechnen:
a = (X / (Z-1)!) + 1
Die 3. Stelle müsste die übriggebliebene Anzahl an Möglichkeiten = 6 (0..5) sein (siehe Tabelle oben)
Dazu die Nummer aus den sechs Möglichkeiten berechnen:
(X mod (Z-1)!)
Damit ergibt sich folgende Formel für die zweite Stelle:
b = ((X mod (Z-1)!) / (Z-2)!) + 1
Die 2. Stelle müsste die übriggebliebene Anzahl an Möglichkeiten = 2 (0..1) sein (siehe Tabelle oben)
Dazu die Nummer aus den sechs Möglichkeiten berechnen:
((X mod (Z-1)!) mod (Z-1)!)
Damit ergibt sich folgende Formel für die zweite Stelle:
c = (((X mod (Z-1)!) mod (Z-1)!) / (Z-3)!) + 1
Die 1. Stelle ist einfach die übrig gebliebene Ziffer.
Soviel zur Theorie, aber offensichtlich ergeben sich Fehler, die sich m.E. auf die Sortierung der übrig
gebliebenen Ziffern für die verbleibenden Stellen ergeben.
Also, ich habe dazu Folgendes programmiert:
#Ti_numberDigits := 4;
"DB_TEST".digitsAvailable[0] :=
"DB_TEST".digitsAvailable[1] :=
"DB_TEST".digitsAvailable[2] :=
"DB_TEST".digitsAvailable[3] :=
true;
"DB_TEST".digitsPool[0] := 1;
"DB_TEST".digitsPool[1] := 2;
"DB_TEST".digitsPool[2] := 3;
"DB_TEST".digitsPool[3] := 4;
// +++ Stelle 4 +++
// berechnen
#Ti_result :=
("DB_TEST".position
/ DINT_TO_INT("POOL_fakultaet"(#Ti_numberDigits - 1)))
+ 1;
// ausgeben
"DB_TEST".digits[0] := "DB_TEST".digitsPool[#Ti_result - 1];
"DB_TEST".digitsPool[#Ti_result - 1] := #Ti_result + 4;
"DB_TEST".digitsAvailable[#Ti_result - 1] := false;
// +++ Stelle 3 berechnen +++
//
#Ti_result :=
(
("DB_TEST".position MOD DINT_TO_INT("POOL_fakultaet"(#Ti_numberDigits - 1)))
/ DINT_TO_INT("POOL_fakultaet"(#Ti_numberDigits - 2)))
+ 1;
FOR #i := #Ti_result - 1 TO #Ti_numberDigits - 1 DO
IF
"DB_TEST".digitsAvailable[#i]
THEN
"DB_TEST".digits[1] := #i + 1;
"DB_TEST".digitsAvailable[#i] := false;
EXIT;
END_IF;
END_FOR;
// +++ Stelle 2 berechnen +++
//
#Ti_result :=
(
(
("DB_TEST".position MOD DINT_TO_INT("POOL_fakultaet"(#Ti_numberDigits - 1))) // 1 mod 6 = 1
MOD DINT_TO_INT("POOL_fakultaet"(#Ti_numberDigits - 2))) // 1 mod 2 = 1
/ DINT_TO_INT("POOL_fakultaet"(#Ti_numberDigits - 3))) // 1 / 1 = 1
+ 1;
FOR #i := #Ti_result - 1 TO #Ti_numberDigits - 1 DO
IF
"DB_TEST".digitsAvailable[#i]
THEN
"DB_TEST".digits[2] := #i + 1;
"DB_TEST".digitsAvailable[#i] := false;
EXIT;
END_IF;
END_FOR;
// +++ Stelle 1 ausgeben +++
FOR #i := 0 TO 3 DO
IF
"DB_TEST".digitsAvailable[#i]
THEN
EXIT;
END_IF;
END_FOR;
"DB_TEST".digits[3] := #i + 1;
//-------------------------------------------------------------------------------------------------------------
FUNCTION "POOL_fakultaet" : DInt
{ S7_Optimized_Access := 'TRUE' }
VERSION : 0.1
VAR_INPUT
Ii_val : Int;
END_VAR
VAR_TEMP
Tdi_faktor : DInt;
Tdi_result : DInt;
END_VAR
BEGIN
#Tdi_faktor :=
#Tdi_result :=
INT_TO_DINT(#Ii_val);
WHILE
#Tdi_faktor > 1
DO
#Tdi_result *= (#Tdi_faktor - 1);
#Tdi_faktor -= 1;
END_WHILE;
#POOL_fakultaet := #Tdi_result;
END_FUNCTIONMoin Mario,
weil der Wertevorrat für die jeweils übrigbleibenden Ziffern nicht zusammenhängend ist. Das bekommt man (bzw. ich) schwer in Mathematik formuliert. Die Verwendung von Stringfunktionen (wie Heinileini) erleichtert das etwas.
Genau das war und ist auch mein Problem, wenn es darum geht, den Algorithmus zu formulieren.
Am besten man löst die Aufgabe so, dass das Problem gar nicht involviert ist.
' // kompl. Permutation
For xSpa& = xTot& To 2 Step -1
' // TeilPermutation zu Idx0 und Spalte s
xSol& = Int(xId0& / Fakultaet(xSpa& - 1)) Mod xSpa&
xTmp& = a(xSpa& - 1 - xSol&)
For ix& = xSpa& - 1 - xSol& To xSpa& - 2
a(ix&) = a(ix& + 1)
Next ix&
a(xSpa& - 1) = xTmp&
Next xSpa&Die Eingabe muß man in der SPS noch prüfen, ob jedes Symbol genau einmal vorkommt. Es gibt bestimmt Bediener, die klicken schneller als die Buttons unsichtbar werden
oder ein SPS-Programmierer steuert unkonzentriert direkt die Eingabewerte... Für die Prüfung braucht man mindestens n Operationen (muß jede Position anfassen). Bei der Variante mit der Übertragung des Index kann das nicht vorkommen, und da braucht man nur 2 Vergleiche auf die min/max-Indexgrenzen zur Prüfung.
In #42 habe ich es in VBA so gelöst:
' // Prüfen, ob in X2 nur Zeichen "ohne Wiederholung" enthalten sind
xPt1& = xNnn& ' // xNnn& = len(xMsk$)
Do While xPt1& > 1
If InStr(xMsk$, Mid$(xMsk$, xPt1&, 1)) < xPt1& Then NummiX = "#DblChr#": Exit Function
xPt1& = xPt1& - 1
Loop
FOR #i := 1 TO 4 DO
IF "Aggregat".button_wahl[#i] AND NOT "Aggregat".naechste_gewaehlt[#i] THEN
"Aggregat".naechste_Anzahl_gewaehlt := "Aggregat".naechste_Anzahl_gewaehlt + 1;
"Aggregat".wahl_naechste["Aggregat".naechste_Anzahl_gewaehlt] := #i;
"Aggregat".naechste_gewaehlt[#i] := TRUE;
"Aggregat".button_wahl[#i] := FALSE;
END_IF;
END_FOR;
IF "Aggregat".button_akzept THEN
"Aggregat".wahl_aktiv := "Aggregat".wahl_naechste;
END_IF;
IF "Aggregat".button_reset OR "Aggregat".button_Akzept THEN
FOR #i := 1 TO 4 DO
"Aggregat".naechste_gewaehlt[#i] := FALSE;
"Aggregat".wahl_naechste[#i] := 0;
END_FOR;
"Aggregat".naechste_Anzahl_gewaehlt := 0;
END_IF;
"Aggregat".button_reset := FALSE;
"Aggregat".button_akzept := FALSE;