BlitzQuiz - AUFLÖSUNG: Geheime Bild-Botschaften

Übersicht Sonstiges Projekte

Gehe zu Seite Zurück  1, 2, 3, 4, 5

Neue Antwort erstellen

Joel

 BeitragMo, Mai 28, 2012 11:15
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich kann mich denen mit der Quersumme von 88 anschließen....
wie blöd das ich erst nach einer halben Stunde Rechnen meines Computers auf die richtige Idee kam... Rolling Eyes

Addi

 BeitragMo, Mai 28, 2012 12:13
Antworten mit Zitat
Benutzer-Profile anzeigen
Kann mir vlt. jemand ein Tipp geben ich komm gerade nicht drauf Laughing.

Habe auch schon versucht irgendwie mit dem Rest zu arbeiten geht aber nicht.
BP/B3D/BMax : Lerne Java : Früher mal Lite-C : Gewinner BCC 62

BlitzMoritz

Betreff: Auflösung Teiler-Rest-Rätsel

 BeitragSa, Jun 02, 2012 10:51
Antworten mit Zitat
Benutzer-Profile anzeigen
Gesucht wurde die Zahl

219060189739591198

Hinführung:
Wenn man sich die ersten Ergebnisse auflisten lässt, also etwa mit den Obergrenzen 4 bis 18, beispielsweise mit diesem (noch nicht optimalen) Algorithmus: BlitzMax: [AUSKLAPPEN] 
SuperStrict

For Local limit% = 4 To 18
	Print "Von 3 bis " + limit + " = " + TeilerRestRaetsel(limit)
Next

Function TeilerRestRaetsel:Long(arg:Int)
	
	Local depth% = arg-2
	Local i:Int[depth]
	
	i[0] = 3
	Repeat
	
		Local solution_found@ = True
		
		For Local d% = 1 Until depth

			Local test_Float:Float = Float((d+2) * i[d-1] - 1) / (d+3)
			i[d] = Int(test_Float)
			If test_Float - Float(i[d]) <> 0 Then
				solution_found = False
				Exit
			End If
		Next
		
		If solution_found = True Then Return 3*i[0]+1
	
		i[0] = i[0] + 4

	Forever
End Function
dann sollte man an den aufgelisteten Lösungen mehrere Auffälligkeiten beobachtet haben:
1.) Am Anfang scheint das Ergebnis jedesmal um zwei kleiner zu sein als das Produkt der Zahlen, also 10 = 3*4 - 2 und 58 = 3*4*5 - 2
Die Angelegenheit hat also vielleicht etwas damit zu tun, dass die Zahlen von der 3 bis zur Obergrenze miteinander multipliziert werden müssen ... ?

2.) Es kommen mitunter für mehrere Obergrenzen gleiche Ergebnisse heraus.
Schaut man genauer hin, dann ändert sich das Ergebnis immer dann, wenn die nächste Obergrenze eine Primzahl ist oder einen zusätzlichen Primfaktor enthält, der bei den Vorgängerzahlen noch nicht vorhanden war.
Die Sache scheint also auch etwas mit Primfaktorzerlegung zu tun zu haben.

Nimmt man beide Beobachtungen zusammen, so wird klar, dass es sich um nichts anderes als das kleinste gemeinsame Vielfache (kgV) der Zahlen 3 bis zur Obergrenze handelt, von der man jeweils 2 abzieht.
Mathematisch lässt sich das so beweisen:

Gesucht sei die Lösung für die Zahlen 3 bis n und sei i gegeben mit 3 <= i <= n
In seiner Eigenschaft als kleinstes gemeinsames Vielfaches gilt dann, dass kgV(3, ... , n) durch i teilbar ist und keinen Rest hat.
Dann ist aber auch kgV(3, ... , n) - i durch i teilbar ohne Rest. Es soll jedoch der Rest (i-2) übrigbleiben. Addieren wir ihn dazu und erhalten
kgV(3, ... , n) - i + (i-2) = kgV(3, ... , n) - 2

Der obige erste Algorithmus ist für Obergrenzen jenseits der 20 oder gar 30 nicht zu gebrauchen, da er viel zu lang dauern würde. Wer dies testen will, beachte bitte, dass vorher Int durch Long und Float durch Double ausgetauscht werden müsste. Mit der jüngst gewonnen Erkenntnis geht es jedoch nur noch darum, einen Code zu schreiben, der den kgV berechnet:BlitzMax: [AUSKLAPPEN] 
SuperStrict

Print "Von 3 bis 42 = " + (getKGV_from_to(3,42)-2)

Function getKGV_from_to:Long(start_n%, last_n%)
	If last_n < start_n Then Return 0
	Local newKGV:Long = Long(last_n)
	Local n% = last_n - 1
	Repeat
		Local tempKGV:Long = newKGV
		Local temp_n% = n
		While temp_n Mod 2 = 0
			temp_n:/2
			If tempKGV Mod 2 = 0 Then
				tempKGV:/2
			Else
				newKGV:*2
			End If
		Wend
		Local div:Long = 3
		While div =< temp_n
			While temp_n Mod div = 0
				temp_n:/div
				If tempKGV Mod div = 0 Then
					tempKGV:/div
				Else
					newKGV:*div
				End If
			Wend
			div:+2		
		Wend	
		n:-1	
	Until n < start_n
	Return newKGV
End Function


HC bat mich um die zeitgerechte Veröffentlichung seines Beitrags, die nun folgen soll:
'________________________________________________________________________________

user posted image Holzchopf:
BlitzMax: [AUSKLAPPEN] 
SuperStrict
Rem
Mathematisch gesehen ist die Lösung des Problems ganz einfach:

Wir suchen eine Zahl, deren Teilerrest zu bestimmten Divisoren eine vorgegebene Zahl ergibt.
Klingt kompliziert?
Nun denn, nehmen wir mal an, die vorgegebene Zahl sei immer 0. Dann suchen wir also eine Zahl,
die, dividiert durch jede Zahl von 3 bis 42, genau einen Rest von 0 ergibt, d.h: durch jede Zahl
von 3 bis 42 teilbar ist.
Also: Was suchen wir? 
Genau, wir suchen die Zahl 3 x 4 x 5 x 6 x ... x 41 x 42
"Das Resultat stimmt, aber das gibt doch eine riesige Zahl?!"
Richtig. Und wenn wir die Aufgabenstellung genau lesen, sehen wir auch, dass wir die kleinste
der Zahlen, die dieses Kriterium erfüllen, suchen.
Welches Stichwort kommt uns da in den Sinn?
"kleinstes gemeinsames Vielfaches!"
Riiichtich!
Das kleinste gemeinsame Vielfache aller Zahlen von 3 bis 42 ist
219060189739591200 (mal so eben fix ausgerechnet).
"Aber wir suchen doch nicht die Zahl, die durch all diese Zahlen teilbar ist, sondern immer
einen Rest von 1, 2, 3 u.s.w. bis 40 ergibt?"
Auch wieder wahr. Aber unser bisheriges Resultat ist schon mal gar nicht so verkehrt. Denn
hinter den Teiler-Resten, die wir anstreben müssen, steckt eine gewisse Arithmetik: Der
gesuchte Rest ist nämlich immer (Teiler -2).
"Und das hilft uns jetzt weiter?"
Natürlich!
Beispiel: Nehmen wir mal die Zahl 60 -- kgV von 3, 4 und 5. Jetzt ziehen wir von 60 2 ab, gibt
58. Und jetzt passt auf, ihr solltet bald ein Muster erkennen:
58 / 3 = 19, Rest 1
58 / 4 = 14, Rest 2
58 / 5 = 11, Rest 3
Seht ihr das Muster?
"19, 14, 11 - das ist doch kein Muster?" Nein! Schau dir den Teiler-Rest an!
"Ahhh! 1, 2, 3. Das ist ja mal interessant!"
Interessant vielleicht, aber durchaus keine neue Entdeckung. Besonders in der Public Key Crypto-
graphy wird dieses Phänomen angewendet, da sucht man immer wieder gerne Zahlen, die bei unter-
schiedlichen Divisoren den selben Rest ergeben - nur, dass die ursprüngliche Zahl das Vielfache
zwei immens grosser Primzahlen ist, so, dass kein Computer mal so eben mir nix dir nix den
öffentlichen Schlüssel faktorisieren kann und so an die privaten Schlüssel kommt.
"Welches Phänomen?"
Ich kenne den genauen Wortlaut nicht mehr, aber das, was mir beigebracht wurde, muss in etwa
so geklungen haben:
"Zieht man von einer Zahl m, die ein Vielfaches einer Zahl p grösser 1 ist, einen
Wert q, der kleiner als p ist, ab, so ergibt die Teiler-Rest-Division (Modulo) p-q."
AHA!
Und was suchen wir?
GENAU! Wir suchen Teilerreste p-q mit p=[3, 42] und q=2
Wenden wir obige Aussagen an, heisst das, dass die Zahl, die wir suchen, nichts anderes als
das kgV aller Zahlen von 3 bis 42 minus 2 suchen.
"Das gäbe dann: 219060189739591198"
Richtige Antwort!
End Rem

Local value:Long = 1
Local timeStart:Int = MilliSecs()
' kgV aller Zahlen von 3 bis 42 ausrechnen
For Local i:Long = 3 To 42
	value = LCM(value, i)
Next
' zwei abziehen
value :- 2
Local time:Int = MilliSecs() -timeStart
' Resultat. Aus. Fertig. Schluss. Keine Widerrede!
Print
Print "Wir suchen die Zahl "+value
Print "("+time+"ms)"
Print

Rem
Ok, zugegeben, dass war jetzt nicht sonderlich spektakulär. Deshalb zeige ich hier noch eine
Variante, wie die Lösung in einem iterativen Prozess gefunden werden kann.
End Rem

' der Startwert 1 wird gesetzt
value = 1
' zu Beginn ist das Inkrement auch 1
Local inc:Long = 1
' und die höchste gefundene Zahl, deren Teiler-Rest auch ins Schema passt, noch 0
Local highest:Int = 0
' rein interessehalber zählen wir die Durchgänge
Local run:Int

' hier legen wir noch fest, wie genau wir über den Prozess informiert werden möchten
Const MODE_FAST:Int			= $00
Const MODE_FASTPRINT:Int		= $01
Const MODE_SLOWMOTION:Int	= $02

Const RUN_MODE:Int = MODE_FASTPRINT

Print "Iterativer Prozess"
Print
' nun startet der iterative Prozess
timeStart = MilliSecs()
Repeat
	run :+ 1
	' wenn nötig: Ausgabe
	If RUN_MODE = MODE_SLOWMOTION Or RUN_MODE = MODE_FASTPRINT
		Print 
		Print "Durchlauf "+run
		Print "Wert ist "+value
	EndIf
	' wir prüfen den Rest zu den Teilern von 3 bis 42
	For Local test:Int = 3 To 42
		Local m:Long = value Mod test
		If RUN_MODE = MODE_SLOWMOTION Or RUN_MODE = MODE_FASTPRINT
			Print "geteilt durch "+test+" gibt Rest "+m
		EndIf
		' Rest passt in die Arithmetik
		If m = (test -2)
			' oha! wir haben's bis zur 42 geschafft, das heisst, dass alle
			' Kriterien erfüllt wurden. Wir sind am Ziel!
			If test=42
				time = MilliSecs() -timeStart
				Print "Die gesuchte Zahl ist "+value
				Print "Deren Quersumme ist "+DigitSum(value)
				Print "Gefunden nach "+run+" Durchläufen"
				Print "in "+time+" Millisekunden."
				End
			' noch nicht am Ende, aber weiter als zuvor!
			' darum speichern wir den Erfolg und schreiten fort in weiten Schritten!
			ElseIf test > highest
				highest = test
				Local oldinc:Long = inc
				' das Inkrement wird also erhöht und ist neu kgV vom alten
				' Inkrement und der erfolgreich getesteten Zahl
				inc = LCM(inc, test)
				If RUN_MODE = MODE_SLOWMOTION Or RUN_MODE = MODE_FASTPRINT
					Print "Neues Inkrement ist "+inc+" (kgV von "+oldinc+" und "+test+")"
				EndIf
			EndIf
		' Die Zahl passt nicht?
		' Nagut, dann prüfen wir gar nicht weiter und gehen zum nächsten Schritt.
		Else
			Exit
		EndIf
	Next
	If RUN_MODE = MODE_SLOWMOTION Or RUN_MODE = MODE_FASTPRINT
		Print "Die Zahl wird um "+inc+" erhöht"
	EndIf
	' wenn nötig: Auf Tasteneingabe warten
	If RUN_MODE = MODE_SLOWMOTION
		Print "Eingabetaste drücken, um Fortzufahren"
		getchar_()
	EndIf
	' Wert inkrementieren
	value :+ inc
Forever

' Faktorisiert eine Zahl, gibt die Faktoren in einem Array zurück
Function Factorize:Long[](pVal:Long)
	If pVal=1 Return [1:Long]
	Local f:Long[]
	Local mf:Long = 2
	
	Repeat
		Local v:Long = mf
		Repeat
			Local m:Long = (pVal Mod v)
			If Not m
				f :+ [v]
				pVal :/ v
				mf = v
				Exit
			EndIf
			v :+ 1
		Forever
	Until pVal = 1
	
	Return f
End Function

' Bestimmt das kgV (engl. LCM von least common multiple) zweier Zahlen
Function LCM:Long(pVal1:Long, pVal2:Long)
	Local factors1:Long[] = Factorize(pVal1)
	Local factors2:Long[] = Factorize(pVal2)
	
	Local efactors:Long[]
	Local i1:Int = 0
	Local i2:Int = 0
	Repeat
		' nächstkleinsten faktor bestimmen
		If i1<factors1.length And i2<factors2.length
			Local sf:Long
			If factors1[i1] < factors2[i2]
				sf = factors1[i1]
			Else
				sf = factors2[i2]
			EndIf
			' so lange anhängen, wie min. einer der beiden arrays diese zahl hat
			While (i1<factors1.length And factors1[i1]=sf) Or (i2<factors2.length And factors2[i2]=sf)
				efactors :+ [sf]
				If factors1[i1]=sf
					i1 :+ 1
				EndIf
				If factors2[i2]=sf
					i2 :+ 1
				EndIf
			Wend
		' alle vergleichbaren faktoren aufgebraucht - rest einfach anhängen
		ElseIf i1<factors1.length
			efactors :+ factors1[i1..]
			Exit
		ElseIf i2<factors2.length
			efactors :+ factors2[i2..]
			Exit
		Else
			Exit
		EndIf
	Forever
	
	' kgV aus den Faktoren berechnen
	Local ret:Long = 1
	For Local f:Long = EachIn efactors
		ret :* f
	Next
	
	Return ret
End Function

' Quersumme berechnen
Function DigitSum:Int(pVal:Long)
	Local sum:Int
	Local value:String = String(pVal)
	For Local i:Int = 0 Until value.length
		Local c:String = value[i..i+1]
		sum :+ Int(c)
	Next
	Return sum
End Function

Noobody

 BeitragSa, Jun 02, 2012 15:00
Antworten mit Zitat
Benutzer-Profile anzeigen
Dass die Lösung LCM - 2 sein muss, fiel mir leider erst im Nachhinein auf. Für mich klang das Problem auf den ersten Blick nach einer Anwendung der allgemeineren Form des Chinesischen Restsatzes, der Methode der sukzessiven Vorwärtssubstitution.

Im Prinzip kombiniert die Methode immer zwei Kongruenzen in eine, indem es die allgemeine Lösung der ersten Kongruenz in die zweite einsetzt, die konstanten Teile verrechnet, die Gleichung vereinfacht und dann mithilfe der modularen Inverse (berechnet durch erweiterten GCD) eine Lösung der ersten Kongruenz findet, die die zweite erfüllt. Dann wird diese Lösung rückwärts eingesetzt und man erhält eine Kongruenz, deren Lösungen beide ursprünglichen Kongruenzen erfüllen.
Diese neu erhaltene Kongruenz kombiniert man wiederum mit der nächsten Kongruenz und reduziert so Stück für Stück die Anzahl Kongruenzen, bis man nur noch eine übrig hat, welche alle Anfangsbedingungen erfüllt. Damit ist es ein leichtes, alle Lösungen zu erhalten, die diese Kongruenz erfüllen (unter anderem auch die kleinste Lösung).

Ist ein wenig mit Kanonen auf Spatzen geschossen Razz Immerhin läuft das Programm immer noch unter einer Millisekunde und kann dafür beliebige Kongruenzen lösen und nicht nur x === i-2 (mod i). Aber ich hatte entscheidend länger an diesem Code als an einer einfachen LCM-Implementierung.

BlitzMax: [AUSKLAPPEN] 
SuperStrict

Local MaxNumber:Int = 42
Local MinNumber:Int = 3

Local Time:Int = MilliSecs()

Local Accum:Long, Modulus:Long = 1
For Local I:Int = MinNumber To MaxNumber
	Local J:Long, K:Long
	SolveCongruencePair(Accum, Modulus, I - 2, I, J, K)
	
	Accum   :+ Modulus*J
	Modulus :* K
Next

Time = MilliSecs() - Time

Local Checksum:Long, Walker:Long = Accum
While Walker
	Checksum :+ Walker Mod 10
	Walker :/ 10
Wend

Print "Solution time:     " + Time + "ms"
Print "All solutions:     " + Accum + " + " + Modulus + "*k"
Print "Smallest solution: " + Accum
Print "Checksum:          " + Checksum

For Local I:Long = MinNumber To MaxNumber
	Print Accum + " Mod " + I + " = " + (Accum Mod I)
Next

Function SolveCongruencePair(Y1:Long, Z1:Long, Y2:Long, Z2:Long, J:Long Var, K:Long Var)
	Local Y3:Long = (((Y2 - Y1) Mod Z2) + Z2) Mod Z2
	
	Local Divisor:Long = GCD(GCD(Y3, Z1), GCD(Y3, Z2))
	Z2 :/ Divisor
	Z1 :/ Divisor
	Y3 :/ Divisor
	
	Local X:Long, Inverse:Long
	ExtendedGCD(Z2, Z1, X, Inverse)
	
	K = Z2
	J = ((Inverse*Y3 Mod K) + K) Mod K
End Function

Function GCD:Long(A:Long, B:Long)
	Return ExtendedGCD(Max(A, B), Min(A, B), A, B)
End Function

Function ExtendedGCD:Long(A:Long, B:Long, X:Long Var, Y:Long Var)
	If Not B Then Return A
	
	Local Table:Long[][] = [[1:Long, 0:Long, A], [0:Long, 1:Long, B]]
	Repeat
		Local D :Long = Table[0][2] Mod Table[1][2]
		Local K :Long = Table[0][2]  /  Table[1][2]
		Local Xi:Long = Table[0][0] - K*Table[1][0]
		Local Yi:Long = Table[0][1] - K*Table[1][1]
		
		X = Table[1][0]
		Y = Table[1][1]
		
		If Not D Then Return Table[1][2]		
		
		Table[0] = Table[1]
		Table[1] = [Xi, Yi, D]
	Forever
End Function
Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun

Joel

 BeitragSa, Jun 02, 2012 18:09
Antworten mit Zitat
Benutzer-Profile anzeigen
Was macht ihr alle das so Kompliziert?
ggT kann man doch viel schöner mit dem Euklidischen Algorithmus ausrechnen.
und der kgV ist dann das Produkt der beiden Zahlen durch den ggT...
BlitzMax: [AUSKLAPPEN] 
SuperStrict

Global n:Long = kgV(3, 4)
For Local u:Int = 5 To 42
	n = kgV(n, u)
Next
n:-2
Print "Lösung:    " + n
Print "Quersumme: " + Quersumme(n)

Function ggT:Long(a:Long, b:Long)
	If a = b Then Return a
	Local z1:Long = Max(a, b)
	Local z2:Long = Min(a, b)
	Repeat
		z1 = z1 Mod z2
		If z1 = 0 Then Return z2
		z2 = z2 Mod z1
		If z2 = 0 Then Return z1
	Forever
End Function

Function kgV:Long(a:Long, b:Long)
	Return (a * b) / ggT(a, b)
End Function

Function Quersumme:Long(a:Long)
	Local str:String = String(a)
	Local z:Long = 0
	For Local n:Int = 0 To Len(str)
		z:+Int(Mid(str, n, 1))
	Next
	Return z
End Function


Aber bis ich auf die Grundidee gekommen bin hat's ne weile gedauert..
Schöne aufgabe!

BlitzMoritz

 BeitragFr, Jun 15, 2012 11:37
Antworten mit Zitat
Benutzer-Profile anzeigen
Neues BlitzQuiz:

Geheime Bild-Botschaften

Vier gleiche Bilder? Mysteriös ... ?!

Bild-0:
user posted image
Bild-1:
user posted image
Bild-2:
user posted image
Bild-3:
user posted image

Für das menschliche Auge mögen diese vier Bilder ja völlig identisch seien, in Wahrheit sind sie es jedoch nicht:
In den Bildern 1, 2 und 3 sind drei verschiedene geheime Botschaften verborgen. Das erste Bild-0 enthält für sich allein keine Botschaft, sondern bildet den "Schlüssel". Das Verschlüsslungsverfahren besteht aus zwei Aspekten:

1.) Durch den Vergleich der ARGB-Farbwerte (Alpha, Rot, Grün und Blau) mit denen von Bild-0 können minimale Unterschiede (jeweils kleiner 4) festgestellt werden. Diese vier absoluten Differenzen bilden die vier Ziffern einer 4er-Systemzahl (der Blau-Unterschied bildet also die Einerziffer der 4er-Systemzahl), mit der jedes Byte von 0 bis 255 darstellbar ist, also auch jede Ascii-Nummer. Dadurch kann - für das Auge unbemerkt - pro Pixel ein Buchstabe bzw. Zeichen "verpackt" werden.
(Der Text steht im Windows-Ansi-Zeichensatz, auf Unix-Systemen werden daher einige Sonderbuchstaben falsch aussehen.)

2.) Der Text ist, ausgehend vom zentralen Pixel in der Bildmitte, spiralförmig angeordnet, und zwar Pixel für Pixel: Von der Mitte nach Rechts - nach Unten - nach Links - nach Links - nach Oben usw... Folgendes, stark vergrößertes Beispiel möge die Pixel-Textspirale von "Hallo und herzlich Willkommen!" veranschaulichen:

user posted image

Nun viel Spaß beim Entschlüsseln der Texte!

Falls ihr alle drei Bilder entschlüsselt habt, verratet bitte nicht den konkreten Inhalt - ein paar allgemeine oder rätselhafte Anspielungen seien aber erlaubt Wink . Auch ein Beisteuern einer weiteren analogen Textverschlüsslung wäre nett.
In einer Woche können dann die konkreten Auflösungen und Code-Beispiele gepostet werden.

Eingeproggt

 BeitragFr, Jun 15, 2012 18:22
Antworten mit Zitat
Benutzer-Profile anzeigen
Entweder stell ich mich grad blöd an oder die Aufgabe is mit B3D nicht lösbar?
Alpha is bei mir immer -1, eh klar wegen den 32-bit-signed Integers oder? Also so wie es in der OnlineHilfe zu ReadPixel beschrieben is versuch ichs:

Code: [AUSKLAPPEN]
col=ReadPixel(x,y,buffer)
a = (col And $FF000000)/$1000000


Vielleicht hab ich auch BB langsam verlernt Sad Habs jedenfalls extra mit Image UND Texture-Buffer probiert weil ich dachte vlt hilft mir die 3D-Textur eher als das 2D-Image...

mfG, Christoph.
Gewinner des BCC 18, 33 und 65 sowie MiniBCC 9

blackgecko

 BeitragFr, Jun 15, 2012 22:40
Antworten mit Zitat
Benutzer-Profile anzeigen
@Eingeproggt Bist du sicher, dass Alpha immer -1 ist oder vielleicht nur sehr oft? Mit BlitzMax gehts nämlich und dort sind die Integer ja auch 32Bit signed. (es sind 4 Werte, jeder bekommt 8 Bits. Sollte reichen.)
Edit: Schönes Rätsel, allerdings schon fast zu viel verraten.
  • Zuletzt bearbeitet von blackgecko am Sa, Jun 16, 2012 13:09, insgesamt einmal bearbeitet

Eingeproggt

 BeitragSa, Jun 16, 2012 0:10
Antworten mit Zitat
Benutzer-Profile anzeigen
Gerade nochmal nachgeprüft, ja ich bin mir sicher.
Gewinner des BCC 18, 33 und 65 sowie MiniBCC 9

SpionAtom

Betreff: Alpha spinnt

 BeitragSa, Jun 16, 2012 3:42
Antworten mit Zitat
Benutzer-Profile anzeigen
Readpixel hat auch bei mir Probleme mit dem Alphakanal.

Hier mal die ersten Werte des Schlüsselbilds und des ersten Verschlüsselungsbildes:
Code: [AUSKLAPPEN]
11111111101100101000001101111010, 11111111101100101000001101111011
11111111101111111000110010000011, 11111111110000011000111110000001
11111111110010011001010110010001, 11111111110001111001010110010001
11111111110000001000111010001010, 11111111101111101000110110001001
11111111100100110110010001011111, 11111111100101010110001001011110
11111111101111001000111010000101, 11111111101111101001000110000111
11111111101001010111110001101101, 11111111101001110111101101101110
11111111101001100111110001101101, 11111111101001000111100101101100
11111111110000001001001010000101, 11111111110000101001001010000101
11111111101100101000000101110101, 11111111101100011000000101110010
11111111101001110111001001101010, 11111111101001010111010101101101
11111111110000111000011110000100, 11111111110001011000101010000101
11111111101010010111000001101100, 11111111101010110111001101101011
11111111100111000110100101100011, 11111111100110100110101001100010
11111111101100111000010001111011, 11111111101101101000010001111001
11111111100111110111001101101010, 11111111101000010111011001101011
11111111101011011000000001110001, 11111111101011110111110101110100
11111111100110110110101101100100, 11111111100110000110101101100110
11111111101011000111110101110110, 11111111101010100111110001111001


Die ersten 8 Bits sind stets gesetzt :/.
Auch in Java funktioniert der getAlpha()-befehl der Colorklasse nicht richtig.
Verrückt ist, dass es funktioniert, wenn ich den Alphawert manuel ausrechne:

Code: [AUSKLAPPEN]
      int d1 = Math.abs(((argb2 >> 24) & 0x000000FF) - ((argb1 >> 24) & 0x000000FF));
      int d2 = Math.abs(c2.getRed()   - c1.getRed());
      int d3 = Math.abs(c2.getGreen() - c1.getGreen());
      int d4 = Math.abs(c2.getBlue()  - c1.getBlue());


Nungut, die Aufgabe ist gelöst, in Java. Hab gleich alle Bilder auf einen Streich entschlüsselt!
os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080

BlitzMoritz

 BeitragSa, Jun 16, 2012 9:42
Antworten mit Zitat
Benutzer-Profile anzeigen
@SpionAtom: Du und dein Java Evil or Very Mad Wink

Täte mir leid, wenn B3D-ler benachteiligt wären Sad , ich mach' halt mit BB nicht mehr viel.
Also mit der Umrechnung in BlitzMax: [AUSKLAPPEN] 
Alpha%  = (ARGB & $FF000000:Int) / $1000000:Int
sollte es keine Probleme geben.

SpionAtom

 BeitragSa, Jun 16, 2012 11:39
Antworten mit Zitat
Benutzer-Profile anzeigen
Ja ich und mein Java. Hab das Programm aber erst in BB geschrieben und bis auf die Alphageschichte funktionierts auch dort. Wink
Außerdem gehts bei deinen Rätseln ja mehr um die Logik dahinter denn um die Programmiersprache (hoffe ich einfach mal).
os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080

ZEVS

 BeitragSa, Jun 16, 2012 11:51
Antworten mit Zitat
Benutzer-Profile anzeigen
Mit BlitzMax war das ein Kinderspiel.
So toll wie BlitzMax, gibt es keine Programmiersprache unter der Sonne.

ZEVS

Nova

 BeitragSa, Jun 16, 2012 20:19
Antworten mit Zitat
Benutzer-Profile anzeigen
Puhh, ich kriege jetzt jedenfalls etwas vernünftiges raus. Naja, fast... Die Rechtschreibung und der Sinn der Geschichte ist noch etwas komisch, da habe ich wohl noch einen Fehler...
Darum kümmere ich mich jetzt. Wink

Edit: Ach, wie schön, es funktioniert jetzt. Very Happy
Die Geschichte mit Hans habe ich mir ganz durchgelesen, aber die anderen beiden... Ne, keine Lust. ^^
Also, war eine schöne, aber halt auch ein wenig komplizierte Aufgabe. Jedenfalls wenn man nur recht selten viel programmiert. Smile

Eine Sache habe ich dabei falsch gemacht: Ich habe nur die Farbwerte des Original - Farbwerte des codierten Bildes genommen, allerdings sollte man dabei noch den Abs-Befehl nutzen.
AMD Athlon II 4x3,1GHz, 8GB Ram DDR3, ATI Radeon HD 6870, Win 7 64bit

BlitzMoritz

Betreff: Auflösung der geheimen Bildbotschaften:

 BeitragSo, Jun 24, 2012 10:54
Antworten mit Zitat
Benutzer-Profile anzeigen
Das Originalbild ist ein verkleinerter Ausschnitt des ehemals geltenden 1000-DM-Scheins und stellt die Gebrüder Grimm dar. Entsprechend enthielten die Bilder 1 bis 3 die kompletten Märchen "Das tapfere Schneiderlein", "Hans im Glück" und "Aschenputtel" - schon erstaunlich, was so in die kleinen Bildchen passte...
Ich wollte mit der Vierersystemzahl die (nicht) erkennbaren Farbunterschiede minimal lassen. Die BB-Irritation mit den Alphawerten wäre vermieden worden, wenn man nur die reinen Farbwerte Rot, Grün, Blau in Verbindung mit einer Sechsersystemzahl manipuliert hätte (nur so als Vorschlag für Nachahmer).
Hier noch ein möglicher Entschlüsslungscode:
BlitzMax: [AUSKLAPPEN] 
SuperStrict

Global text$, count_letter%, letter_Index%, Alpha%[,], Red%[,], Green%[,], Blue%[,]

ReadSecretPixmaps(["Bild-0.png", "Bild-1.png", "Bild-2.png", "Bild-3.png"])

Function ReadSecretPixmaps(PM_path$[])
	Local count% = Len(PM_path)
	If count < 2 Then RuntimeError("Man braucht mindestens zwei Bilder zum Vergleich!")
	
	'Die Daten des Originalbildes einlesen:	
	Local PM:TPixmap[count]
	PM[0] = LoadPixmap(PM_path[0])
	If PM[0] = Null Then RuntimeError("Das Bild konnte nicht geladen werden: ~n" + PM_path[0])
	Local Width% = PixmapWidth(PM[0])
	Local Height% = PixmapHeight(PM[0])
	Alpha = New Int[Width,Height]
	Red = New Int[Width,Height]
	Green = New Int[Width,Height]
	Blue = New Int[Width,Height]
	
	For Local x% = 0 Until Width
		For Local y% = 0 Until Height
			Local ARGB% = ReadPixel(PM[0], x, y)
			Alpha[x,y] = Byte((ARGB & $FF000000:Int) / $1000000:Int)
			Red[x,y] = Byte((ARGB & $00FF0000:Int) / $10000:Int)
			Green[x,y] = Byte((ARGB & $0000FF00:Int) / $100:Int)
			Blue[x,y] = Byte(ARGB & $000000FF:Int)
		Next
	Next

	'Nun die verschlüsselten Bilder mittig spiralförmig vergleichen.
	For Local c% = 1 Until count
		PM[c] = LoadPixmap(PM_path[c])

		If PM[c] = Null Then
			Print "Das Bild konnte nicht geladen werden: " + PM_path[c]
			Continue
		End If
		If PixmapWidth(PM[c]) <> Width Or PixmapHeight(PM[c]) <> Height Then
			Print "Das Bild hat nicht die gleichen Maße wie das erste (Original-)Bild: " + PM_path[c]
			Continue
		End If

		Local x% = 0.5*PixmapWidth(PM[0])
		Local y% = 0.5*PixmapHeight(PM[0])
		Local new_text$, new_ascii@ = compare_pixel(x,y,PM[0],PM[c])
		new_text:+Chr(new_ascii)
		
		Local length% = 1
		Local direction% = +1
		
		Repeat 'Spiralfoermig
		
			For Local i% = 1 To length
				x:+direction
				new_ascii = compare_pixel(x,y,PM[0],PM[c])	
				If new_ascii > 0 Then
					new_text:+Chr(new_ascii)
				Else
					Exit
				End If
			Next
			If new_ascii = 0 Then Exit
			
			For Local j% = 1 To length
				y:+direction
				new_ascii = compare_pixel(x,y,PM[0],PM[c])	
				If new_ascii > 0 Then
					new_text:+Chr(new_ascii)
				Else
					Exit
				End If
			Next
			If new_ascii = 0 Then Exit
			
			length:+1
			direction = -direction
			
			For Local i% = 1 To length
				x:+direction
				new_ascii = compare_pixel(x,y,PM[0],PM[c])	
				If new_ascii > 0 Then
					new_text:+Chr(new_ascii)
				Else
					Exit
				End If
			Next
			If new_ascii = 0 Then Exit	
			
			For Local j% = 1 To length
				y:+direction
				new_ascii = compare_pixel(x,y,PM[0],PM[c])	
				If new_ascii > 0 Then
					new_text:+Chr(new_ascii)
				Else
					Exit
				End If
			Next	
			If new_ascii = 0 Then Exit
			
			length:+1
			direction = -direction	
			
		Forever
		Print "==============================================="
		Print new_text
	Next
End Function

Function compare_pixel@(x%, y%, OriginalPM:TPixmap, SecretPM:TPixmap)
	If x < 0 Or x >= PixmapWidth(SecretPM) Or y < 0 Or y >= PixmapHeight(SecretPM) Then Return 0	
	Local ARGB% = ReadPixel(SecretPM, x, y)
	Local change_A% = Abs(Byte((ARGB & $FF000000:Int) / $1000000:Int) - Alpha[x,y])
	Local change_R% = Abs(Byte((ARGB & $00FF0000:Int) / $10000:Int) - Red[x,y])
	Local change_G% = Abs(Byte((ARGB & $0000FF00:Int) / $100:Int) - Green[x,y])
	Local change_B% = Abs(Byte(ARGB & $000000FF:Int) - Blue[x,y])
	Return 64*change_A + 16*change_R + 4*change_G + change_B
End Function

Joel

 BeitragSo, Jun 24, 2012 11:34
Antworten mit Zitat
Benutzer-Profile anzeigen
Wieder schöne aufgabe... Very Happy

Meine Lösung:BlitzMax: [AUSKLAPPEN] 
SuperStrict

Global img0:TPixmap = LoadPixmap("b0.png")
Global img1:TPixmap = LoadPixmap("b1.png")

Global X:Int = 68
Global Y:Int = 68
Global t:Int

Global str:String

Global stp:Int = 0

GC X, Y'erstes Zeichen auslesen
Repeat'Spirale
	stp:+1
	Repeat
		X:+1
		GC X, Y
		t:+1
	Until t = stp
	t = 0
	
	Repeat
		Y:+1
		GC X, Y
		t:+1
	Until t = stp
	t = 0
	stp:+1
	Repeat
		X:-1
		GC X, Y
		t:+1
	Until t = stp
	t = 0
	Repeat
		Y:-1
		GC X, Y
		t:+1
	Until t = stp
	t = 0
Until stp => 134
Print str

Function GC(Xpos:Int, Ypos:Int)'Jeweiligen Wert ausgeben
	Local argb0:Int = ReadPixel(img0, xpos, ypos)
	Local a0:Int = (argb0 & $FF000000) / $1000000
	Local r0:Int = (argb0 & $FF0000) / $10000
	Local g0:Int = (argb0 & $FF00) / $100
	Local b0:Int = argb0 & $FF
	Local argb1:Int = ReadPixel(img1, xpos, ypos)
	Local a1:Int = (argb1 & $FF000000) / $1000000
	Local r1:Int = (argb1 & $FF0000) / $10000
	Local g1:Int = (argb1 & $FF00) / $100
	Local b1:Int = argb1 & $FF
	Local n:Int
	n:+Abs(b0 - b1)
	n:+Abs(g0 - g1) * 4
	n:+Abs(r0 - r1) * 16
	n:+Abs(a0 - a1) * 64
	If n <> 0 Then str:+Chr(n)
End Function

ZEVS

 BeitragSo, Jun 24, 2012 14:28
Antworten mit Zitat
Benutzer-Profile anzeigen
Drei Funktionen. Die erste ermittelt die Differenz zweier Pixmaps für jede Komponente einzeln. Hierbei brauche ich also nicht erst kompliziert umrechnen. Die zweite Funktion macht aus einem spiralförmig gewickelten Text ein eindimensionales Array, wobei sie die dritte verwendet, die aus jedem ARGB-Wert einen schönen ASCII-Wert macht.
BlitzMax: [AUSKLAPPEN] 
SuperStrict
Function GetDiffPixmap:TPixmap(pix1:TPixmap, pix2:TPixmap)

	Assert pix1.width=pix2.width And pix1.height = pix2.height
	
	Local result:TPixmap = CreatePixmap(pix1.width, pix1.height, PF_RGBA8888)
	
	For Local i:Int = 0 Until pix1.capacity
			
		result.pixels[i] = Abs(pix1.pixels[i] - pix2.pixels[i])
		
		?Debug
			Assert result.pixels[i] <= 4
		?
				
	Next
	
	Return result
	
End Function

Function Unspiral:Byte[](pixmap:TPixmap)

	Local x:Int = pixmap.width/2, y:Int = pixmap.height/2
	Local movement:Int = 0
	Local vx:Int = 1, vy:Int = 0
	Local range:Int = 0
	Local moved:Int = 0
	Local bytes:Byte[pixmap.width*pixmap.height], index:Int = 0
	While x >= 0 And x < pixmap.width And y >= 0 And y < pixmap.height
	
		Local argb:Int = ReadPixel(pixmap, x, y)
		
		
		bytes[index] = ExtractChar(argb)
		
		index :+ 1
				
		
		x :+ vx
		y :+ vy
		
		moved :+ 1
		If moved > range Then
		
			movement = (movement + 1) Mod 4
			vx = 0
			vy = 0
			Select movement
				Case 0
					vx = 1
				Case 1
					vy = 1
				Case 2
					vx = -1
				Case 3
					vy = -1
			End Select
			
			If vx Then
			
				range :+ 1
				
			EndIf
			
			moved = 0
			
		EndIf
		

	Wend

	Return bytes

End Function

Local diff:TPixmap = GetDiffPixmap(LoadPixmap("img0.png"), LoadPixmap("img1.png"))

Local bytes:Byte[] = Unspiral(diff)

Print String.FromBytes(bytes, bytes.length)

Function ExtractChar:Byte(argb:Int)

	Local aDiff:Int = (argb & $03000000) Shr 24
	Local rDiff:Int = (argb & $00030000) Shr 16
	Local gDiff:Int = (argb & $00000300) Shr 8
	Local bDiff:Int = (argb & $00000003) Shr 0
	
	Local c:Byte = (aDiff Shl 6) | (rDiff Shl 4) | (gDiff Shl 2) | bDiff
	
	Return c

End Function


ZEVS

Nova

 BeitragDo, Jun 28, 2012 21:10
Antworten mit Zitat
Benutzer-Profile anzeigen
Hier mein Quelltext. Die Dateinamen kann man in der zweiten und dritten Zeile verändern.
BlitzMax: [AUSKLAPPEN] 
SuperStrict
Global bild0:TPixmap = LoadPixmapPNG ("bild-0.png")
Global bild1:TPixmap = LoadPixmapPNG ("bild-1.png")

Local bildgroesse:Int = PixmapWidth (bild0)
Local anzahl:Int = (bildgroesse -2)
	anzahl = (anzahl -1) * (anzahl -1)

Local x:Int = Floor (bildgroesse /2)
Local y:Int = x
Local i:Int = 0
Local j:Int
Local modus:Int
Local schritte:Int = 1
Local momSchritt:Int = 0
Local richtung:Int = 0
Local satz:String = ""


For i = 0 Until anzahl

	satz = satz + buchstabeAusPixmap (x, y)

	Select richtung
		Case 0
			x = x +1
		Case 1
			y = y +1
		Case 2
			x = x -1
		Case 3
			y = y -1
	EndSelect


	momSchritt = momSchritt +1
	
	If momSchritt = schritte
		Select richtung
			Case 1
				schritte = schritte +1
			Case 3
				schritte = schritte +1
		EndSelect

		richtung = (richtung +1) Mod 4
		momSchritt = 0
	EndIf
Next

Print "Der Satz lautet:"
Print satz

Input ("")
End



Function buchstabeAusPixmap:String (x:Int, y:Int)

	Local pixelOrg:Int
	Local alphaOrg:Int
	Local rotOrg:Int
	Local gruenOrg:Int
	Local blauOrg:Int
	
	Local pixelCod:Int
	Local alphaCod:Int
	Local rotCod:Int
	Local gruenCod:Int
	Local blauCod:Int
	
	Local alpha:Int
	Local rot:Int
	Local gruen:Int
	Local blau:Int
	
	Local buchstabe:String

	DebugLog "Koordinaten: "+ x +" "+ y
	pixelOrg = ReadPixel (bild0, x, y)
	alphaOrg  = ( pixelOrg Shr 24 ) & $FF
	rotOrg = ( pixelOrg Shr 16) & $FF
	gruenOrg = ( pixelOrg Shr 8) & $FF
	blauOrg = pixelOrg & $FF
		
	pixelCod = ReadPixel (bild1, x, y)
	alphaCod  = ( pixelCod Shr 24 ) & $FF
	rotCod = ( pixelCod Shr 16) & $FF
	gruenCod = ( pixelCod Shr 8) & $FF
	blauCod = pixelCod & $FF
	
	alpha = Abs (alphaOrg - alphaCod)
	rot = Abs (rotOrg - rotCod)
	gruen = Abs (gruenOrg - gruenCod)
	blau = Abs (blauOrg - blauCod)	
	
	buchstabe = Chr ((alpha *4 *4 *4) + (rot *4 *4) + (gruen*4) + blau)
	
	Return buchstabe

EndFunction
AMD Athlon II 4x3,1GHz, 8GB Ram DDR3, ATI Radeon HD 6870, Win 7 64bit

Gehe zu Seite Zurück  1, 2, 3, 4, 5

Neue Antwort erstellen


Übersicht Sonstiges Projekte

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group